Day 23: too long, too complicated. Do not read this.

diff --git a/45.pl b/45.pl
new file mode 100755 (executable)
index 0000000..b5ff0b9
--- /dev/null
+++ b/45.pl
@@ -0,0 +1,208 @@
+#!/usr/bin/perl -w
+
+use v5.16;
+
+#  ab c d e fg
+#    h j l n
+#    i k m o
+
+my %g = (
+       'h' => {
+               'a' => [ 3, 'b' ],
+               'b' => [ 2, '' ],
+               'c' => [ 2, '' ],
+               'd' => [ 4, 'c' ],
+               'e' => [ 6, 'cd' ],
+               'f' => [ 8, 'cde' ],
+               'g' => [ 9, 'cdef' ],
+       },
+       'i' => {
+               'a' => [ 4, 'bh' ],
+               'b' => [ 3, 'h' ],
+               'c' => [ 3, 'h' ],
+               'd' => [ 5, 'ch' ],
+               'e' => [ 7, 'cdh' ],
+               'f' => [ 9, 'cdeh' ],
+               'g' => [ 10, 'cdefh' ],
+       },
+       'j' => {
+               'a' => [ 5, 'bc' ],
+               'b' => [ 4, 'c' ],
+               'c' => [ 2, '' ],
+               'd' => [ 2, '' ],
+               'e' => [ 4, 'd' ],
+               'f' => [ 6, 'de' ],
+               'g' => [ 7, 'def' ],
+       },
+       'k' => {
+               'a' => [ 6, 'bcj' ],
+               'b' => [ 5, 'cj' ],
+               'c' => [ 3, 'j' ],
+               'd' => [ 3, 'j' ],
+               'e' => [ 5, 'dj' ],
+               'f' => [ 7, 'dej' ],
+               'g' => [ 8, 'defj' ],
+       },
+       'l' => {
+               'a' => [ 7, 'bcd' ],
+               'b' => [ 6, 'cd' ],
+               'c' => [ 4, 'd' ],
+               'd' => [ 2, '' ],
+               'e' => [ 2, '' ],
+               'f' => [ 4, 'e' ],
+               'g' => [ 6, 'ef' ],
+       },
+       'm' => {
+               'a' => [ 8, 'bcdl' ],
+               'b' => [ 7, 'cdl' ],
+               'c' => [ 5, 'dl' ],
+               'd' => [ 3, 'l' ],
+               'e' => [ 3, 'l' ],
+               'f' => [ 5, 'el' ],
+               'g' => [ 7, 'efl' ],
+       },
+       'n' => {
+               'a' => [ 9, 'bcde' ],
+               'b' => [ 8, 'cde' ],
+               'c' => [ 6, 'de' ],
+               'd' => [ 4, 'e' ],
+               'e' => [ 2, '' ],
+               'f' => [ 2, '' ],
+               'g' => [ 3, 'f' ],
+       },
+       'o' => {
+               'a' => [ 10, 'bcden' ],
+               'b' => [ 9, 'cden' ],
+               'c' => [ 7, 'den' ],
+               'd' => [ 5, 'en' ],
+               'e' => [ 3, 'n' ],
+               'f' => [ 3, 'n' ],
+               'g' => [ 4, 'fn' ],
+       },
+);
+
+for my $node (keys %g) {
+       for my $n2 (keys %{ $g{$node} }) {
+               $g{$n2}->{$node} = $g{$node}->{$n2};
+       }
+}
+
+my %home = (
+       h => 'A',
+       i => 'A',
+       j => 'B',
+       k => 'B',
+       l => 'C',
+       m => 'C',
+       n => 'D',
+       o => 'D',
+);
+
+my %otherhome = (
+       h => 'i',
+       j => 'k',
+       l => 'm',
+       n => 'o',
+);
+%otherhome = (%otherhome, reverse %otherhome);
+
+my %cost_of = (
+       A => 1,
+       B => 10,
+       C => 100,
+       D => 1000,
+);
+
+my @type = qw( A A B B C C D D );
+
+sub can_move {
+       my ($pos, $who, $dst) = @_;
+       my $i = 0;
+       my %rpos = map { $_ => $i++ } @$pos;
+       my $src = $pos->[$who];
+       my $mytype = $type[$who];
+       return 0 if defined $rpos{$dst}; # occupied
+       return 0 if !$home{$src} && !$home{$dst}; # cant move in a hallway
+       if ($home{$dst}) {
+               return 0 if $home{$dst} ne $mytype; # not own home
+               my $other = $otherhome{$dst};
+               return 0 if defined $rpos{$other} && $type[$rpos{$other}] ne $mytype;
+               return 0 if $other gt $dst && !defined $rpos{$other};
+       }
+
+       # path exists?
+       my $c = $g{$src}->{$dst};
+       return 0 if !$c;
+
+       # path occupied?
+       for my $in (split //, $c->[1]) {
+               return 0 if $rpos{$in};
+       }
+
+       # say "can_move $who$type[$who]=>$dst ", join(',', keys %rpos);
+       return $c->[0];
+}
+
+my %pos_seen;
+my $min_cost = 100_000;
+sub walk {
+       my ($pos, $moved, $cost, $moves) = @_;
+       my $key = join(' ', @$pos, $cost);
+       return if $pos_seen{$key}++;
+       my $athome = 0;
+       # say "walk ", join(' ', @$pos), " cost $cost";
+       for my $i (0 .. $#$pos) {
+               my @dsts; 
+               if (!$moved->{$i}) {
+                       @dsts = 'a' .. 'g';
+               } elsif ($moved->{$i} == 1) {
+                       @dsts = grep { $home{$_} eq $type[$i] } keys %home;
+               } else {
+                       $athome++;
+               }
+               for my $dst (@dsts) {
+                       my $acost = can_move($pos, $i, $dst);
+                       next if !$acost;
+                       $acost *= $cost_of{$type[$i]};
+                       next if $cost + $acost >= $min_cost;
+
+                       my @npos = @$pos;
+                       $npos[$i] = $dst;
+
+                       my %nmoved = %$moved;
+                       $nmoved{$i}++;
+
+                       my @nmoves = @$moves;
+                       push @nmoves, "$i$type[$i]=>$dst $acost";
+                       
+                       walk(\@npos, \%nmoved, $cost + $acost, \@nmoves);
+               }
+       }
+       if ($athome == 8) {
+               if (!$min_cost || $cost < $min_cost) {
+                       $min_cost = $cost;
+                       say "athome = $athome cost $cost $min_cost: ",
+                               join(', ', @$moves);
+               }
+       }
+}
+
+
+walk( [qw( h k i l j o m n )], {}, 0, [ ]);
+# walk( [qw( i o h l j m k n )], { 0 => 2, 5 => 2 }, 0, [ ]);
+
+#############
+#...........#
+###B#C#B#D###
+  #A#D#C#A#
+  #########
+
+
+
+                       
+                       
+               
+                       
+               
+
+

