--- /dev/null
+#!/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#
+ #########
+
+
+
+
+
+
+
+
+
+