added transition matrix version

1 files changed, 45 insertions, 13 deletions

diff --git a/challenge-118/james-smith/perl/ch-2.pl b/challenge-118/james-smith/perl/ch-2.pl
index 358b7a1f64..8c7c1a0163 100644
--- a/challenge-118/james-smith/perl/ch-2.pl
+++ b/challenge-118/james-smith/perl/ch-2.pl
@@ -9,6 +9,7 @@ use Benchmark qw(cmpthese timethis);
 use Data::Dumper qw(Dumper);
 
 my @dir = ([-2,1],[2,1],[-2,-1],[2,-1],[-1,2],[1,2],[-1,-2],[1,-2]);
+my $trans = get_trans();
 
 my @treasures = qw(a2 b1 b2 b3 c4 e6);
 my( $sol, $best_len, $best_rt ) = ( 0, 65 );
@@ -31,7 +32,7 @@ $sol |= 1 <<  8 * (substr $_,1) - 105 + ord $_ foreach @treasures;
 ## to bytes using chr/ord.
 
 
-walk( 0, 7, 0, q() );   ## Walk the tree starting from top-left
+walk_trans( 56, 0, q() );   ## Walk the tree starting from top-left
 
 say '';
 say "Treasures: @treasures";
@@ -40,8 +41,9 @@ say 'Route:     ',show_rt( $best_rt ); ## Show best route
 say '';
 
 cmpthese( 20, {
-  'walk'     => sub { $best_len=65; walk(     0, 7, 0, q() ); show_rt($best_rt); },
-  'walk_opt' => sub { $best_len=65; walk_opt( 0, 7, 0, q() ); show_rt($best_rt); },
+  'walk'       => sub { $best_len=65; walk(        0, 7, 0, q() ); show_rt($best_rt); },
+  'walk_opt'   => sub { $best_len=65; walk_opt(    0, 7, 0, q() ); show_rt($best_rt); },
+  'walk_trans' => sub { $best_len=65; walk_trans( 56, 0, q() );   show_rt($best_rt); },
 } );
 
 sub walk {
@@ -58,15 +60,6 @@ sub walk {
   walk( $x + $_->[0], $y + $_->[1], $seen, $rt ) foreach @dir;
 }
 
-sub show_rt {
-  my %t = map { $_ => 1 } @treasures;
-  return join q( ),
-         map        { $_.( exists $t{$_} ? q(*) : q( ) ) }
-         map        { chr( 97 + ($_&7) ).( 1 + ($_>>3) ) }
-         map        { ord $_                             }
-         split m{}, shift;
-}
-
 sub walk_opt {
   my( $x, $y, $seen, $rt ) = @_;
   ## Skip if the new "chain" will be bigger than the best chain so far
@@ -75,7 +68,7 @@ sub walk_opt {
   return if $seen & ( my $v = 1 << (my$t=$x+$y*8) );
   $seen |= $v;
   $rt   .= chr $t;
-  return ($best_rt,$best_len) = ($rt,-1+length $rt) if ($seen & $sol) == $sol;
+  return (($best_rt,$best_len) = ($rt,-1+length $rt)) if ($seen & $sol) == $sol;
   return if $best_len <= length $rt;
   walk_opt( $x-2, $y+1, $seen, $rt ) if $x>1 && $y<7;
   walk_opt( $x+2, $y+1, $seen, $rt ) if $x<6 && $y<7;
@@ -87,3 +80,42 @@ sub walk_opt {
   walk_opt( $x+1, $y-2, $seen, $rt ) if $x<7 && $y>1;
 }
 
+sub show_rt {
+  my %t = map { $_ => 1 } @treasures;
+  return join q( ),
+         map        { $_.( exists $t{$_} ? q(*) : q( ) ) }
+         map        { chr( 97 + ($_&7) ).( 1 + ($_>>3) ) }
+         map        { ord $_                             }
+         split m{}, shift;
+}
+
+sub walk_trans {
+  my( $t, $seen, $rt ) = @_;
+  ## Skip if the new "chain" will be bigger than the best chain so far
+  ## If we have fallen off the sides of the board
+  ## Or if we have already visited the square.
+  return if $seen & ( my $v = 1 << $t );
+  $seen |= $v;
+  $rt   .= chr $t;
+  return ($best_rt,$best_len) = ($rt,-1+length $rt) if ($seen & $sol) == $sol;
+  return if $best_len <= length $rt;
+  walk_trans( $_, $seen, $rt ) foreach @{$trans->[$t]};
+}
+
+sub get_trans {
+  my $q=[];
+  foreach my $y (0..7) {
+    foreach my $x (0..7) {
+      my $l = $x + $y * 8;
+      push @{ $q->[$l] }, $l + 6  if $y<7 && $x > 1;
+      push @{ $q->[$l] }, $l + 10 if $y<7 && $x < 6;
+      push @{ $q->[$l] }, $l - 6  if $y>0 && $x < 6;
+      push @{ $q->[$l] }, $l - 10 if $y>0 && $x > 1;
+      push @{ $q->[$l] }, $l + 15 if $y<6 && $x > 0;
+      push @{ $q->[$l] }, $l + 17 if $y<6 && $x < 7;
+      push @{ $q->[$l] }, $l - 15 if $y>1 && $x < 7;
+      push @{ $q->[$l] }, $l - 17 if $y>1 && $x > 0;
+    }
+  }
+  return $q;
+}