I’ve been doing the Perl Weekly
Challenges. The
latest
involved binary palindromes and a restricted Knight's Tour. (Note that this is
open until 27 June 2021.)
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.
Pretty straightforward really. Convert integer to binary representation; check
whether that representation is a palindrome.
To make things a little more interesting, rather than just using
reverse
and equivalents, I wrote a step-by-step comparison which
should in principle be faster than reversing the string and testing
for equality.
Here's the Python. As in most of these languages, I can get individual
substring characters with an index accessor.
def bp(n):
The binary string:
s="{0:b}".format(n)
Its length, because we'll be using that as an offset.
l=len(s)-1
The first half of the string:
for i in range(int(l/2)+1):
Compared with the corresponding character from the second half.
if s[i] != s[l-i]:
return 0
If we didn't fail at some point, we succeeded.
return 1
TASK #2 › Adventure of Knight
A knight is restricted to move on an 8×8 chessboard. The knight is
denoted by N and its way of movement is the same as what it is
defined in Chess.
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.
BONUS: If you believe that your algorithm can output one of the
shortest possible path.
This isn't quite a Knight's Tour (though that would technically be a
solution, just not a short one): most obviously, we don't have to
visit every square. But more importantly, it's permissible to visit a
square more than once – obviously not within a single bound (a
sequence of moves from a treasure or starting square to another
treasure), because we're looking for shortest routes, but perhaps in
two successive bounds.
So I took a hierarchical approach. At the core is findroute
, which
finds a shortest knight's-move route from point A to point B. That's
my standard breadth-first search pattern with a rolling buffer. (l2c
is a utility function to convert a chessboard location such as "a8" to
a coordinate pair such as [0,7].)
sub findroute {
my ($a,$b)=@_;
my $target=l2c($b);
my $rt;
my @chain=([l2c($a)]);
SEARCH:
In each pass, take the first chain entry (which will be shortest or
equal shortest of all entries on the chain), and append to it each
possible legal move.
while (my $c=shift @chain) {
foreach my $offset (
[-2,-1],
[-1,-2],
[-2,1],
[1,-2],
[2,-1],
[-1,2],
[2,1],
[1,2],
) {
my $x=$c->[-1][0]+$offset->[0];
my $y=$c->[-1][1]+$offset->[1];
if ($x>=0 && $x<=7 && $y>=0 && $y<=7) {
If we land on the target, log that as a shortest-possible-route and
break out of the loop. Otherwise, append it to the chain as a new
candidate route.
my $rl=[@{$c},[$x,$y]];
if ($x==$target->[0] && $y==$target->[1]) {
$rt=$rl;
last SEARCH;
} else {
push @chain,$rl;
}
}
}
}
return $rt;
}
This might go a bit faster if I checked and avoided backtracking, but
even without that it runs pretty well.
So that gives me a way of finding a shortest route from point to
point. Then it's just a matter of testing each permutation of points
for the total route length that that permutation takes, and picking
the shortest of those. (I could calculate all the route pairs in
advance, but it's just as effective to cache each calculation I do
with memoize
.) I've written actual permutation code before for these
things so now I allow myself the non-core module Algorithm::Permute
.
aok('a8',[qw(e6 c4 b3 a2 b2 b1)]);
sub aok {
my ($start,$t)=@_;
my @arr=@{$t};
my $ml;
my @mu;
Algorithm::Permute::permute {
my @r=($start,@arr);
my $l=0;
my @m=();
foreach my $i (0..$#r-1) {
push @m,findroute($r[$i],$r[$i+1]);
$l+=scalar @{$m[-1]}-1;
}
if (!defined $ml || $l < $ml) {
$ml=$l;
@mu=@m;
}
} @arr;
(It's not a "real" block attached to the permute
method, thus the
need to reset @m
each time it's declared.)
Then it's just a matter of formatting the contents of @mu
for
human-readable output. (c2l
is the converse of the earlier l2c
.)
print "$start\n";
foreach my $mv (@mu) {
my @r;
foreach my $i (1..$#{$mv}) {
push @r,c2l($mv->[$i]);
}
print join(' ',map {"-> $_"} @r),"\n";
}
print "\n$ml moves\n";
}
But having done this – all of which is basically techniques I've used
in other PWC answers, and which I knew would have the fiddliness of
array copying in other languages – I found in myself a sudden lack of
enthusiasm for converting it to other languages, so I didn't.
Full code on
github.
Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.