Merge pull request #4333 from drbaggy/master

New transition matrix version.

2 files changed, 230 insertions, 18 deletions

diff --git a/challenge-118/james-smith/README.md b/challenge-118/james-smith/README.md
index a4727b0222..112ab8cc06 100644
--- a/challenge-118/james-smith/README.md
+++ b/challenge-118/james-smith/README.md
@@ -41,13 +41,32 @@ start from the top-left square.***
 
 ## The technique
 
+*To start with I didn't want to look up any "ideal" solution for this
+problem - but start from first principles and see if we can get
+a "brute force" solution to come back in a reasonable time!*
+
 This week unfortunately we are not going to avoid a recursive solution.
 The problem leads us in this direction, as at each step we have to test
 up to 8 "next steps" - the directions of the knight moves.
 
-BUT - to simplify our code solution - we want to avoid a solution which
-requires loops within our recursive function - other than the one which
-looks at the "next" step.
+The brute force algorithm is:
+
+ * check to see if we've visited the square before; stop
+ * update route;
+ * check to see if we've found the solution;
+ * try all moves from the current location;
+
+If we are looking for the shortest route - we can also add a clause which
+says stop if the route we've got is equal to or longer in length than the
+current best route.
+
+### Avoiding loops
+To simplify our code solution, and increase performance we want to
+remove the need for any extraneous loops, and also the use of arrays
+as there are many overheads to using arrays.
+
+We want to avoid a solution which requires loops within our recursive
+function - other than the one which looks at the "next" step.
 
 We note that the chessboard has 64 squares and that Perl has 64-bit
 integers. We note therefore that we can represent the location of an
@@ -116,7 +135,7 @@ square we are in (0..63). We can just store this in an array. But to
 avoid the array overhead instead we can just store it in a byte string,
 using `chr $loc`.
 
-## The solution
+## Our first solution
 
 ### The "main code"
 
@@ -225,7 +244,7 @@ sub show_rt {
 }
 ```
 
-## Aside - let's eek out the speed.
+## Improvement 1 - reduce function calls
 
 There is one place where the code could gain a bit of speed. The
 range checks are performed AFTER the function call not before. We
@@ -261,3 +280,160 @@ sub walk_opt {
   walk_opt( $x+1, $y-2, $seen, $rt ) if $x<7 && $y>1;
 }
 ```