diff --git a/46.pl b/46.pl
new file mode 100755 (executable)
index 0000000..4cacd82
--- /dev/null
+++ b/46.pl
@@ -0,0 +1,264 @@
+#!/usr/bin/perl -w
+
+use v5.16;
+
+#  ab c d e fg
+#    h l p t
+#    i m q u
+#    j n r v
+#    k o s w
+
+my %g = (
+       'h' => {
+               'a' => [ 3, 'b' ],
+               'b' => [ 2, '' ],
+               'c' => [ 2, '' ],
+               'd' => [ 4, 'c' ],
+               'e' => [ 6, 'cd' ],
+               'f' => [ 8, 'cde' ],
+               'g' => [ 9, 'cdef' ],
+       },
+       'l' => {
+               'a' => [ 5, 'bc' ],
+               'b' => [ 4, 'c' ],
+               'c' => [ 2, '' ],
+               'd' => [ 2, '' ],
+               'e' => [ 4, 'd' ],
+               'f' => [ 6, 'de' ],
+               'g' => [ 7, 'def' ],
+       },
+       'p' => {
+               'a' => [ 7, 'bcd' ],
+               'b' => [ 6, 'cd' ],
+               'c' => [ 4, 'd' ],
+               'd' => [ 2, '' ],
+               'e' => [ 2, '' ],
+               'f' => [ 4, 'e' ],
+               'g' => [ 6, 'ef' ],
+       },
+       't' => {
+               'a' => [ 9, 'bcde' ],
+               'b' => [ 8, 'cde' ],
+               'c' => [ 6, 'de' ],
+               'd' => [ 4, 'e' ],
+               'e' => [ 2, '' ],
+               'f' => [ 2, '' ],
+               'g' => [ 3, 'f' ],
+       },
+);
+
+for my $n1 (keys %g) {
+       my $prevnodes = $n1;
+       for my $i (1..3) {
+               my $n2 = chr(ord($n1)+$i);
+               for my $n3 (keys %{ $g{$n1} }) {
+                       my $c = $g{$n1}->{$n3};
+                       $g{$n2}->{$n3} = [ $c->[0] + $i, $c->[1].$prevnodes ];
+               }
+               $prevnodes .= $n2;
+       }
+}
+
+# symmetric
+for my $node (keys %g) {
+       for my $n2 (keys %{ $g{$node} }) {
+               $g{$n2}->{$node} = $g{$node}->{$n2};
+       }
+}
+
+my %home = (
+       h => 'A',
+       l => 'B',
+       p => 'C',
+       t => 'D',
+);
+
+my %lowerhome;
+for my $n1 (keys %home) {
+       for (1..3) {
+               my $n2 = chr(ord($n1)+$_);
+               $home{$n2} = $home{$n1};
+       }
+}
+
+my %home_of = (
+       A => [ 'h' .. 'k' ],
+       B => [ 'l' .. 'o' ],
+       C => [ 'p' .. 's' ],
+       D => [ 't' .. 'w' ],
+);
+
+my %cost_of = (
+       A => 1,
+       B => 10,
+       C => 100,
+       D => 1000,
+);
+
+my @type = qw( A A A A B B B B C C C C D D D D );
+
+sub can_move {
+       my ($pos, $who, $dst) = @_;
+       my $i = 0;
+       my %rpos = map { $_ => $i++ } @$pos;
+       my $src = $pos->[$who];
+       my $mytype = $type[$who];
+       return 0 if defined $rpos{$dst}; # occupied
+       return 0 if !$home{$src} && !$home{$dst}; # cant move in a hallway
+
+       # path exists?
+       my $c = $g{$src}->{$dst};
+       return 0 if !$c;
+
+       # path occupied?
+       for my $in (split //, $c->[1]) {
+               return 0 if defined $rpos{$in};
+       }
+
+       # say "can_move $who$type[$who]=>$dst ", join(',', keys %rpos);
+       return $c->[0];
+}
+
+sub gen_pos {
+       my ($pos) = @_;
+       my $text = <<'EOF';
+#############
+#ab.c.d.e.fg#
+###h#l#p#t###
+  #i#m#q#u#
+  #j#n#r#v#
+  #k#o#s#w#
+  #########
+EOF
+       for my $i (0 .. $#$pos) {
+               $text =~ s/$pos->[$i]/$type[$i]/gxms;
+       }
+       $text =~ s/[a-z]/./gxms;
+       return join('', @$pos) . "\n" .$text;
+}
+
+sub print_pos { say gen_pos(shift) }
+
+my %pos_seen;
+my $min_cost = 100_000;
+sub walk {
+       my ($pos, $moved, $can_move, $free_home, $cost, $moves) = @_;
+
+       my $key = join(' ', @$pos, $cost);
+       return if $pos_seen{$key}++;
+
+       my $finished = grep { $moved->{$_} && $moved->{$_} == 2 } 0 .. $#$pos;
+       my $stepped =  grep { $moved->{$_} && $moved->{$_} == 1 } 0 .. $#$pos;
+       # say "stepped $stepped, finished: $finished";
+       if ($finished == @$pos) {
+               if (!$min_cost || $cost < $min_cost) {
+                       $min_cost = $cost;
+                       say "cost $cost $min_cost: ", @$moves;
+               }
+       }
+
+       my $x = 0;
+       my %rpos = map { $_ => $x++ } @$pos;
+
+if (0) {
+       say "walk ", join(' ', @$pos), " cost $cost, can_move = ",
+               join(',', keys %$can_move),
+               " free_home = ", join(',', keys %$free_home);
+       print_pos($pos);
+}
+
+       for my $i (grep { !$moved->{$_} } keys %$can_move) {
+               my @dsts;
+
+               my %nmoved = %$moved;
+               my %ncan_move = %$can_move;
+               my %nfree_home = %$free_home;
+
+               my $mypos = $pos->[$i];
+               my $mytype = $type[$i];
+
+               $nmoved{$i}++;
+
+               delete $ncan_move{$i};
+               my $under = chr(ord($mypos)+1);
+               if (defined $home{$under} && $home{$mypos} eq $home{$under}
+                       && !$moved->{$rpos{$under}}) { 
+                       $ncan_move{$rpos{$under}} = 1;
+               } else {
+                       $nfree_home{$home{$mypos}} = $mypos;
+               }
+               for my $dst (grep { !defined $rpos{$_} } 'a' .. 'g') {
+                       my $acost = can_move($pos, $i, $dst);
+                       next if !$acost;
+                       $acost *= $cost_of{$type[$i]};
+                       next if $cost + $acost >= $min_cost;
+
+                       my @npos = @$pos;
+                       $npos[$i] = $dst;
+
+                       my @nmoves = @$moves;
+                       push @nmoves, "$i$type[$i]$pos->[$i]=>$dst $acost\n" . gen_pos($pos) . "\n";
+                       
+                       # print_pos($pos);
+                       # say $nmoves[-1];
+                       walk(\@npos, \%nmoved, \%ncan_move, \%nfree_home, $cost + $acost, \@nmoves);
+               }
+       }
+
+       for my $i (grep { $moved->{$_} && $moved->{$_} == 1 } keys %$moved) {
+               my $mypos = $pos->[$i];
+               my $mytype = $type[$i];
+               next if !$free_home->{$mytype};
+               my $dst = $free_home->{$mytype};
+
+               my $acost = can_move($pos, $i, $dst);
+               next if !$acost;
+               $acost *= $cost_of{$type[$i]};
+               next if $cost + $acost >= $min_cost;
+
+               my %nmoved = %$moved;
+               my %ncan_move = %$can_move;
+               my %nfree_home = %$free_home;
+
+               $nmoved{$i}++;
+
+               delete $nfree_home{$mytype};
+               my $above = chr(ord($dst)-1);
+               if ($home{$above} && $home{$above} eq $mytype) {
+                       $nfree_home{$mytype} = $above;
+               }
+
+               delete $ncan_move{$i};
+               
+               my @npos = @$pos;
+               $npos[$i] = $dst;
+
+               my @nmoves = @$moves;
+               push @nmoves, "$i$type[$i]$pos->[$i]=>$dst $acost\n" . gen_pos($pos) . "\n";
+               # say "xxx ", $nmoves[-1];
+               # print_pos($pos);
+               walk(\@npos, \%nmoved, \%ncan_move, \%nfree_home, $cost + $acost, \@nmoves);
+       }
+
+       # say "return";
+}
+
+my $prod = 1;
+#          A A A A B B B B C C C C D D D D
+walk( [qw( h o r u k n p q l m v w i j s t )],
+       {},
+       { map { $_ => 1 } qw(0 8 6 15) },
+       {},
+       0, [ ]) if $prod;
+walk( [qw( k r u w h n p q l m s v i j o t )],
+       { 0 => 2, 10 => 2 },
+       { map { $_ => 1 } qw(4 8 6 15) },
+       { },
+       0, [ ]) if !$prod;
+
+say $min_cost;
+#############
+#...........#
+###B#C#B#D###
+  #A#D#C#A#
+  #########