--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my %items;
+while (<>) {
+ while (/(\w+) gener/g) {
+ $items{"G$1"} = $.;
+ }
+ while (/(\w+)-compat/g) {
+ $items{"M$1"} = $.;
+ }
+}
+
+my @q = ([ 0, 0, 1, \%items ]);
+
+sub valid_f {
+ my ($f, $itm) = @_;
+ my %g_cur = map { substr($_, 1) => 1 }
+ grep { $_ =~ /^G/ && $itm->{$_} == $f } keys %$itm;
+ return 1 if !keys %g_cur;
+ for my $c (grep { $_ =~ /^M/ && $itm->{$_} == $f } keys %$itm) {
+ return undef if !$g_cur{ substr($c, 1) };
+ }
+ return 1;
+}
+
+my @sorted = sort keys %items;
+my %seen;
+ENTRY:
+while (@q) {
+ my $entry = shift @q;
+ my ($w, $steps, $floor, $itm) = @$entry;
+
+ my $key = join('|', $floor, map { $itm->{$_} } @sorted);
+ say "$key";
+ next if $seen{$key}++;
+
+ for (1 .. 4) {
+ next ENTRY if !valid_f($_, $itm);
+ }
+ say "valid";
+
+ if (!grep { $itm->{$_} != 4 } keys %$itm) {
+ say "$steps";
+ last;
+ }
+
+ for my $nf ($floor+1, $floor-1) {
+ next if $nf < 1 || $nf > 4;
+ for my $i (0 .. $#sorted) {
+ my $itm_i = $sorted[$i];
+ next if $itm->{$itm_i} != $floor;
+ for my $j ($i .. $#sorted) {
+ my $itm_j = $sorted[$j];
+ next if $itm->{$itm_j} != $floor;
+ my %nitm = %$itm;
+ say "moving $itm_i $itm_j from $floor to $nf steps $steps+1";
+ $nitm{$itm_i} = $nf;
+ $nitm{$itm_j} = $nf;
+ push @q, [ 0, $steps+1, $nf, \%nitm ];
+ }
+ }
+ }
+}
+
+
+
+
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.16;
+
+my %items;
+while (<>) {
+ while (/(\w+) gener/g) {
+ $items{"G$1"} = $.;
+ }
+ while (/(\w+)-compat/g) {
+ $items{"M$1"} = $.;
+ }
+}
+
+if (1) {
+$items{Gelerium} = 1;
+$items{Melerium} = 1;
+$items{Gdilithium} = 1;
+$items{Mdilithium} = 1;
+}
+
+my @q = ([ 0, 0, 1, \%items ]);
+
+sub valid_f {
+ my ($f, $itm) = @_;
+ my %g_cur = map { substr($_, 1) => 1 }
+ grep { $_ =~ /^G/ && $itm->{$_} == $f } keys %$itm;
+ return 1 if !keys %g_cur;
+ for my $c (grep { $_ =~ /^M/ && $itm->{$_} == $f } keys %$itm) {
+ return undef if !$g_cur{ substr($c, 1) };
+ }
+ return 1;
+}
+
+my @sorted = sort keys %items;
+my %seen;
+
+use Array::Heap;
+
+my $prev_w = 0;
+ENTRY:
+while (@q) {
+ my $entry = pop_heap @q;
+ my ($w, $steps, $floor, $itm) = @$entry;
+
+ my $key = join('', $floor, map { $itm->{$_} } @sorted);
+ say "$w $steps $key" if $w != $prev_w;
+ $prev_w = $w;
+ next if $seen{$key}++;
+
+ if (!grep { $itm->{$_} != 4 } keys %$itm) {
+ say "$steps";
+ last;
+ }
+
+ for my $nf ($floor+1, $floor-1) {
+ next if $nf < 1 || $nf > 4;
+ for my $i (0 .. $#sorted) {
+ my $itm_i = $sorted[$i];
+ next if $itm->{$itm_i} != $floor;
+ next if $floor == 4 && $itm_i =~ /\AM/;
+ for my $j ($i .. $#sorted) {
+ my $itm_j = $sorted[$j];
+ next if $itm->{$itm_j} != $floor;
+ next if $floor == 4 && $itm_i ne $itm_j;
+ next if $itm_i =~ /\AG/ && $itm_j =~ /\AM/
+ && substr($itm_i, 1) ne substr($itm_j, 1);
+ my %nitm = %$itm;
+ # say "moving $itm_i $itm_j from $floor to $nf steps $steps+1";
+ $nitm{$itm_i} = $nf;
+ $nitm{$itm_j} = $nf;
+ next if !valid_f($nf, \%nitm);
+ next if !valid_f($floor, \%nitm);
+ my $nw = 2*$steps;
+ $nw += 4 - $nitm{$_} for keys %nitm;
+ push_heap @q, [ $nw, $steps+1, $nf, \%nitm ];
+ }
+ }
+ }
+}
+
+
+
+
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my %regs;
+my @code = map { chomp; $_ } <>;
+
+my $ip = 0;
+while ($ip < @code) {
+ say "$ip $code[$ip] ", join(', ', map { "$_=$regs{$_}" } sort keys %regs);
+ $_ = $code[$ip++];
+ if (/cpy (-?\w+) (\w+)/) {
+ my $val = $1;
+ my $reg = $2;
+ $val = $regs{$val} if $val =~ /[a-z]/;
+ $regs{$reg} = $val;
+ } elsif (/inc (\w+)/) {
+ $regs{$1}++;
+ } elsif (/dec (\w+)/) {
+ $regs{$1}--;
+ } elsif (/jnz (-?\w+) (-?\d+)/) {
+ my ($reg, $val) = ($1, $2);
+ $reg = $regs{$reg} if $reg =~ /[a-z]/;
+ if ($reg) {
+ $ip += $val - 1;
+ }
+ } else {
+ say "Unknown instrution: $_";
+ }
+}
+
+say $ip;
+say $regs{a};
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my %regs = ( c => 1 );
+my @code = map { chomp; $_ } <>;
+
+my $ip = 0;
+while ($ip < @code) {
+ say "$ip $code[$ip] ", join(', ', map { "$_=$regs{$_}" } sort keys %regs);
+ $_ = $code[$ip++];
+ if (/cpy (-?\w+) (\w+)/) {
+ my $val = $1;
+ my $reg = $2;
+ $val = $regs{$val} if $val =~ /[a-z]/;
+ $regs{$reg} = $val;
+ } elsif (/inc (\w+)/) {
+ $regs{$1}++;
+ } elsif (/dec (\w+)/) {
+ $regs{$1}--;
+ } elsif (/jnz (-?\w+) (-?\d+)/) {
+ my ($reg, $val) = ($1, $2);
+ $reg = $regs{$reg} if $reg =~ /[a-z]/;
+ if ($reg) {
+ $ip += $val - 1;
+ }
+ } else {
+ say "Unknown instrution: $_";
+ }
+}
+
+say $ip;
+say $regs{a};
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my $in = 1362;
+# my $in = 10;
+
+my %maze;
+$; = ',';
+sub is_wall {
+ my ($x, $y) = @_;
+ return $maze{$x,$y} if exists $maze{$x,$y};
+
+ my $sum = $in + $x*$x + 3*$x + 2*$x*$y + $y + $y*$y;
+ my $bin = sprintf("%b", $sum);
+ say "$x $y => $sum => $bin";
+ my $count = () = $bin =~ /1/g;
+ return $maze{$x,$y} = $count & 1;
+}
+
+say is_wall(0, 0);
+say is_wall(3, 5);
+say is_wall(9, 2);
+
+my %seen = ( "1,1" => 1 );
+my @paths = ( [ 1, 1, 0 ] );
+while (@paths) {
+ my $p = shift @paths;
+ my ($x, $y, $steps) = @$p;
+ if ($x == 31 && $y == 39) {
+ say $steps;
+ last;
+ }
+ for my $d ([0, 1], [0, -1], [1, 0], [-1, 0]) {
+ my $x1 = $x + $d->[0];
+ my $y1 = $y + $d->[1];
+ next if $x1 < 0 || $y1 < 0;
+ next if $seen{$x1,$y1};
+ next if is_wall($x1, $y1);
+ $seen{$x1,$y1}++;
+ push @paths, [$x1, $y1, $steps+1];
+ }
+}
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my $in = 1362;
+# my $in = 10;
+
+my %maze;
+$; = ',';
+sub is_wall {
+ my ($x, $y) = @_;
+ return $maze{$x,$y} if exists $maze{$x,$y};
+
+ my $sum = $in + $x*$x + 3*$x + 2*$x*$y + $y + $y*$y;
+ my $bin = sprintf("%b", $sum);
+ say "$x $y => $sum => $bin";
+ my $count = () = $bin =~ /1/g;
+ return $maze{$x,$y} = $count & 1;
+}
+
+say is_wall(0, 0);
+say is_wall(3, 5);
+say is_wall(9, 2);
+
+my %seen = ( "1,1" => 1 );
+my @paths = ( [ 1, 1, 0 ] );
+while (@paths) {
+ my $p = shift @paths;
+ my ($x, $y, $steps) = @$p;
+ for my $d ([0, 1], [0, -1], [1, 0], [-1, 0]) {
+ my $x1 = $x + $d->[0];
+ my $y1 = $y + $d->[1];
+ next if $x1 < 0 || $y1 < 0;
+ next if $seen{$x1,$y1};
+ next if is_wall($x1, $y1);
+ next if $steps >= 50;
+ $seen{$x1,$y1}++;
+ push @paths, [$x1, $y1, $steps+1];
+ }
+}
+say scalar keys %seen;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+use Digest::MD5 qw(md5_hex);
+
+my $salt = 'zpqevtbw';
+# my $salt = 'abc';
+
+my $i = -1001;
+my $count = 0;
+my %five;
+while (1) {
+ ++$i;
+ my $j = $i+1000;
+ my $f = md5_hex($salt.$j);
+ $five{$1} = $j for $f =~ /(.)\1\1\1\1/g;
+ next if $i < 0;
+ my $h = md5_hex($salt,$i);
+ if ($h =~ /(.)\1\1/) {
+ next if !$five{$1} || $five{$1} <= $i;
+ say ++$count, " $i $1 in $h, also at $five{$1} ", md5_hex($salt.$five{$1});;
+ exit 0 if $count >= 64;
+ }
+}
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+use Digest::MD5 qw(md5_hex);
+
+my $salt = 'zpqevtbw';
+# my $salt = 'abc';
+
+my $i = -1001;
+my $count = 0;
+my %five;
+while (1) {
+ ++$i;
+ my $j = $i+1000;
+ my $f = md5_hex($salt.$j);
+ $f = md5_hex($f) for 1 .. 2016;
+ $five{$1} = $j for $f =~ /(.)\1\1\1\1/g;
+ next if $i < 0;
+ my $h = md5_hex($salt,$i);
+ $h = md5_hex($h) for 1 .. 2016;
+ if ($h =~ /(.)\1\1/) {
+ next if !$five{$1} || $five{$1} <= $i;
+ say ++$count, " $i $1 in $h, also at $five{$1} ", md5_hex($salt.$five{$1});;
+ exit 0 if $count >= 64;
+ }
+}
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my @positions;
+my @npos;
+while (<>) {
+ my ($disc, $pos, $start) = /Disc #(\d+) has (\d+) p.* position (\d+)/;
+ $disc--;
+ $positions[$disc] = $start;
+ $npos[$disc] = $pos;
+}
+
+my $t = -1;
+TIME:
+while (1) {
+ $t++;
+ for my $d (0 .. $#positions) {
+ next TIME if ($positions[$d] + $t + 1 + $d) % $npos[$d];
+ }
+ say "$t";
+ last;
+}
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my @positions;
+my @npos;
+while (<>) {
+ my ($disc, $pos, $start) = /Disc #(\d+) has (\d+) p.* position (\d+)/;
+ $disc--;
+ $positions[$disc] = $start;
+ $npos[$disc] = $pos;
+}
+
+push @positions, 0;
+push @npos, 11;
+
+my $t = -1;
+TIME:
+while (1) {
+ $t++;
+ for my $d (0 .. $#positions) {
+ next TIME if ($positions[$d] + $t + 1 + $d) % $npos[$d];
+ }
+ say "$t";
+ last;
+}
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my $in = '00101000101111010';
+my $len = 272;
+
+while (length($in) < $len) {
+ my $l1 = join('', reverse split(//, $in));
+ $l1 =~ y/01/10/;
+ $in .= '0' . $l1;
+}
+
+$in = substr($in, 0, $len);
+while (length($in) % 2 == 0) {
+ my $l1 = '';
+ while ($in =~ /../g) {
+ $l1 .= ($& eq '11' || $& eq '00') ? '1' : '0';
+ }
+ $in = $l1;
+}
+
+say $in;
+
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my $in = '00101000101111010';
+my $len = 35651584;
+
+while (length($in) < $len) {
+ my $l1 = join('', reverse split(//, $in));
+ $l1 =~ y/01/10/;
+ $in .= '0' . $l1;
+}
+
+$in = substr($in, 0, $len);
+while (length($in) % 2 == 0) {
+ my $l1 = '';
+ while ($in =~ /../g) {
+ $l1 .= ($& eq '11' || $& eq '00') ? '1' : '0';
+ }
+ $in = $l1;
+}
+
+say $in;
+
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+use Digest::MD5 qw(md5_hex);
+my $in = 'pvhmgsws';
+
+my @paths = [ 0, 0, '' ];
+
+while (@paths) {
+ my $p = shift @paths;
+ my ($x, $y, $path) = @$p;
+
+ if ($x == 3 && $y == 3) {
+ say $path;
+ last;
+ }
+
+ my $h = md5_hex($in.$path);
+ if ($y > 0 && substr($h, 0, 1) =~ /[b-f]/) {
+ push @paths, [ $x, $y-1, $path.'U' ];
+ }
+ if ($y < 3 && substr($h, 1, 1) =~ /[b-f]/) {
+ push @paths, [ $x, $y+1, $path.'D' ];
+ }
+ if ($x > 0 && substr($h, 2, 1) =~ /[b-f]/) {
+ push @paths, [ $x-1, $y, $path.'L' ];
+ }
+ if ($x < 3 && substr($h, 3, 1) =~ /[b-f]/) {
+ push @paths, [ $x+1, $y, $path.'R' ];
+ }
+}
+
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+use Digest::MD5 qw(md5_hex);
+my $in = 'pvhmgsws';
+
+my @paths = [ 0, 0, '' ];
+
+my $max;
+while (@paths) {
+ my $p = shift @paths;
+ my ($x, $y, $path) = @$p;
+
+ if ($x == 3 && $y == 3) {
+ $max = length $path if !$max || $max < length $path;
+ next;
+ }
+
+ my $h = md5_hex($in.$path);
+ if ($y > 0 && substr($h, 0, 1) =~ /[b-f]/) {
+ push @paths, [ $x, $y-1, $path.'U' ];
+ }
+ if ($y < 3 && substr($h, 1, 1) =~ /[b-f]/) {
+ push @paths, [ $x, $y+1, $path.'D' ];
+ }
+ if ($x > 0 && substr($h, 2, 1) =~ /[b-f]/) {
+ push @paths, [ $x-1, $y, $path.'L' ];
+ }
+ if ($x < 3 && substr($h, 3, 1) =~ /[b-f]/) {
+ push @paths, [ $x+1, $y, $path.'R' ];
+ }
+}
+
+say $max;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+chomp (my $line = <>);
+
+my $traps;
+for (1 .. 40) {
+ $traps += () = $line =~ /\./g;
+ say $traps;
+ $line = '.' . $line . '.';
+ my $nl = '';
+ for my $i (0 .. length($line)-3) {
+ my $p = substr($line, $i, 3);
+ $nl .= ($p eq '^^.' || $p eq '.^^' || $p eq '^..' || $p eq '..^')
+ ? '^' : '.';
+ }
+ say "$_ $nl";
+ $line = $nl;
+}
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+chomp (my $line = <>);
+
+my $traps;
+for (1 .. 400000) {
+ $traps += () = $line =~ /\./g;
+ say $traps if $_ == 400000;
+ $line = '.' . $line . '.';
+ my $nl = '';
+ for my $i (0 .. length($line)-3) {
+ my $p = substr($line, $i, 3);
+ $nl .= ($p eq '^^.' || $p eq '.^^' || $p eq '^..' || $p eq '..^')
+ ? '^' : '.';
+ }
+ # say "$_ $nl";
+ $line = $nl;
+}
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+# my $in = 3004953;
+my $in = shift;
+
+my @elves = (1 .. $in);
+my $now = 0;
+while (@elves > 1) {
+ @elves = grep { $now = !$now } @elves;
+ say join(' ', @elves);
+}
+say $elves[0];
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+# my $in = 3004953;
+my $in = shift;
+
+my @elves = (1 .. $in);
+my $now = 0;
+while (@elves > 1) {
+ my $steal = $now + int(@elves/2);
+ $steal -= @elves if $steal > $#elves;
+ say "now $now, steal $steal, total ", scalar @elves, ": ", join(' ', @elves);
+ splice(@elves, $steal, 1);
+ $now++ if $steal > $now;
+ $now = 0 if $now > $#elves;
+}
+say $elves[0];
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my @ints = ([ 0, (1 << 32)-1 ]);
+INT:
+while (<>) {
+ chomp;
+ say join(' ', map { $_->[0] . '-' . $_->[1] } @ints);
+ my ($lo, $hi) = split /-/;
+ say "blacklisting $lo-$hi";
+ my $i = 0;
+ while ($i < @ints) {
+ my $int = $ints[$i];
+ if ($int->[0] < $lo && $int->[1] > $hi) {
+ splice @ints, $i, 1, [ $int->[0], $lo-1 ], [ $hi+1, $int->[1] ];
+ next INT;
+ } elsif ($int->[0] < $lo && $int->[1] >= $lo && $int->[1] <= $hi) {
+ splice @ints, $i, 1, [ $int->[0], $lo-1 ];
+ $i++;
+ } elsif ($int->[0] >= $lo && $int->[1] <= $hi) {
+ splice @ints, $i, 1;
+ } elsif ($int->[0] >= $lo && $int->[0] <= $hi && $int->[1] > $hi) {
+ splice @ints, $i, 1, [ $hi+1, $int->[1] ];
+ next INT;
+ } elsif ($int->[0] > $hi) {
+ next INT;
+ } else {
+ $i++;
+ }
+ }
+}
+
+say $ints[0]->[0];
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my @ints = ([ 0, (1 << 32)-1 ]);
+INT:
+while (<>) {
+ chomp;
+ say join(' ', map { $_->[0] . '-' . $_->[1] } @ints);
+ my ($lo, $hi) = split /-/;
+ say "blacklisting $lo-$hi";
+ my $i = 0;
+ while ($i < @ints) {
+ my $int = $ints[$i];
+ if ($int->[0] < $lo && $int->[1] > $hi) {
+ splice @ints, $i, 1, [ $int->[0], $lo-1 ], [ $hi+1, $int->[1] ];
+ next INT;
+ } elsif ($int->[0] < $lo && $int->[1] >= $lo && $int->[1] <= $hi) {
+ splice @ints, $i, 1, [ $int->[0], $lo-1 ];
+ $i++;
+ } elsif ($int->[0] >= $lo && $int->[1] <= $hi) {
+ splice @ints, $i, 1;
+ } elsif ($int->[0] >= $lo && $int->[0] <= $hi && $int->[1] > $hi) {
+ splice @ints, $i, 1, [ $hi+1, $int->[1] ];
+ next INT;
+ } elsif ($int->[0] > $hi) {
+ next INT;
+ } else {
+ $i++;
+ }
+ }
+}
+
+my $sum;
+for my $i (@ints) {
+ $sum += $i->[1]-$i->[0]+1;
+}
+say $sum;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my $data = 'abcdefgh';
+# my $data = 'abcde';
+
+while (<>) {
+ chomp;
+ say "$data $_";
+ if (/swap position (\d+) with position (\d+)/) {
+ (substr($data, $1, 1), substr($data, $2, 1))
+ = (substr($data, $2, 1), substr($data, $1, 1));
+ } elsif (/swap letter (\w) with letter (\w)/) {
+ eval "\$data =~ y/$1$2/$2$1/";
+ } elsif (/rotate left (\d+) /) {
+ my $n = $1;
+ $data =~ s/^(.{$n})(.*)/$2$1/;
+ } elsif (/rotate right (\d+) /) {
+ my $n = $1;
+ $data =~ s/^(.*)(.{$n})/$2$1/;
+ } elsif (/rotate based on position of letter (\w)/) {
+ my $l = $1;
+ my ($pref) = $data =~ /^(.*$l)/;
+ my $pos = length($pref);
+ $pos++ if $pos > 4;
+ $pos -= length($data) if $pos >= length($data);
+ $data =~ s/^(.*)(.{$pos})/$2$1/ if $pos;
+ } elsif (/reverse positions (\d+) through (\d+)/) {
+ substr($data, $1, $2-$1+1) = join('', reverse split //,
+ substr($data, $1, $2-$1+1));
+ } elsif (/move position (\d+) to position (\d+)/) {
+ my $l = substr($data, $1, 1);
+ substr($data, $1, 1) = '';
+ substr($data, $2, 0) = $l;
+ } else {
+ die "Unknown command $_.";
+ }
+
+}
+
+say $data;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my $data = 'abcdefgh';
+# my $data = 'abcde';
+chomp (my @rules = <>);
+
+sub scramble {
+ my $data = shift;
+ for (@rules) {
+ if (/swap position (\d+) with position (\d+)/) {
+ (substr($data, $1, 1), substr($data, $2, 1))
+ = (substr($data, $2, 1), substr($data, $1, 1));
+ } elsif (/swap letter (\w) with letter (\w)/) {
+ eval "\$data =~ y/$1$2/$2$1/";
+ } elsif (/rotate left (\d+) /) {
+ my $n = $1;
+ $data =~ s/^(.{$n})(.*)/$2$1/;
+ } elsif (/rotate right (\d+) /) {
+ my $n = $1;
+ $data =~ s/^(.*)(.{$n})/$2$1/;
+ } elsif (/rotate based on position of letter (\w)/) {
+ my $l = $1;
+ my ($pref) = $data =~ /^(.*$l)/;
+ my $pos = length($pref);
+ $pos++ if $pos > 4;
+ $pos -= length($data) if $pos >= length($data);
+ $data =~ s/^(.*)(.{$pos})/$2$1/ if $pos;
+ } elsif (/reverse positions (\d+) through (\d+)/) {
+ substr($data, $1, $2-$1+1) = join('', reverse split //,
+ substr($data, $1, $2-$1+1));
+ } elsif (/move position (\d+) to position (\d+)/) {
+ my $l = substr($data, $1, 1);
+ substr($data, $1, 1) = '';
+ substr($data, $2, 0) = $l;
+ } else {
+ die "Unknown command $_.";
+ }
+ }
+ return $data;
+}
+
+sub perm {
+ my ($pass, @rest) = @_;
+ if (!@rest) {
+ if (scramble($pass) eq 'fbgdceah') {
+ say "found $pass";
+ exit 0;
+ }
+ }
+ for my $i (0 .. $#rest) {
+ my @nr = @rest;
+ my $c = splice (@nr, $i, 1);
+ perm("$pass$c", @nr);
+ }
+}
+
+perm('', split //, 'abcdefgh');
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+$_ = <>; # header
+$_ = <>; # header
+$; = ',';
+
+my (%size, %used);
+while (<>) {
+ my ($x, $y, $size, $used) = m|/dev/grid/node-x(\d+)-y(\d+)\s+(\d+)T\s+(\d+)T|;
+ die "no match at $_" if !defined $used;
+ $size{$x,$y} = $size;
+ $used{$x,$y} = $used;
+}
+
+my $count = 0;
+for my $n1 (keys %size) {
+for my $n2 (keys %size) {
+ next if $n1 eq $n2;
+ next if !$used{$n1};
+ $count++ if $used{$n1} <= $size{$n2} - $used{$n2};
+} }
+say $count;
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+$_ = <>; # header
+$_ = <>; # header
+$; = ',';
+
+my (%dead);
+my ($xmax, $ymax);
+my ($fx, $fy);
+while (<>) {
+ my ($x, $y, $size, $used) = m|/dev/grid/node-x(\d+)-y(\d+)\s+(\d+)T\s+(\d+)T|;
+ die "no match at $_" if !defined $used;
+ if ($size > 100) {
+ $dead{$x,$y} = 1;
+ } elsif ($used == 0) {
+ $fx = $x;
+ $fy = $y;
+ }
+ $xmax = $x if !$xmax || $xmax < $x;
+ $ymax = $y if !$ymax || $ymax < $y;
+}
+
+use Array::Heap;
+my @q = ( [ $xmax + $xmax-$fx + $fy, $xmax, 0, $fx, $fy, 0 ] );
+
+my %seen;
+while (@q) {
+ my $state = pop_heap @q;
+ my ($score, $gx, $gy, $fx, $fy, $steps) = @$state;
+ say "score $score, goal at $gx,$gy, free at $fx,$fy, steps $steps";
+ last if $gx == 0 && $gy == 0;
+ for ([0, 1], [0, -1], [1, 0], [-1, 0]) {
+ my ($dx, $dy) = ($fx + $_->[0], $fy + $_->[1]);
+ next if $dx < 0 || $dx > $xmax || $dy < 0 || $dy > $ymax;
+ next if $dead{$dx,$dy};
+ my ($ngx, $ngy) = ($gx, $gy);
+ if ($dx == $gx && $dy == $gy) {
+ ($ngx, $ngy) = ($fx, $fy);
+ }
+ next if $seen{$ngx,$ngy,$dx,$dy}++;
+ my $nscore = $ngx+$ngy+abs($dx-$ngx)+abs($dy-$ngy);
+ push_heap @q, [ $nscore,
+ $ngx, $ngy, $dx, $dy, $steps+1 ];
+ say " F->$dx,$dy $nscore";
+ }
+}
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my @code = map { chomp; [ split /\s+/ ] } <>;
+
+my $ip = 0;
+
+my %tgl = (
+ cpy => 'jnz',
+ inc => 'dec',
+ dec => 'inc',
+ jnz => 'cpy',
+ tgl => 'inc',
+);
+
+my %regs = (a => 12);
+while ($ip < @code) {
+ say join(' ', $ip, @{ $code[$ip] }, map { "$_=$regs{$_}" } sort keys %regs);
+ my @ins = @{ $code[$ip] };
+ if ($ins[0] eq 'cpy') {
+ my $val = $ins[1];
+ my $reg = $ins[2];
+ $val = $regs{$val} if $val =~ /[a-z]/;
+ $regs{$reg} = $val;
+ } elsif ($ins[0] eq 'inc') {
+ $regs{$ins[1]}++;
+ } elsif ($ins[0] eq 'dec') {
+ $regs{$ins[1]}--;
+ } elsif ($ins[0] eq 'jnz') {
+ my ($reg, $val) = @ins[1..2];
+ $reg = $regs{$reg} if $reg =~ /[a-z]/;
+ $val = $regs{$val} if $val =~ /[a-z]/;
+ if ($reg) {
+ $ip += $val - 1;
+ }
+ } elsif ($ins[0] eq 'tgl') {
+ my $off = $ins[1];
+ $off = $regs{$off} if $off =~ /[a-z]/;
+ my $other = $code[$ip + $off];
+ $other->[0] = $tgl{$other->[0]};
+ } else {
+ say "Unknown instrution: $_";
+ }
+ $ip++;
+}
+
+say $ip;
+say $regs{a};
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my @code = map { chomp; [ split /\s+/ ] } <>;
+
+my $ip = 0;
+
+my %tgl = (
+ cpy => 'jnz',
+ inc => 'dec',
+ dec => 'inc',
+ jnz => 'cpy',
+ tgl => 'inc',
+);
+
+my %regs = (a => 12);
+# my %regs = (a => 479001600, b => 1, c => 2, d => 0);
+# $code[24][0] = 'dec'; # after b=4
+# $code[22][0] = 'dec'; # after b=3
+# $code[20][0] = 'cpy'; # after b=2
+# $code[18][0] = 'cpy'; # after b=2
+# $code[16][0] = 'inc'; # after b=1
+my $debug = 0;
+# $ip = 17;
+while ($ip < @code) {
+ say join(' ', $ip, @{ $code[$ip] }, map { "$_=$regs{$_}" } sort keys %regs)
+ if $debug;
+ $debug = 0;
+ my @ins = @{ $code[$ip] };
+ if ($ins[0] eq 'cpy') {
+ my $val = $ins[1];
+ my $reg = $ins[2];
+ $val = $regs{$val} if $val =~ /[a-z]/;
+ $regs{$reg} = $val;
+ } elsif ($ins[0] eq 'inc') {
+ $regs{$ins[1]}++;
+ } elsif ($ins[0] eq 'dec') {
+ $regs{$ins[1]}--;
+ } elsif ($ins[0] eq 'jnz') {
+ my ($reg, $val) = @ins[1..2];
+ if ($val eq '-2' && $ip >= 2 && $code[$ip-1][0] eq 'dec'
+ && $code[$ip-2][0] eq 'inc'
+ && $code[$ip-1][1] eq $reg) {
+ $regs{$code[$ip-2][1]} += $regs{$reg};
+ $regs{$reg} = 0;
+ }
+ $val = $regs{$val} if $val =~ /[a-z]/;
+ $reg = $regs{$reg} if $reg =~ /[a-z]/;
+ if ($reg) {
+ $ip += $val - 1;
+ }
+ } elsif ($ins[0] eq 'tgl') {
+ my $off = $ins[1];
+ $off = $regs{$off} if $off =~ /[a-z]/;
+ my $other = $code[$ip + $off];
+ say "toggle ", $ip+$off, " $other->[0] to $tgl{$other->[0]}"
+ if $other;
+ $debug = 1;
+ $other->[0] = $tgl{$other->[0]} if $other;
+ } else {
+ say "Unknown instrution: $_";
+ }
+ $ip++;
+}
+
+say $ip;
+say $regs{a};
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my @ducts;
+my %duct_pos;
+my @map;
+while (<>) {
+ chomp;
+ push @map, [ split // ];
+ my $line = $_;
+ while ($line =~ /\d/g) {
+ my $x = pos($line) - 1;
+ my $y = $#map;
+ $ducts[$&] = [ $x, $y ];
+ $duct_pos{$x,$y} = $&;
+ say "$& at ", pos($line)-1, ",$#map";
+ }
+}
+
+my $xmax = $#{ $map[0] };
+my $ymax = $#map;
+$; = ',';
+
+my %dist;
+
+sub walk {
+ my ($duct) = @_;
+
+ my ($x, $y) = @{ $ducts[$duct] };
+ my @q = ([ $x, $y, 0 ]);
+ my %seen = ("$x,$y" => 1);
+ my $ducts_seen = 0;
+ while (@q) {
+ my $entry = shift @q;
+ my ($x, $y, $dist) = @$entry;
+ if ($map[$y][$x] =~ /\d/) {
+ $dist{$duct}{$&} = $dist;
+ say "dist $duct -> $& = $dist";
+ return if (++$ducts_seen >= @ducts);
+ }
+ for ([0, 1], [0, -1], [1, 0], [-1, 0]) {
+ my $dx = $x + $_->[0];
+ my $dy = $y + $_->[1];
+ next if $dx < 0 || $dx > $xmax || $dy < 0 || $dy > $ymax
+ || $map[$y][$x] eq '#';
+ next if $seen{$dx,$dy}++;
+ push @q, [ $dx, $dy, $dist+1];
+ }
+ }
+}
+
+walk($_) for 0 .. 7;
+
+my $min_dist;
+
+sub perm {
+ my ($dist, $now, @rest) = @_;
+ if (!@rest) {
+ $min_dist = $dist if !defined $min_dist || $dist < $min_dist;
+ }
+ for my $i (0 .. $#rest) {
+ my @nr = @rest;
+ my $duct = splice @nr, $i, 1;
+ perm($dist + $dist{$now}{$duct}, $duct, @nr);
+ }
+}
+
+perm(0, 0 .. 7);
+
+say $min_dist;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.30;
+
+my @ducts;
+my %duct_pos;
+my @map;
+while (<>) {
+ chomp;
+ push @map, [ split // ];
+ my $line = $_;
+ while ($line =~ /\d/g) {
+ my $x = pos($line) - 1;
+ my $y = $#map;
+ $ducts[$&] = [ $x, $y ];
+ $duct_pos{$x,$y} = $&;
+ say "$& at ", pos($line)-1, ",$#map";
+ }
+}
+
+my $xmax = $#{ $map[0] };
+my $ymax = $#map;
+$; = ',';
+
+my %dist;
+
+sub walk {
+ my ($duct) = @_;
+
+ my ($x, $y) = @{ $ducts[$duct] };
+ my @q = ([ $x, $y, 0 ]);
+ my %seen = ("$x,$y" => 1);
+ my $ducts_seen = 0;
+ while (@q) {
+ my $entry = shift @q;
+ my ($x, $y, $dist) = @$entry;
+ if ($map[$y][$x] =~ /\d/) {
+ $dist{$duct}{$&} = $dist;
+ say "dist $duct -> $& = $dist";
+ return if (++$ducts_seen >= @ducts);
+ }
+ for ([0, 1], [0, -1], [1, 0], [-1, 0]) {
+ my $dx = $x + $_->[0];
+ my $dy = $y + $_->[1];
+ next if $dx < 0 || $dx > $xmax || $dy < 0 || $dy > $ymax
+ || $map[$y][$x] eq '#';
+ next if $seen{$dx,$dy}++;
+ push @q, [ $dx, $dy, $dist+1];
+ }
+ }
+}
+
+walk($_) for 0 .. 7;
+
+my $min_dist;
+
+sub perm {
+ my ($dist, $now, @rest) = @_;
+ if (!@rest) {
+ $dist += $dist{$now}{0};
+ $min_dist = $dist if !defined $min_dist || $dist < $min_dist;
+ }
+ for my $i (0 .. $#rest) {
+ my @nr = @rest;
+ my $duct = splice @nr, $i, 1;
+ perm($dist + $dist{$now}{$duct}, $duct, @nr);
+ }
+}
+
+perm(0, 0 .. 7);
+
+say $min_dist;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use v5.16;
+
+my @code = map { chomp; [ split /\s+/ ] } <>;
+
+my $start = -1;
+STARTVAL:
+while (1) {
+ my %regs = (a => ++$start, b => 0, c => 0, d => 0);
+
+ say "Trying $start";
+
+ my $ip = 0;
+ my %state;
+
+ my $debug = 0;
+ my $nouts = 0;
+
+ while ($ip < @code) {
+ say join(' ', $ip, @{ $code[$ip] }, map { "$_=$regs{$_}" } sort keys %regs)
+ if $debug;
+ my $key = join(',', $ip, map { $regs{$_} } qw(a b c d));
+ if (defined $state{$key} && $nouts > $state{$key}
+ && ($nouts - $state{$key}) % 2 == 0) {
+ say $start;
+ exit 0;
+ }
+ $state{$key} = $nouts;
+ $debug = 0;
+ my @ins = @{ $code[$ip] };
+ if ($ins[0] eq 'cpy') {
+ my $val = $ins[1];
+ my $reg = $ins[2];
+ $val = $regs{$val} if $val =~ /[a-z]/;
+ $regs{$reg} = $val;
+ } elsif ($ins[0] eq 'inc') {
+ $regs{$ins[1]}++;
+ } elsif ($ins[0] eq 'dec') {
+ $regs{$ins[1]}--;
+ } elsif ($ins[0] eq 'jnz') {
+ my ($reg, $val) = @ins[1..2];
+ if ($val eq '-2' && $ip >= 2 && $code[$ip-1][0] eq 'dec'
+ && $code[$ip-2][0] eq 'inc'
+ && $code[$ip-1][1] eq $reg) {
+ $regs{$code[$ip-2][1]} += $regs{$reg};
+ $regs{$reg} = 0;
+ }
+ $val = $regs{$val} if $val =~ /[a-z]/;
+ $reg = $regs{$reg} if $reg =~ /[a-z]/;
+ if ($reg) {
+ $ip += $val - 1;
+ }
+ } elsif ($ins[0] eq 'out') {
+ my $val = $ins[1];
+ $val = $regs{$val} if $val =~ /[a-z]/;
+ if ($val != ($nouts & 1)) {
+ next STARTVAL;
+ }
+ $nouts++;
+ } else {
+ say "Unknown instrution: $_";
+ }
+ $ip++;
+ }
+}
+
--- /dev/null
+#!/bin/bash
+
+DAY=`date +%d|sed 's/ //g'`
+test -n "$1" && DAY="$1"
+FILE="$((2*DAY - 1))in.txt"
+COOKIE=`cat cookie`
+
+START="6:00:02"
+MAXWAIT=300
+STARTSEC=`date -d "$START" "+%s"`
+NOW=`date "+%s"`
+WAITSEC=`expr $STARTSEC - $NOW`
+
+if [ $WAITSEC -gt 0 -a $WAITSEC -lt $MAXWAIT ]
+then
+ echo "Waiting for $WAITSEC seconds till $START for getting $FILE ..."
+ sleep $WAITSEC
+fi
+
+URL="https://adventofcode.com/2016/day/$DAY/input"
+echo
+echo "Downloading $URL to $FILE"
+curl -s -b "$COOKIE" "$URL" --output "$FILE"
+echo ========================================================================
+cat "$FILE"
+echo ========================================================================
+echo "lines words chars"
+wc "$FILE"
+echo
https://www.fi.muni.cz/~kas/git / aoc.git / commitdiff