46.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.16;
   4
   5 #  ab c d e fg
   6 #    h l p t
   7 #    i m q u
   8 #    j n r v
   9 #    k o s w
  10
  11 my %g = (
  12         'h' => {
  13                 'a' => [ 3, 'b' ],
  14                 'b' => [ 2, '' ],
  15                 'c' => [ 2, '' ],
  16                 'd' => [ 4, 'c' ],
  17                 'e' => [ 6, 'cd' ],
  18                 'f' => [ 8, 'cde' ],
  19                 'g' => [ 9, 'cdef' ],
  20         },
  21         'l' => {
  22                 'a' => [ 5, 'bc' ],
  23                 'b' => [ 4, 'c' ],
  24                 'c' => [ 2, '' ],
  25                 'd' => [ 2, '' ],
  26                 'e' => [ 4, 'd' ],
  27                 'f' => [ 6, 'de' ],
  28                 'g' => [ 7, 'def' ],
  29         },
  30         'p' => {
  31                 'a' => [ 7, 'bcd' ],
  32                 'b' => [ 6, 'cd' ],
  33                 'c' => [ 4, 'd' ],
  34                 'd' => [ 2, '' ],
  35                 'e' => [ 2, '' ],
  36                 'f' => [ 4, 'e' ],
  37                 'g' => [ 6, 'ef' ],
  38         },
  39         't' => {
  40                 'a' => [ 9, 'bcde' ],
  41                 'b' => [ 8, 'cde' ],
  42                 'c' => [ 6, 'de' ],
  43                 'd' => [ 4, 'e' ],
  44                 'e' => [ 2, '' ],
  45                 'f' => [ 2, '' ],
  46                 'g' => [ 3, 'f' ],
  47         },
  48 );
  49
  50 for my $n1 (keys %g) {
  51         my $prevnodes = $n1;
  52         for my $i (1..3) {
  53                 my $n2 = chr(ord($n1)+$i);
  54                 for my $n3 (keys %{ $g{$n1} }) {
  55                         my $c = $g{$n1}->{$n3};
  56                         $g{$n2}->{$n3} = [ $c->[0] + $i, $c->[1].$prevnodes ];
  57                 }
  58                 $prevnodes .= $n2;
  59         }
  60 }
  61
  62 # symmetric
  63 for my $node (keys %g) {
  64         for my $n2 (keys %{ $g{$node} }) {
  65                 $g{$n2}->{$node} = $g{$node}->{$n2};
  66         }
  67 }
  68
  69 my %home = (
  70         h => 'A',
  71         l => 'B',
  72         p => 'C',
  73         t => 'D',
  74 );
  75
  76 my %lowerhome;
  77 for my $n1 (keys %home) {
  78         for (1..3) {
  79                 my $n2 = chr(ord($n1)+$_);
  80                 $home{$n2} = $home{$n1};
  81         }
  82 }
  83
  84 my %home_of = (
  85         A => [ 'h' .. 'k' ],
  86         B => [ 'l' .. 'o' ],
  87         C => [ 'p' .. 's' ],
  88         D => [ 't' .. 'w' ],
  89 );
  90
  91 my %cost_of = (
  92         A => 1,
  93         B => 10,
  94         C => 100,
  95         D => 1000,
  96 );
  97
  98 my @type = qw( A A A A B B B B C C C C D D D D );
  99
 100 sub can_move {
 101         my ($pos, $who, $dst) = @_;
 102         my $i = 0;
 103         my %rpos = map { $_ => $i++ } @$pos;
 104         my $src = $pos->[$who];
 105         my $mytype = $type[$who];
 106         return 0 if defined $rpos{$dst}; # occupied
 107         return 0 if !$home{$src} && !$home{$dst}; # cant move in a hallway
 108
 109         # path exists?
 110         my $c = $g{$src}->{$dst};
 111         return 0 if !$c;
 112
 113         # path occupied?
 114         for my $in (split //, $c->[1]) {
 115                 return 0 if defined $rpos{$in};
 116         }
 117
 118         # say "can_move $who$type[$who]=>$dst ", join(',', keys %rpos);
 119         return $c->[0];
 120 }
 121
 122 sub gen_pos {
 123         my ($pos) = @_;
 124         my $text = <<'EOF';
 125 #############
 126 #ab.c.d.e.fg#
 127 ###h#l#p#t###
 128   #i#m#q#u#
 129   #j#n#r#v#
 130   #k#o#s#w#
 131   #########
 132 EOF
 133         for my $i (0 .. $#$pos) {
 134                 $text =~ s/$pos->[$i]/$type[$i]/gxms;
 135         }
 136         $text =~ s/[a-z]/./gxms;
 137         return join('', @$pos) . "\n" .$text;
 138 }
 139
 140 sub print_pos { say gen_pos(shift) }
 141
 142 my %pos_seen;
 143 my $min_cost = 100_000;
 144 sub walk {
 145         my ($pos, $moved, $can_move, $free_home, $cost, $moves) = @_;
 146
 147         my $key = join(' ', @$pos, $cost);
 148         return if $pos_seen{$key}++;
 149
 150         my $finished = grep { $moved->{$_} && $moved->{$_} == 2 } 0 .. $#$pos;
 151         my $stepped =  grep { $moved->{$_} && $moved->{$_} == 1 } 0 .. $#$pos;
 152         # say "stepped $stepped, finished: $finished";
 153         if ($finished == @$pos) {
 154                 if (!$min_cost || $cost < $min_cost) {
 155                         $min_cost = $cost;
 156                         say "cost $cost $min_cost: ", @$moves;
 157                 }
 158         }
 159
 160         my $x = 0;
 161         my %rpos = map { $_ => $x++ } @$pos;
 162
 163 if (0) {
 164         say "walk ", join(' ', @$pos), " cost $cost, can_move = ",
 165                 join(',', keys %$can_move),
 166                 " free_home = ", join(',', keys %$free_home);
 167         print_pos($pos);
 168 }
 169
 170         for my $i (grep { !$moved->{$_} } keys %$can_move) {
 171                 my @dsts;
 172
 173                 my %nmoved = %$moved;
 174                 my %ncan_move = %$can_move;
 175                 my %nfree_home = %$free_home;
 176
 177                 my $mypos = $pos->[$i];
 178                 my $mytype = $type[$i];
 179
 180                 $nmoved{$i}++;
 181
 182                 delete $ncan_move{$i};
 183                 my $under = chr(ord($mypos)+1);
 184                 if (defined $home{$under} && $home{$mypos} eq $home{$under}
 185                         && !$moved->{$rpos{$under}}) {
 186                         $ncan_move{$rpos{$under}} = 1;
 187                 } else {
 188                         $nfree_home{$home{$mypos}} = $mypos;
 189                 }
 190                 for my $dst (grep { !defined $rpos{$_} } 'a' .. 'g') {
 191                         my $acost = can_move($pos, $i, $dst);
 192                         next if !$acost;
 193                         $acost *= $cost_of{$type[$i]};
 194                         next if $cost + $acost >= $min_cost;
 195
 196                         my @npos = @$pos;
 197                         $npos[$i] = $dst;
 198
 199                         my @nmoves = @$moves;
 200                         push @nmoves, "$i$type[$i]$pos->[$i]=>$dst $acost\n" . gen_pos($pos) . "\n";
 201
 202                         # print_pos($pos);
 203                         # say $nmoves[-1];
 204                         walk(\@npos, \%nmoved, \%ncan_move, \%nfree_home, $cost + $acost, \@nmoves);
 205                 }
 206         }
 207
 208         for my $i (grep { $moved->{$_} && $moved->{$_} == 1 } keys %$moved) {
 209                 my $mypos = $pos->[$i];
 210                 my $mytype = $type[$i];
 211                 next if !$free_home->{$mytype};
 212                 my $dst = $free_home->{$mytype};
 213
 214                 my $acost = can_move($pos, $i, $dst);
 215                 next if !$acost;
 216                 $acost *= $cost_of{$type[$i]};
 217                 next if $cost + $acost >= $min_cost;
 218
 219                 my %nmoved = %$moved;
 220                 my %ncan_move = %$can_move;
 221                 my %nfree_home = %$free_home;
 222
 223                 $nmoved{$i}++;
 224
 225                 delete $nfree_home{$mytype};
 226                 my $above = chr(ord($dst)-1);
 227                 if ($home{$above} && $home{$above} eq $mytype) {
 228                         $nfree_home{$mytype} = $above;
 229                 }
 230
 231                 delete $ncan_move{$i};
 232
 233                 my @npos = @$pos;
 234                 $npos[$i] = $dst;
 235
 236                 my @nmoves = @$moves;
 237                 push @nmoves, "$i$type[$i]$pos->[$i]=>$dst $acost\n" . gen_pos($pos) . "\n";
 238                 # say "xxx ", $nmoves[-1];
 239                 # print_pos($pos);
 240                 walk(\@npos, \%nmoved, \%ncan_move, \%nfree_home, $cost + $acost, \@nmoves);
 241         }
 242
 243         # say "return";
 244 }
 245
 246 my $prod = 1;
 247 #          A A A A B B B B C C C C D D D D
 248 walk( [qw( h o r u k n p q l m v w i j s t )],
 249         {},
 250         { map { $_ => 1 } qw(0 8 6 15) },
 251         {},
 252         0, [ ]) if $prod;
 253 walk( [qw( k r u w h n p q l m s v i j o t )],
 254         { 0 => 2, 10 => 2 },
 255         { map { $_ => 1 } qw(4 8 6 15) },
 256         { },
 257         0, [ ]) if !$prod;
 258
 259 say $min_cost;
 260 #############
 261 #...........#
 262 ###B#C#B#D###
 263   #A#D#C#A#
 264   #########