+
+## Improvement 2 - remove some `if`s
+
+So we've remove unecessary loops in our first attempt, in our second we have reduced the number of function calls. So we need to see where we can gain more time...
+
+The only thing left is to reduce the `if` statements in the "heart" of the loop.
+
+Rather than checking to see if a move from one square in a given direction ("transition") is valid each time - we pre-compute the list of moves, and store it in a "transition" matrix. This reduces overall execution time.
+
+So we use the logic above to generate an array where the "key" is the square number and the "value" is an array of square numbers that you can reach.
+
+This gives us the following code:
+
+```perl
+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;
+}
+```
+
+The numbers 6, 10, 15 and 17 come from looking at the grid above....
+
+```
+  ... +15 ... +17 ...
+   +6 ... ... ... +10
+  ... ... *** ... ...
+  -10 ... ... ...  -6
+  ... -17 ... -15 ...
+```
+We then have an optimized version of the walk code:
+
+The array looks something like:
+```
+[
+  [10,17]
+  [11,16,18]
+  [8,12,17,19]
+  [9,13,18,20]
+  [10,14,19,21]
+  [11,15,20,22]
+  [12,21,23]
+  [13,22]
+  ....
+]
+```
+
+The walk sub then becomes the simpler:
+
+```perl
+sub walk_trans {
+  my( $t, $seen, $rt ) = @_;  ## Current square, visited squares, current route
+  return if $seen & 1 << $t;  ## Return if we've already been to this square.
+  $seen |= 1 << $t;           ## Mark that we have been in this square.
+  $rt   .= chr $t;            ## Add this square to our route.
+  return ($best_rt,$best_len) = ($rt,-1+length $rt) if ($seen & $sol) == $sol;
+                              ## If we've found all the treasure
+                              ## Update the best route (and it's length)
+                              ## and return;
+  return if $best_len <= length $rt;
+                              ## If our route is longer than the best route
+                              ## return;
+  walk_trans( $_, $seen, $rt ) foreach @{$trans->[$t]};
+                              ## Try all knight move squares from the current
+                              ## square.
+}
+```
+
+The eight lines of `if`s go back to a single foreach loop.
+
+As well as removing the ifs we have a "side-effect" where we no longer need to label squares by their x&y co-ordinates but just by their index 0..63 which also gains us a little speed.
+
+The time is now down to approximately 10 seconds.
+
+## Notes
+
+### Transition matrix
+```perl
+[
+  [10, 17],
+  [11, 16, 18],
+  [8, 12, 17, 19],
+  [9, 13, 18, 20],
+  [10, 14, 19, 21],
+  [11, 15, 20, 22],
+  [12, 21, 23],
+  [13, 22],
+  [2, 18, 25],
+  [3, 19, 24, 26],
+  [0, 4, 16, 20, 25, 27],
+  [1, 5, 17, 21, 26, 28],
+  [2, 6, 18, 22, 27, 29],
+  [3, 7, 19, 23, 28, 30],
+  [4, 20, 29, 31],
+  [5, 21, 30],
+  [1, 10, 26, 33],
+  [0, 2, 11, 27, 32, 34],
+  [1, 3, 8, 12, 24, 28, 33, 35],
+  [2, 4, 9, 13, 25, 29, 34, 36],
+  [3, 5, 10, 14, 26, 30, 35, 37],
+  [4, 6, 11, 15, 27, 31, 36, 38],
+  [5, 7, 12, 28, 37, 39],
+  [6, 13, 29, 38],
+  [9, 18, 34, 41],
+  [8, 10, 19, 35, 40, 42],
+  [9, 11, 16, 20, 32, 36, 41, 43],
+  [10, 12, 17, 21, 33, 37, 42, 44],
+  [11, 13, 18, 22, 34, 38, 43, 45],
+  [12, 14, 19, 23, 35, 39, 44, 46],
+  [13, 15, 20, 36, 45, 47],
+  [14, 21, 37, 46],
+  [17, 26, 42, 49],
+  [16, 18, 27, 43, 48, 50],
+  [17, 19, 24, 28, 40, 44, 49, 51],
+  [18, 20, 25, 29, 41, 45, 50, 52],
+  [19, 21, 26, 30, 42, 46, 51, 53],
+  [20, 22, 27, 31, 43, 47, 52, 54],
+  [21, 23, 28, 44, 53, 55],
+  [22, 29, 45, 54],
+  [25, 34, 50, 57],
+  [24, 26, 35, 51, 56, 58],
+  [25, 27, 32, 36, 48, 52, 57, 59],
+  [26, 28, 33, 37, 49, 53, 58, 60],
+  [27, 29, 34, 38, 50, 54, 59, 61],
+  [28, 30, 35, 39, 51, 55, 60, 62],
+  [29, 31, 36, 52, 61, 63],
+  [30, 37, 53, 62],
+  [33, 42, 58],
+  [32, 34, 43, 59],
+  [33, 35, 40, 44, 56, 60],
+  [34, 36, 41, 45, 57, 61],
+  [35, 37, 42, 46, 58, 62],
+  [36, 38, 43, 47, 59, 63],
+  [37, 39, 44, 60],
+  [38, 45, 61],
+  [41, 50],
+  [40, 42, 51],
+  [41, 43, 48, 52],
+  [42, 44, 49, 53],
+  [43, 45, 50, 54],
+  [44, 46, 51, 55],
+  [45, 47, 52],
+  [46, 53],
+]
+```
diff --git a/challenge-118/james-smith/perl/ch-2.pl b/challenge-118/james-smith/perl/ch-2.pl
index 358b7a1f64..5e1d821aae 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,46 @@ 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 ) = @_;  ## Current square, visited squares, current route
+  return if $seen & 1 << $t;  ## Return if we've already been to this square.
+  $seen |= 1 << $t;           ## Mark that we have been in this square.
+  $rt   .= chr $t;            ## Add this square to our route.
+  return ($best_rt,$best_len) = ($rt,-1+length $rt) if ($seen & $sol) == $sol;
+                              ## If we've found all the treasure
+                              ## Update the best route (and it's length)
+                              ## and return;
+  return if $best_len <= length $rt;
+                              ## If our route is longer than the best route
+                              ## return;
+  walk_trans( $_, $seen, $rt ) foreach @{$trans->[$t]};
+                              ## Try all knight move squares from the current
+                              ## square.
+}
+
+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;
+}