Perl Weekly Challenge: Week 118
Challenge 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.
Example
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.
This one is easy.
First we convert $N to binary and then we compare the binary string to its reverse. If they are equal it's a
palindrome so print 1 otherwise print 0.
my $binary = $N.base(2);
say ($binary eq $binary.flip) ?? 1 !! 0;
In Perl the functions and operators used are named differently but they work the same. 0+ has to be added after say to stave off a warning.
my $binary = sprintf "%b", $N;
say 0+($binary eq reverse $binary) ? 1 : 0;
Challenge 2:
Adventure of Knight
A knight is restricted to move on an 8x8 chessboard. The knight is denoted by
Nand its way of movement is the same as what it is defined in Chess.*represents an empty square.xrepresents a square with treasure.The Knight's movement is unique. It may move two squares vertically and one square horizontally, or two squares horizontally and one square vertically (with both forming the shape of an L).
There are
6 squareswith treasures.Write a script to find the path such that Knight can capture all treasures. The Knight can start from the top-left square.
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
BONUS: If you believe that your algorithm can output one of the shortest possible path.
What we're doing here is pathfinding. A common algorithm for pathfinding which I've implemented before is A*. Specifically, I'm going to implement a variant called Iterative Deepening A* or IDA* which is less memory-intensive than the standard A* algorithm.
I did my first implementation in C++ as I already had some C++ code for IDA* I could adapt to this problem. You can see the code here.
And here's how I translated my C++ code into Raku:
We will need a data structure to represent the locations of the knight, treasures, and spaces on the board.
class Position {
has Int $.row is rw;
has Int $.col is rw;
By default, Raku class constructors will only accept named parameters. I didn't want that so I wrote a custom constructor which takes positional parameters.
method new( $row, $col ) {
self.bless(:$row, :$col);
}
Each Position will be a pair of numbers, each from 0 - 7. We would like a friendlier representation so we
overload the Str method to use the a - h, 1 -8 notation mentioned in the spec.
method Str {
('a'.ord + $!col).chr ~ (8 - $!row).Str;
}
}
One last thing Position will use is a custom == operator for comparisons.
multi sub infix:<==>(Position $a, Position $b) returns Bool {
return $a.row == $b.row && $a.col == $b.col;
}
In C++ I had to implement a number of other operators but Raku is smart enough to make them unnecessary.
Now we can define our MAIN() function.
We locate the treasures.
my Position @treasures = [
Position.new(2, 4),
Position.new(4, 2),
Position.new(5, 1),
Position.new(6, 0),
Position.new(6, 1),
Position.new(7, 1),
];
And the knight.
my $knight = Position.new(0, 0);
makePath() will find the path from the knights initial position to all the treasures. IDA* guarantees
that it will be the shortest possible path.
my @path = makePath($knight, @treasures);
Then we can print it out.
@path.join(q{ }).say;
So what does this makePath() function do? It's going to run the IDA* algorithm several times. First from
the knights initial position to the first treasure, then from the first treasure to the the second treasure,
and from the second, to the third and so on until the final end position, the location of the last treasure.
I call each of these start to end segments a stage. After, all the stages are concatenated to make the path
which will be returned. Here is an in-depth explanation:
sub makePath(Position $knight is rw, Position @targets) {
First the initial position of the knight is added to the final @path for reasons which shall be explained soon.
my @path = [ $knight ];
Then for each target (i.e. treasure) ...
for @targets -> $target {
A new stage is created, initially containing the current position of the knight.
my Position @stage = [ $knight ];
What makes the A* family of algorithms so powerful and efficient over other pathfinding methods
is the use of a heuristic function. This is a guess as to what will be the "cost" of getting from
point A to point B. In this case, the cost is simply how many moves the knight has to take but in for instance
a wargame, it might be more costly to send your troops through a swamp rather than along a road. The guess doesn't
have to be perfect, but it should be admissable which means right more often than wrong. This way we can quickly
get rid of obviously inefficent paths before wasting time on them. The estimatedCost() function will be described
later.
my $estimate = estimatedCost($knight, $target);
Now we go through a loop in which we try different paths to the $target.
loop {
The search() function will also be described later but for know all you need to know is that it return a result $t.
my $t = search($target, @stage, $estimate);
If $t equals -∞, it means we have successfully found the shortest @stage so we can break out of the loop.
if $t ~~ -∞ {
last;
}
If $t equals -∞, it means we couldn't find a path at all. This might happen in a more complex pathfinding scenario but it is impossible here. I just kept it for completenesses sake.
if $t ~~ ∞ {
last;
}
Any other result means our heuristic guess was incorrect and needs to be adjusted.
$estimate = $t;
}
Once we are out of the loop we can add the results to the master @path. We ommit the first element. If you recall,
we also added the initial position of the knight. The reason is we are not simply find a path from A..B but A..B,
B..C, C..D etc. We want the final answer to be A..B..C..D but with without these convolutions we would get A..BB..CC..D.
@path.push(| @stage[1 .. *]);
Finally we clear out the @stage and set the knights start position to the current end position in order to start
the next iteration of the loop.
@stage = [];
$knight = $target;
}
Finally, the complete @path is returned.
return @path;
}
Before when I implemented IDA* I had used Manhattan distance as a heuristic. That won't work for this problem because the knights move is not a straight line but 'L' shaped. Luckily,
a bit of research led me to a page on the Chess Programming Wiki
which gave me an idea for how to implement estimatedCost().
sub estimatedCost(Position $position, Position $goal) {
Because we only have 64 spaces on the board, it is not inefficient to precompute the distance from one position to another.
state @distance = [
0, 3, 2, 3, 2, 3, 4, 5,
3, 2, 1, 2, 3, 4, 3, 4,
2, 1, 4, 3, 2, 3, 4, 5,
3, 2, 3, 2, 3, 4, 3, 4,
2, 3, 2, 3, 4, 3, 4, 5,
3, 4, 3, 4, 3, 4, 5, 4,
4, 3, 4, 3, 4, 5, 4, 5,
5, 4, 5, 4, 5, 4, 5, 6
];
Then we can use a variant of Manhattan distance to look up how many knight moves it would take to get from
$position to $goal. I must confess I'm not 100% sure why this works but it does.
return @distance[abs($position.row - $goal.row) * 8 +
abs($position.col - $goal.col)];
}
search() finds a path to $target.
sub search(Position $target, Position @path, Int $estimate) {
Where is the knight right now? The last element in @path holds his position.
my $current = @path[*-1];
How expensive will it be to get to the $target? The length of the @path is the number
of moves we've already made. To that we add an estimate with our heuristic.
If $cost is greater than we had previously estimated, it means our guess was too low. We bail out here and
$cost will become our new $estimate in makePath().
my $cost = @path.elems + estimatedCost($current, $target);
if $cost > $estimate {
return $cost;
}
If the current position of the knight is the target position, we have successfully finished. We exit the function
with a return value of -∞.
if $current == $target {
return -∞;
}
Now we set the minimum length of the path to infinity. Hopefully the final answer will be less than that!
my $min = ∞;
For each possible move the knight can make from his current position (possibleMoves() will be explained in detail next)...
for possibleMoves($current, $target) -> $move {
First we check that $move is not already on the @path. We don't want to end up going round and round in circles.
if $move ⊄ @path {
If it wasn't already on the @path, the move gets added to it.
@path.push($move);
search() is called again recursively.
my $t = search($target, @path, $estimate);
if $t is -∞ we can unwind the recursion all the way and return.
if $t == -∞ {
return -∞;
}
If $t is less than the current value of $min, it becomes the new value for it.
if $t < $min {
$min = $t;
}
This $move didn't produce the optimum @path so we backtrack by removing it.
@path.pop;
}
}
return $min;
}
A knight can move anywhere from 2 (if he is in a corner) to 8 (in the middle of the board) different places.
possibleMoves() returns a list of valid moves.
It delegates the actual validation to a helper function called tryMove(). This takes the current position, applies
a delta and determines if the new position would fall off the edge of the board or not. If it is good, the new position is returned.
sub tryMove(Position $position, Position $delta) {
This trippped me up initially. You need to perform the calculations on a copy of $position or
else the original will be modified.
my $dest = $position.clone;
$dest.row += $delta.row;
$dest.col += $delta.col;
return ($dest.row >= 0 && $dest.row < 8 && $dest.col >= 0 && $dest.col < 8)
?? $dest
!! Nil;
}
Back to possibleMoves()...
sub possibleMoves(Position $position, Position $target) {The eight different knight 'L' moves are expressed as deltas from the current position.
state @deltas = [
Position.new(-2, -1),
Position.new(-2, 1),
Position.new(-1, 2),
Position.new(1, 2),
Position.new(2, 1),
Position.new(2, -1),
Position.new(-1, -2),
Position.new(1, -2)
];
Then tryMove() is called with the $position and each $delta in succession. Any
valid moves discovered are added to @moves.
my @moves;
for @deltas -> $delta {
my $move = tryMove($position, $delta);
if $move {
@moves.push($move);
}
}
Before being returned, @moves is sorted by cost. It probably makes no difference
in an at most 8 element list like this but in a real game, there may be hundreds or thousands or possible
moves so it will add to efficiency to keep the most promising values at the beginning.
@moves = @moves.sort({
estimatedCost($^a, $target) < estimatedCost($^b, $target);
});
return @moves;
}
That was a lot of code but we finally have enough to be able to attempt the problem. Running the script gives the following path:
a8 c7 e6 d8 f7 e5 c4 d2 b3 c1 a2 b4 d3 b2 a4 c3 b1
16 moves is not to shabby but can we do better?. Perhaps the order in which we are traversing the targets is suboptimal. There are only 6 targets which gives us 6! or 720 permutations to check which is not too taxing for todays typical computers. We change MAIN() like this:
my $shortest = ∞;
my @shortestPath;
for @treasures.permutations -> @perm {
my $knight = Position.new(0, 0);
my Position @p = @perm;
my @path = makePath($knight, @p);
if @path.elems < $shortest {
$shortest = @path.elems;
@shortestPath = @path;
}
}
@shortestPath.join(q{ }).say;
With this change we get:
a8 c7 e6 d4 b3 c1 a2 c3 b1 a3 c4 b2
...which at 11 moves is I believe the shortest possible path.
The Perl version is similar so I'll only show the bits which are notably different.
For OOP in perl I prefer to use Moo. This is what the Position class looks
like.
package Position;
use Moo;
use namespace::clean;
has row => (
is => 'rw',
);
has col => (
is => 'rw',
);
around BUILDARGS => sub {
my ($orig, $class, @args) = @_;
return { row => $args[0], col => $args[1] };
};
There is no standard way to change the default representation of an object so I just made a method to call whenever needed.
sub str {
my ($self) = @_;
return chr(ord('a') + $self->col) . (8 - $self->row);
}
1;
Rather than overload operator ==, I just made a subroutine to compare two Positions.
sub compare {
my ($a, $b) = @_;
return $a->row == $b->row && $a->col == $b->col;
}
the equivalent of MAIN() looks like this.
my @treasures = (
Position->new(2, 4),
Position->new(4, 2),
Position->new(5, 1),
Position->new(6, 0),
Position->new(6, 1),
Position->new(7, 1),
);
my $shortest = 'inf';
my @shortestPath;
Perl lacks the .permutations() method of Raku so I once again used the version I first found in perlfaq4.
my @permutations;
permute { push @permutations, \@_; } @treasures;
for my $perm (@permutations) {
my $knight = Position->new(0, 0);
my @path = makePath($knight, $perm);
if (scalar @path < $shortest) {
$shortest = scalar @path;
@shortestPath = @path;
}
}
say join q{ }, map { $_-> str } @shortestPath;