This is my response to the Perl Weekly Challenge #118.
$N
.
Input: $N = 5
Output: 1 as binary representation of 5 is 101 which is Palindrome.
Input: $N = 4
Output: 0 as binary representation of 4 is 100 which is NOT Palindrome.
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0, :v($verbose)); # [1]
my $bin = $N.fmt('%b'); # [2]
say ": $bin (binary)\n: { $bin.flip } (binary flipped)" if $verbose;
say + ($bin eq $bin.flip); # [3]
[1] Ensure a positive integer.
[2] Get the binary representation.
[3]
Reverse (flip) the string, and check if it is the same as the
original version. (Note that reverse
will reverse the order of
items in an array, list etc.) The +
is there to ensure
that we get the numeric values «0» and «1» instead of False
and True
.
See
docs.raku.org/routine/fmt
more information about fmt
.
See
docs.raku.org/routine/flip for more information about flip
.
See
docs.raku.org/routine/reverse for more information about reverse
.
Running it:
$ ./bin-pal 5
1
$ ./bin-pal 4
0
With verbose mode:
$ ./bin-pal -v 5
: 101 (binary)
: 101 (binary flipped)
1
$ ./bin-pal -v 4
: 100 (binary)
: 001 (binary flipped)
0
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Getopt::Long;
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $N = shift(@ARGV);
die "Specify a positive integer" unless $N =~ /^[1-9]\d*$/;
my $bin = sprintf('%b', $N);
say ": $bin (binary)\n: " . reverse($bin) . " (binary flipped)" if $verbose;
say 0 + ($bin eq reverse($bin)); # [1]
[1] The 0 +
part is there to prevent an empty string when the strings
differ. I do not know why it does not return 0, but it was easy to fix.
Running it gives the same result as the Raku version:
$ ./bin-pal-perl -v 5
: 101 (binary)
: 101 (binary flipped)
1
$ ./bin-pal-perl -v 4
: 100 (binary)
: 001 (binary flipped)
0
N
and its way of movement is the same as what it is defined in Chess. *
represents
an empty square. x
represents a square with treasure.
6 squares
with treasures.
a b c d e f g h
8 N * * * * * * * 8
7 * * * * * * * * 7
6 * * * * x * * * 6
5 * * * * * * * * 5
4 * * x * * * * * 4
3 * x * * * * * * 3
2 x x * * * * * * 2
1 * x * * * * * * 1
a b c d e f g h
A knight can reach 8 different positions from the current one, given enough space (board) in the relevant directions, as shown below (the first block, with «0» as the initial position):
- 1 - 1 - - 1 2 1 - - 1 2 1 - 4 1 2 1 4
1 - - - 1 1 2 - 2 1 1 2 3 2 1 1 2 3 2 1
- - 0 - - 2 - 0 - 2 2 3 0 3 2 2 3 0 3 2
1 - - - 1 1 2 - 2 1 1 2 3 2 1 1 2 3 2 1
- 1 - 1 - - 1 2 1 - - 1 2 1 - 4 1 2 1 4
The rest of the illustration shows that the knight can reach every position on a 5x5 board, with at most 4 moves. The fact that we can reach all the positions applies to a 8x8 board as well, but the number of required moves is higher.
A nicer version of the illustration:
This task is similar to traversing a maze, amazingly as it may seem. In a maze, the goal is a certain location (the exit), and we move along corridors. A knight on the other hand moves in seemingly erratic ways (L-shaped jumps), and we are done when all the treasures have been collected.
See my Amazingly Raku Part 2: The Path article for a desription of the shortest path applied to a maze (the program «maze-solver-spa-simple»).
The general idea when looking for the shortest path is to not follow a path recursively (depth first), but add them to the end of a queue and process paths from the start of the queue. The resulting path (when we have reached the exit) is the shortest (or rather, one of potentially many with the same length).
Let us start by writing a program that list all available locations we can reach (with one move). The current location is specified on the command line. I have chosen to use Chess Notation, where the letter comes before the digit.
File: knight-move
#! /usr/bin/env raku
subset ChessPos where # [1a]
$_.chars == 2 && # [1b]
$_.substr(0,1) ~~ /<[abcdefgh]>/ && # [1c]
$_.substr(1,1) ~~ /<[12345678]>/; # [1d]
unit sub MAIN (ChessPos $pos, :v($verbose)); # [1]
my ($col, $row) = $pos.comb; # [2]
if $verbose
{
say ": row: $row";
say ": col: $col";
}
my @next = ( # [3]
"{ ($col.ord - 2).chr }{ $row - 1 }", # LLD
"{ ($col.ord - 2).chr }{ $row + 1 }", # LLU
"{ ($col.ord - 1).chr }{ $row - 2 }", # LDD
"{ ($col.ord - 1).chr }{ $row + 2 }", # LUU
"{ ($col.ord + 1).chr }{ $row - 2 }", # RDD
"{ ($col.ord + 1).chr }{ $row + 2 }", # RUU
"{ ($col.ord + 2).chr }{ $row - 1 }", # RRD
"{ ($col.ord + 2).chr }{ $row + 1 }", # RRU
).grep( * ~~ ChessPos); # [4]
say @next.join(", ");
[1] We use a custom type [1a] (set up with subset
)
to ensure that the input has exactly two characters [1b], the first one is a letter
(a-h) [1c], and the second one a digit (1-8) [1d]. (Note that it is possible to
write this shorter, by replacing [1b, 1c and 1d] with a single regex.)
[2] Split the position into column (a-z) and row (1-8).
[3]
Construct all the possible positions, as a list. The comments on
each row gives the direction to get there; L=Left, R=Right, D=Down, U=Up. We cannot
add to a letter, so use ord
to get the Unicode value (position) of it,
then we add to that number, and convert the result back to a letter with
code>chr.
[4] And finally, get rid of positions outside of the board by smartmatching against the custom type from [1].
See
docs.raku.org/language/typesystem#index-entry-subset-subset
for more information about subset
.
See
docs.raku.org/routine/ord
for more information about ord
.
See
docs.raku.org/routine/chr
for more information about chr
.
Running it:
$ ./knight-move a3
b1, b5, c2, c4
$ ./knight-move c5
a4, a6, b3, b7, d3, d7, e4, e6
Looking good.
Then the program solving the challenge.
This program finds the (or rather a) shortest path. But it has one caveat; it does not visit the same position twice, just as when solving a maze. Here it could be ok, especially if we had entered a dead end to get hold of one of the treasures, and another one is also in a dead end. But this is not a maze, we do not have dead ends, and the knight has so many possible moves that it does not matter in practice. (Allowing multiple visits to the same position would lead to loops, and the program would go on forever - unless special care has been taken. More about that later.)
File: adv-night
#! /usr/bin/env raku
subset ChessPos of Str where
$_.chars == 2 &&
$_.substr(0,1) ~~ /<[abcdefgh]>/ &&
$_.substr(1,1) ~~ /<[12345678]>/;
unit sub MAIN (ChessPos $pos = 'a8', :v($verbose)); # [1]
my ($col, $row) = $pos.comb;
my %treasures = ('e6' => True, 'c4' => True, 'b3' => True, # [2]
'a2' => True, 'b2' => True, 'b1' => True);
my %visited = ('a8' => True); # [3]
my @todo = ( ('a8', 'a8', {%visited}, {%treasures}), ); # [4]
while @todo # [5]
{
my $next = @todo.shift; # [6]
my ($pos, $path, $visited, $treasures) = @($next); # [6a]
my %visited = %($visited); # [6b]
my %treasures = %($treasures); # [6c]
for get-next($pos) -> $next # [7]
{
say ": Checking pos: $next (at path \'$path\') with \
{ %visited.elems } visits and { %treasures.elems } \
remaining treasures" if $verbose;
next if %visited{$next}; # [8]
if %treasures{$next} # [9]
{
if %treasures.elems == 1 # [10]
{
say "Path: $path $next"; # [11]
exit; # [11a]
}
%treasures{$next}:delete; # [12]
}
%visited{$next} = True; # [13]
@todo.push: ($next, "$path $next", {%visited}, {%treasures}); # [14]
}
}
sub get-next ($pos) # [15]
{
my ($col, $row) = $pos.comb;
my @next = (
"{ ($col.ord - 2).chr }{ $row - 1 }", # LLD
"{ ($col.ord - 2).chr }{ $row + 1 }", # LLU
"{ ($col.ord - 1).chr }{ $row - 2 }", # LDD
"{ ($col.ord - 1).chr }{ $row + 2 }", # LUU
"{ ($col.ord + 1).chr }{ $row - 2 }", # RDD
"{ ($col.ord + 1).chr }{ $row + 2 }", # RUU
"{ ($col.ord + 2).chr }{ $row - 1 }", # RRD
"{ ($col.ord + 2).chr }{ $row + 1 }", # RRU
).grep( * ~~ ChessPos);
return @next;
}
[1] It is possible to specify another starting position (than «a8», the upper left corner).
[2] The positions of the treasures, in a hash.
[3] The already visited cells.
[4] Add the initial state to the list of partial paths. Note the
{
and }
around the hashes, so that they are
added as s single element (a pointer to a hash) and not as a list (of
key/value pairs). The trailing comma ensures that we get a list with
one element (which in turn has 4 elements).
[5] As long as we have partial paths,
[6] Get the first one. Unpack the four values [6a], and get the two hashes [6b] and [6c].
[7] For each position we can move to,
[8] Skip the position if we have already been there.
[9] Have we arrived at a treasure?
[10] Is this the last remaining treasure?
[11] Print the path and exit (as we are done).
[12] Remoe the treasure from the treasure hash.
[13] Add the position to the visited hash.
[14] Add the result of this iteration to the list of partial paths.
[15] This should be familiar by now. If not, see the «knight-move» program above.
Running it:
$ ./adv-night
Path: a8 b6 a4 b2 d1 c3 b5 d4 e6
Verbose mode shows us that it really is at work here, with over 34,000 steps:
: Checking pos: b6 (at path 'a8') with 1 visits and 6 remaining treasures
: Checking pos: c7 (at path 'a8') with 2 visits and 6 remaining treasures
: Checking pos: a4 (at path 'a8 b6') with 2 visits and 6 remaining treasures
: Checking pos: a8 (at path 'a8 b6') with 3 visits and 6 remaining treasures
... 34124 lines not ahown
: Checking pos: e2 (at path 'a8 b6 a4 b2 d1 c3 b5 d4') with 17 visits and 1 remaining treasures
: Checking pos: e6 (at path 'a8 b6 a4 b2 d1 c3 b5 d4') with 18 visits and 1 remaining treasures
Path: a8 b6 a4 b2 d1 c3 b5 d4 e6
Caveat Revisited: This «only visit each cell once» rule worked out. If it had not, we could have cleared the visited hash each time we had found a treasure. That would work, but the program would be (even) slower as a result.
And that's it.