Merge pull request #4315 from drbaggy/master

Solutions to challenge 118 & some minor tweaks to 117/116 with respect to notes

5 files changed, 386 insertions, 91 deletions

diff --git a/challenge-116/james-smith/README.md b/challenge-116/james-smith/README.md
index 9900d1f1f9..dfd11efa51 100644
--- a/challenge-116/james-smith/README.md
+++ b/challenge-116/james-smith/README.md
@@ -23,18 +23,23 @@ of the sequence (`$start.=$_`)....
 
 Within each loop we just stitch together the string by incrementing the number each time through the loop..
 
- * We use string (in)equalities/incremements so this will work with arbitrarily large numbers (see examples in script)
- * We reduce the maximum calculations by a factor of 2 by spliting just the first half of the string   
- * As we are working with strings rather than numbers we check the lengths in the while condition (because we are using string comparison)
+ * We use string (in)equalities/incremements so this will work with arbitrarily large numbers (see examples in script) (#1)
+
+ * We reduce the maximum calculations by a factor of 2 by spliting just the first half of the string (#2)
+
+ * As we are working with strings rather than numbers we check the lengths in the while condition (because we are using string comparison) (#3)
+
+ * We also check that the number we have just added is equal to the next chunk of the string (#4)
 
 ```perl
 sub splitnum {
   my( $in, $start ) = ( shift, '' );
-  for( split //, substr $in, 0, (my $len = length $in) >> 1) {
+  for( split //, substr $in, 0, (my $len = length $in) >> 1) {              #[2]
     my @range = ( my $str = my $end = $start .= $_ );
-    ($str .= ++$end) && push @range, $end while ($len > length $str) &&
-              $end eq substr $in,length($str)-length($end),length($end);
-    return \@range if $string eq $in;
+    ( $str .= ++$end ) && push @range, $end                                 #[1]
+      while ($len > length $str) &&                                         #[3]
+            $end eq substr $in, length($str) - length($end) , length($end); #[4]
+    return \@range if $string eq $in;                                       #[1]
   }
   return [$in];
 }
diff --git a/challenge-117/james-smith/perl/ch-2.pl b/challenge-117/james-smith/perl/ch-2.pl
index d68f4d9c9b..c4ee3fda2e 100644
--- a/challenge-117/james-smith/perl/ch-2.pl
+++ b/challenge-117/james-smith/perl/ch-2.pl
@@ -48,7 +48,8 @@ my @cache;
 ## RRR
 
 if( $N < 0 ) { ## Run recursive dumper!
-  triangle( -$N, 0, '' );
+  tr_nr( -$N, 0, '' );
+  #triangle( -$N, 0, '' );
   exit;
 }
 
@@ -68,6 +69,23 @@ cmpthese( 10000, {
   'recrel'        => sub {            schröder_recurrence_rel( $N ); },
 });
 
+sub tr_nr {
+  my $size = shift;
+  my @line = map { ['H'x$_] } reverse 0 .. $size;
+  while(@line>1) {
+    my @new = ([map( {'L'.$_ } @{$line[-2]}), map {'R'.$_ } @{$line[-1]} ]);
+    while(@line>2) {
+      pop @line;
+      push @new, [
+        map( {'H'.$_ } @{$new[ -1]}),
+        map( {'L'.$_ } @{$line[-2]}),
+        map  {'R'.$_ } @{$line[-1]}
+      ];
+    }
+    @line = @new;
+  }
+  say $_ foreach @{$line[0]};
+}
 sub triangle {
 ## As asked display results - note as $n gets large storing in an
 ## array and returning values is too memory intensive - so we will
diff --git a/challenge-118/james-smith/README.md b/challenge-118/james-smith/README.md
index a2df765405..06bf45b666 100644
--- a/challenge-118/james-smith/README.md
+++ b/challenge-118/james-smith/README.md
@@ -1,4 +1,4 @@
-# Perl Weekly Challenge #117
+# Perl Weekly Challenge #118
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -12,127 +12,252 @@ You can find the solutions here on github at:
 
 https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-117/james-smith/perl
 
-# Task 1 - Missing Row
+# Task 1 - Binary Palindrome
+***You are given a positive integer `$N`. Write a script to find out if the binary representation of the given integer is Palindrome. Print `1` if it is otherwise `0`.***
+## The solution
 
-***You are given text file with rows numbered 1-15 in random order but there is a catch one row in missing in the file. Write a script to find the missing row number.***
+This is a simple code - we convert the number to a binary represenation
+using `sprintf` (actually faster than `unpack`), reverse and `compare`.
 
-## The solution
+```perl
+sub is_binary_palindrome_string {
+  my $t = sprintf '%b', shift;
+  return ($t eq reverse $t) || 0;
+}
+```
 
-It would first seem we would need to collect a complete list of line numbers - but that is not the case.
+I looked at alternative array based solutions - but these are all
+appreciably slower than using perl "core" string functions - which
+what you would expect. Core functionality will be written in highly
+optimzed "C" and so usually can't be beaten. We have seen this before
+when comparing the speed of `grep` to list utils `first` on small
+to medium lists when the comparison function is simple.
 
-If we have a file with `N` rows, we now that the sum of the line numbers is `N*(N+1)/2`.
+# Task 2 - Adventure of Knight
 
-So to find the one that is missing we just sum the line numbers and take it from `N*(N+1)/2`.
+***There are 6 squares with treasures. Write a script to find the
+path such that Knight can capture all treasures. The Knight can
+start from the top-left square.***
 
-If `T` is the total of the line numbers and `n` is the number of lines read then:
+## The technique
 
-`N = n+1` so `T` + `missing number` = `(n+1)(n+2)2`
+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.
 
-```perl
-sub splitnum {
-  my( $N, $T ) = ( 1, 0 );
-  open my $fh, q(<), shift;
-  ++$N && ( $T += substr $_, 0, index $_, q(,) ) while <$fh>;
-  close $fh;
-  return $N * ( $N + 1 ) / 2 - $T;
-}
+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.
+
+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
+array of items on the board as a single number.
+
+We number the squares starting bottom left with `0` & ending top right
+with `63`.
+
+```
+       a  b  c  d  e  f  g  h
+
+ 8    56 57 58 59 60 61 62 63
+ 7    48 49 50 51 52 53 54 55
+ 6    40 41 42 43 44 45 46 47
+ 5    32 33 34 35 36 37 38 39
+ 4    24 25 26 27 28 29 30 31
+ 3    16 17 18 19 20 21 22 23
+ 2     8  9 10 11 12 13 14 15
+ 1     0  1  2  3  4  5  6  7
 ```
 
-# Task 2 - Find Possible Paths
+Each board has a single integer representing it by adding up `2^n`
+for every square which contains an object.
 
-***You are given size of a triangle. Write a script to find all possible paths from top to the bottom right corner. In each step, we can either move horizontally to the right (H), or move downwards to the left (L) or right (R).***
+We can then represent the location of the "treasures" as a 64-bit
+number where we set the appropriate bit for each square a treasure
+is in. So we can represent the solution as:
+
+```
+   b1 (2^ 1)                    1
+   a2 (2^ 8)                  256
+   b2 (2^ 9)                  512
+   b3 (2^17)              131 072
+   c4 (2^26)           67 108 864
+   e6 (2^44)   17 592 186 044 416
+   ---------- -------------------
+   TOTAL       17 592 253 285 121
+   ---------- -------------------
+```
+
+We can similarly represent the squares the knight has visited as
+a single number.
+
+Two checks we need are:
+
+ * When a knight moves have they already visited the new square. If
+   they have then we do a bitwise compare (`&`) of `2^n` of the new
+   square with the representation of the squares they have visited.
+   If this is non-zero - we have already visited the square.
+
+ * To check to see if we have visited ALL the treasures we can `&`
+   the square we have visited with the location of the squares of
+   the treasure and if all the bits of the treasure squares have
+   been visited we know we have a solution. `tour & solution == solution`.
+
+**No loops required!**
+
+To find an optimal solution - we just need to find the shortest path -
+so one final check we can do is to "fail" the search if any new path is
+equal to or longer than the current shortest path.
+
+Finally this representation stores where a knight has been but NOT the
+order of the squares he has visited. We have to additionally store this
+information. At each stage we needed to compute the number of the
+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
 
-The output of this script will be large - especially for larger sizes. We will look at the "count" only version lately. But e.g for size 10 - there are 1,037,718 routes and size 20 - there are 17,518,619,320,890 routes.
+### The "main code"
 
-For dumping the routes - this lends itself to a recursive solution:
+Set up list of possible knight moves.
+```perl
+my @dir = ([-2,1],[2,1],[-2,-1],[2,-1],[-1,2],[1,2],[-1,-2],[1,-2]);
+```
 
+Get a list of treasure locations (in the form of letter.number).
 ```perl
-sub triangle {
-  my( $size, $offset, $route ) = @_;
-  ( say $route.( 'H' x $offset ) ) && return     unless $size;
-  triangle( $size - 1, $offset + 1, $route.'L' );
-  triangle( $size - 1, $offset,     $route.'R' );
-  triangle( $size,     $offset - 1, $route.'H' ) if $offset;
-}
+my @treasures = qw(a2 b1 b2 b3 c4 e6);
 ```
 
-**Notes:**
+Initialize variables (best route, best route length), and compute the
+numeric represenation of the solution. You see we use "`|`" rather
+than "`&`" to add up the digits.
+
+We subtract `105 = 8 + 97` - as we have to substract `ord 'a'` from the
+horizontally co-ordinate and `1 (*8)` from the vertical co-ordinate
+to map to a `0` based location number.
+
+```perl
+my( $sol, $best_len, $best_rt ) = ( 0, 65 );
+$sol |= 1 <<  8 * (substr $_,1) - 105 + ord $_ foreach @treasures;
+```
 
-`$offset` is the distance from the right hand side of the triangle - so moving left (`L`)
-increments `$offset` and moving horizontally (`H`) decrements `$offset`.
+Walk the grid to find the best solution. Starting in the top left
+corner which is `(0,7)`.
+```perl
+walk( 0, 7, 0, q() );
+```
+
+Write out best solution
+```perl
+say '';
+say "Treasures: @treasures";
+say '#Steps:    ',-1 + length $best_rt;
+say 'Route:     ',show_rt( $best_rt );
+say '';
+```
 
-If we get to the bottom row - we short-cut the recursion by just including an `H` for
-every point we are to the left of the corner (which just happens to be `$offset`)...
+### The walk function
 
-We don't "collect" routes in a data structure and then print them all at the
-end, but instead render directly from within the subroutine. For `$N` larger than
-`10` the memory requirements for storing this information increases significantly,
-so this code is limited purely by disk rather than memory.
+This is the heart of the algorithm.
 
-### Now the counts... Schröder numbers
+To make the code shorter we don't check the square we are moving to
+before we call the function, but instead we check at the start of the
+call.
 
-*It's amazing what you find out about when you google the answers you get!*
+We have the following variables:
 
-Due to the memory/storage issues we can change the problem to one of counting rather than listing...
-The first approach is to just convert the `triangle` method above to count - we introduce a cache
-as well to improve performance.
+  * `$seen` is the binary representation of the board showing where
+    the knight has been.
+  * `$rt` the byte string of the route of of the knight.
+  * `$x`/`$y` the co-ordinates of the current square.
+  * `$t`/`$v` the location of the square as a number between `0` and `63` and
+    it's location as a bit in the 64-bit represenation. `2^$t`.
+
+We check:
+
+  * Is the new square on the board (x/y co-ordinates between 0 and 7).
+  * We check we haven't seen the square before `$seen & $v`
+
+We then update both `$seen` and `$rt`
+
+Then we check the solution - `$seen & $sol == $sol` - if it is we
+update the "best solution" and try the next path.
+
+Before the recursive step we check whether our solution will be optimal
+by comparing it's length to the best length we have already seen.
 
 ```perl
-sub schröder_cache_array {
-   my($size,$offset) = @_; $offset ||=0;
-   return $size
-        ? ( $cache[$size][$offset] ||=
-              schroder_cache_array( $size - 1, $offset + 1 ) #L
-            + schroder_cache_array( $size - 1, $offset     ) #R
-            + ( $offset ? schroder_cache_array( $size, $offset - 1 ) : 0 )
-          )
-        : 1;
+sub walk {
+  my( $x, $y, $seen, $rt ) = @_;
+  return if $x < 0 || $y < 0 || $x > 7 || $y > 7
+         || $seen & ( my $v = 1 << ( my $t = 8*$y + $x ) );
+  $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( $x + $_->[0], $y + $_->[1], $seen, $rt ) foreach @dir;
 }
 ```
 
-But as we've said before recursion is a curse - but we notice that
-```
-       T0,m = 1                          
-  Sn = Tn,0 = Tn-1,0 + Tn-1,1
-       Tn,m = Tn-1,m + Tn-1,m+1 + Tn,m-1
-```
+### The dump function
+
+This returns the path - in the original letter.number format with
+stars to indicate when we find treasures. We do this by Using
+nested `map`s.
 
-We can use that to define each row of a triangle with `Sn` as the last
-value.
+ * We first convert the byte string representation into an array of
+   square numbers.
+ * We then convert this to a list of location strings.
+ * We finally check to see if each square is a treasure and prepend
+   with either a `*` or a space.
 
 ```perl
-sub schröder_non_recursive {
-  my $size = shift;
-  my @x = map {1} 0..$size;
-  foreach my $s (1..$size) {
-    my @y = $x[1] + $x[0];
-    push @y, $x[$_+1] + $x[$_] + $y[-1] foreach 1 .. $size-$s;
-    @x=@y;
-  }
-  return $x[0];
+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;
 }
 ```
 
-We again use the row "flip" method as we only need one row and the previous
-one to get values... Avoids having to allocate more memory for the whole
-triangle.
+## Aside - let's eek out the speed.
+
+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
+can move them but a generic check code gets messy and isn't as
+fast. If we unravel the one loop we have left we can simplify
+things slighlty - as we can make the range checks simpler.
+
+Note we have kept the order of the offsets the same as in the `walk`
+function above - this will have an affect on the speed (the search
+is faster if you find shorter matches early on).
 
-### The quickest counter!
+As you can see we have avoided array look ups and extra function calls,
+so although the code is longer it is more efficient.
 
-Googling for `2, 6, 22, 90, 394` came up with https://en.wikipedia.org/wiki/Schröder_number, this has
-lots of information about uses of this sequence. As well as giving the non-recursive relation above it
-also gives a faster (about twice as fast as above) solution - as Scrhöder numbers can be written as a
-recurrence relation. Writing this in perl gives us, where @S = is the array of Scrhöder numbers.
+Testing gives around a one-third speed up from around 24 seconds
+to 18 seconds per run on my usual VM.
 
 ```perl
-sub schröder_recurrence_rel {
-  my( $size, @S ) = ( shift, 1, 2 );
-  foreach my $n (2..$size) {
-    $S[ $n ]  =        3 * $S[ $n - 1      ];
-    $S[ $n ] += $S[ $_ ] * $S[ $n - 1 - $_ ] foreach 1..$n-2;
-  }
-  return $S[ $size ];
+sub walk_opt {
+  my( $x, $y, $seen, $rt ) = @_;
+  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 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;
+  walk_opt( $x-2, $y-1, $seen, $rt ) if $y   && $x>1;
+  walk_opt( $x+2, $y-1, $seen, $rt ) if $y   && $x<6;
+  walk_opt( $x-1, $y+2, $seen, $rt ) if $x   && $y<6;
+  walk_opt( $x+1, $y+2, $seen, $rt ) if $x<7 && $y<6;
+  walk_opt( $x-1, $y-2, $seen, $rt ) if $x   && $y>1;
+  walk_opt( $x+1, $y-2, $seen, $rt ) if $x<7 && $y>1;
 }
 ```
diff --git a/challenge-118/james-smith/perl/ch-1.pl b/challenge-118/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..6dadf2038d
--- /dev/null
+++ b/challenge-118/james-smith/perl/ch-1.pl
@@ -0,0 +1,58 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Data::Dumper qw(Dumper);
+
+my @TESTS = (
+  [ 5, 1 ],
+  [ 4, 0 ],
+  [ 9, 1 ],
+  [ 90, 0 ],
+  [ 45, 1 ],
+  [ 15, 1 ],
+  [ 31, 1 ],
+  [ 63, 1 ],
+  [ 127, 1 ],
+  [ 255, 1 ],
+  [ 129, 1 ],
+  [ 65, 1 ],
+  [ 247, 0 ],
+  [ 200,0],
+  [ 500,0],
+  [ 100,0],
+  [ 400,0],
+  [ 300,0],
+);
+
+is( is_binary_palindrome($_->[0]), $_->[1] ) foreach @TESTS;
+is( is_binary_palindrome_string($_->[0]), $_->[1] ) foreach @TESTS;
+
+cmpthese( 250_000, {
+  'array'  => sub { is_binary_palindrome($_->[0])        foreach @TESTS },
+  'string' => sub { is_binary_palindrome_string($_->[0]) foreach @TESTS },
+} );
+
+done_testing();
+
+sub is_binary_palindrome_string {
+  ## This is the core perl solution convert to binary using sprintf
+  ## [this is faster than unpack!]
+  ## and compare with reverse...
+  my $t = sprintf '%b', shift;
+  return ($t eq reverse $t) || 0;
+}
+
+sub is_binary_palindrome {
+  ## Can we write an array based one which is faster! Answer NO!
+  ## We work from both ends to see if the numbers are different
+  ## if they are return 0
+  ## o/w we get to the end and return 1
+  my @n = split m{}, sprintf '%b', shift;
+  (pop @n eq shift @n) || return 0 while @n > 1;
+  return 1;
+}
diff --git a/challenge-118/james-smith/perl/ch-2.pl b/challenge-118/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..358b7a1f64
--- /dev/null
+++ b/challenge-118/james-smith/perl/ch-2.pl
@@ -0,0 +1,89 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+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 @treasures = qw(a2 b1 b2 b3 c4 e6);
+my( $sol, $best_len, $best_rt ) = ( 0, 65 );
+$sol |= 1 <<  8 * (substr $_,1) - 105 + ord $_ foreach @treasures;
+
+## We convert the "letter/digit" co-ordinates into a square number
+## starting 0 as bottom left, working along each row... to 63 in the
+## top right....
+##
+## As our "perl" version is 64-bit we set the appropriate bit
+## this makes checking the solution more easily
+##
+## We get the solution by "|"ing everything together and use "bit-shift"
+## operator to generate the position number..
+##
+## When we keep track of the path we use the same technique to track
+## which squares we have visited.
+##
+## We store the actual path as a byte string (mapping the 0-63 number
+## to bytes using chr/ord.
+
+
+walk( 0, 7, 0, q() );   ## Walk the tree starting from top-left
+
+say '';
+say "Treasures: @treasures";
+say '#Steps:    ',-1 + length $best_rt;
+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); },
+} );
+
+sub walk {
+  my( $x, $y, $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 $x < 0 || $y < 0 || $x > 7 || $y > 7
+         || $seen & ( my $v = 1 << ( my $t = 8*$y + $x ) );
+  $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( $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
+  ## If we have fallen off the sides of the board
+  ## Or if we have already visited the square.
+  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 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;
+  walk_opt( $x-2, $y-1, $seen, $rt ) if $x>1 && $y;
+  walk_opt( $x+2, $y-1, $seen, $rt ) if $x<6 && $y;
+  walk_opt( $x-1, $y+2, $seen, $rt ) if $x   && $y<6;
+  walk_opt( $x+1, $y+2, $seen, $rt ) if $x<7 && $y<6;
+  walk_opt( $x-1, $y-2, $seen, $rt ) if $x   && $y>1;
+  walk_opt( $x+1, $y-2, $seen, $rt ) if $x<7 && $y>1;
+}
+