pushing solutions to knight's trail & binary palindrome

2 files changed, 119 insertions, 0 deletions

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..4045d50ac0
--- /dev/null
+++ b/challenge-118/james-smith/perl/ch-2.pl
@@ -0,0 +1,61 @@
+#!/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( $SIZE, @treasures ) = ( 8, qw(a2 b1 b2 b3 c4 e6) );
+my( $sol, $best_len, $best_rt ) = ( 0, $SIZE*$SIZE + 1 );
+$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, $SIZE-1, 0, '' );   ## Walk the tree starting from top-left
+
+say length $best_rt, ' - ', show_rt( $best_rt );     ## Show 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 $best_len <= length $rt
+         || $x < 0 || $y < 0 || $x >= $SIZE || $y >= $SIZE
+         || $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;
+  walk( $x + $_->[0], $y + $_->[1], $seen, $rt ) foreach @dir;
+}
+
+sub show_rt {
+  my %t = map { $_ => 1 } @treasures;
+  return join q(),
+          map { sprintf ' %s%s', exists$t{$_}?'*':' ', $_ }
+          map { chr( ($_&7) + 97 ).(1 + ($_>>3)) }
+          map { ord $_ }
+        split m{}, shift;
+}
+