45.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.16;
   4
   5 #  ab c d e fg
   6 #    h j l n
   7 #    i k m o
   8
   9 my %g = (
  10         'h' => {
  11                 'a' => [ 3, 'b' ],
  12                 'b' => [ 2, '' ],
  13                 'c' => [ 2, '' ],
  14                 'd' => [ 4, 'c' ],
  15                 'e' => [ 6, 'cd' ],
  16                 'f' => [ 8, 'cde' ],
  17                 'g' => [ 9, 'cdef' ],
  18         },
  19         'i' => {
  20                 'a' => [ 4, 'bh' ],
  21                 'b' => [ 3, 'h' ],
  22                 'c' => [ 3, 'h' ],
  23                 'd' => [ 5, 'ch' ],
  24                 'e' => [ 7, 'cdh' ],
  25                 'f' => [ 9, 'cdeh' ],
  26                 'g' => [ 10, 'cdefh' ],
  27         },
  28         'j' => {
  29                 'a' => [ 5, 'bc' ],
  30                 'b' => [ 4, 'c' ],
  31                 'c' => [ 2, '' ],
  32                 'd' => [ 2, '' ],
  33                 'e' => [ 4, 'd' ],
  34                 'f' => [ 6, 'de' ],
  35                 'g' => [ 7, 'def' ],
  36         },
  37         'k' => {
  38                 'a' => [ 6, 'bcj' ],
  39                 'b' => [ 5, 'cj' ],
  40                 'c' => [ 3, 'j' ],
  41                 'd' => [ 3, 'j' ],
  42                 'e' => [ 5, 'dj' ],
  43                 'f' => [ 7, 'dej' ],
  44                 'g' => [ 8, 'defj' ],
  45         },
  46         'l' => {
  47                 'a' => [ 7, 'bcd' ],
  48                 'b' => [ 6, 'cd' ],
  49                 'c' => [ 4, 'd' ],
  50                 'd' => [ 2, '' ],
  51                 'e' => [ 2, '' ],
  52                 'f' => [ 4, 'e' ],
  53                 'g' => [ 6, 'ef' ],
  54         },
  55         'm' => {
  56                 'a' => [ 8, 'bcdl' ],
  57                 'b' => [ 7, 'cdl' ],
  58                 'c' => [ 5, 'dl' ],
  59                 'd' => [ 3, 'l' ],
  60                 'e' => [ 3, 'l' ],
  61                 'f' => [ 5, 'el' ],
  62                 'g' => [ 7, 'efl' ],
  63         },
  64         'n' => {
  65                 'a' => [ 9, 'bcde' ],
  66                 'b' => [ 8, 'cde' ],
  67                 'c' => [ 6, 'de' ],
  68                 'd' => [ 4, 'e' ],
  69                 'e' => [ 2, '' ],
  70                 'f' => [ 2, '' ],
  71                 'g' => [ 3, 'f' ],
  72         },
  73         'o' => {
  74                 'a' => [ 10, 'bcden' ],
  75                 'b' => [ 9, 'cden' ],
  76                 'c' => [ 7, 'den' ],
  77                 'd' => [ 5, 'en' ],
  78                 'e' => [ 3, 'n' ],
  79                 'f' => [ 3, 'n' ],
  80                 'g' => [ 4, 'fn' ],
  81         },
  82 );
  83
  84 for my $node (keys %g) {
  85         for my $n2 (keys %{ $g{$node} }) {
  86                 $g{$n2}->{$node} = $g{$node}->{$n2};
  87         }
  88 }
  89
  90 my %home = (
  91         h => 'A',
  92         i => 'A',
  93         j => 'B',
  94         k => 'B',
  95         l => 'C',
  96         m => 'C',
  97         n => 'D',
  98         o => 'D',
  99 );
 100
 101 my %otherhome = (
 102         h => 'i',
 103         j => 'k',
 104         l => 'm',
 105         n => 'o',
 106 );
 107 %otherhome = (%otherhome, reverse %otherhome);
 108
 109 my %cost_of = (
 110         A => 1,
 111         B => 10,
 112         C => 100,
 113         D => 1000,
 114 );
 115
 116 my @type = qw( A A B B C C D D );
 117
 118 sub can_move {
 119         my ($pos, $who, $dst) = @_;
 120         my $i = 0;
 121         my %rpos = map { $_ => $i++ } @$pos;
 122         my $src = $pos->[$who];
 123         my $mytype = $type[$who];
 124         return 0 if defined $rpos{$dst}; # occupied
 125         return 0 if !$home{$src} && !$home{$dst}; # cant move in a hallway
 126         if ($home{$dst}) {
 127                 return 0 if $home{$dst} ne $mytype; # not own home
 128                 my $other = $otherhome{$dst};
 129                 return 0 if defined $rpos{$other} && $type[$rpos{$other}] ne $mytype;
 130                 return 0 if $other gt $dst && !defined $rpos{$other};
 131         }
 132
 133         # path exists?
 134         my $c = $g{$src}->{$dst};
 135         return 0 if !$c;
 136
 137         # path occupied?
 138         for my $in (split //, $c->[1]) {
 139                 return 0 if $rpos{$in};
 140         }
 141
 142         # say "can_move $who$type[$who]=>$dst ", join(',', keys %rpos);
 143         return $c->[0];
 144 }
 145
 146 my %pos_seen;
 147 my $min_cost = 100_000;
 148 sub walk {
 149         my ($pos, $moved, $cost, $moves) = @_;
 150         my $key = join(' ', @$pos, $cost);
 151         return if $pos_seen{$key}++;
 152         my $athome = 0;
 153         # say "walk ", join(' ', @$pos), " cost $cost";
 154         for my $i (0 .. $#$pos) {
 155                 my @dsts;
 156                 if (!$moved->{$i}) {
 157                         @dsts = 'a' .. 'g';
 158                 } elsif ($moved->{$i} == 1) {
 159                         @dsts = grep { $home{$_} eq $type[$i] } keys %home;
 160                 } else {
 161                         $athome++;
 162                 }
 163                 for my $dst (@dsts) {
 164                         my $acost = can_move($pos, $i, $dst);
 165                         next if !$acost;
 166                         $acost *= $cost_of{$type[$i]};
 167                         next if $cost + $acost >= $min_cost;
 168
 169                         my @npos = @$pos;
 170                         $npos[$i] = $dst;
 171
 172                         my %nmoved = %$moved;
 173                         $nmoved{$i}++;
 174
 175                         my @nmoves = @$moves;
 176                         push @nmoves, "$i$type[$i]=>$dst $acost";
 177
 178                         walk(\@npos, \%nmoved, $cost + $acost, \@nmoves);
 179                 }
 180         }
 181         if ($athome == 8) {
 182                 if (!$min_cost || $cost < $min_cost) {
 183                         $min_cost = $cost;
 184                         say "athome = $athome cost $cost $min_cost: ",
 185                                 join(', ', @$moves);
 186                 }
 187         }
 188 }
 189
 190
 191 walk( [qw( h k i l j o m n )], {}, 0, [ ]);
 192 # walk( [qw( i o h l j m k n )], { 0 => 2, 5 => 2 }, 0, [ ]);
 193
 194 #############
 195 #...........#
 196 ###B#C#B#D###
 197   #A#D#C#A#
 198   #########
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208