Perl Weekly Challenge 118.
My solutions (task 1 and task 2) to the The Weekly Challenge - 118.
Task 1: Binary Palindrome
Submitted by: Mohammad S Anwar
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 is a one liner. We just print the number as binary (without leading zeroes) and compare it to its reverse:
perl -E 'map{ my $b=sprintf("%b", $_); say "Input: $_, Output: ", ($b eq reverse $b)?1:0} @ARGV;' `seq 10`
Results:
Input: 1, Output: 1
Input: 2, Output: 0
Input: 3, Output: 1
Input: 4, Output: 0
Input: 5, Output: 1
Input: 6, Output: 0
Input: 7, Output: 1
Input: 8, Output: 0
Input: 9, Output: 1
Input: 10, Output: 0
Here is the longer version:
# Perl weekly challenge 118
# Task 1: Binary palindrome
#
# See https://wlmb.github.io/2021/06/21/PWC118/#task-1-binary-palindrome
use strict;
use warnings;
use v5.12;
map {
my $b=sprintf("%b", $_);
say "Input: $_, Output: ", ($b eq reverse $b)?1:0
} @ARGV;
Example:
./ch-1.pl `seq 10`
Results:
Input: 1, Output: 1
Input: 2, Output: 0
Input: 3, Output: 1
Input: 4, Output: 0
Input: 5, Output: 1
Input: 6, Output: 0
Input: 7, Output: 1
Input: 8, Output: 0
Input: 9, Output: 1
Input: 10, Output: 0
Task 2: Adventure of Knight
Submitted by: Cheok-Yin Fung
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. * represents an empty square. x represents
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 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.
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.
I found a solution which is sort of optimal by parts. It frequently is, but I’m quite sure it not always is the globally optimal solution. I describe the solution below as I build it.
I start with the usual pragmas and loading the required packages and initialize the size of the board and its number of cells.
# Perl weekly challenge 118
# Task 2: Adventure of knight
#
# See https://wlmb.github.io/2021/06/21/PWC118/#task-2-adventure-of-knight
use strict;
use warnings;
use PDL;
use PDL::NiceSlice;
use Exporter::Renaming; # Avoid name conflicts with PDL
use List::Util Renaming=>[reduce=>'lu_reduce', pairs=>undef, first=>undef];
use v5.12;
my $N=8;
my $N2=$N*$N;
There are several ways to represent the position of the knight. One can use names, such as a8 or e6, etc., one can use coordinates such as 0,0 or 4,2, or one could use a matrix that has zeroes everywhere and a one at the actual position, such as
perl -MPDL -e '$a8=zeroes(8,8); $a8->slice("0,0").=1; print $a8;' \
-e '$e6=zeroes(8,8); $e6->slice("4,2").=1; print $e6;'
[
[1 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 1 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
where I used the Perl Data Language PDL. Thus, I define
subroutines to change from one to another representation.
sub positions_from_names {
map { my $s=zeroes($N,$N); $s->($_->[0], $_->[1]).=1; $s}
pairs coords_from_names(@_);
}
sub names_from_positions {
names_from_coords(coords_from_positions(@_));
}
sub names_from_coords {
map {my ($x,$y)=@$_; $x=chr($x+ord('a')); $y=$N-$y; "$x$y"} pairs @_;
}
sub coords_from_names {
my @coords=map {my ($x,$y)=split ''; $x=ord(lc $x)-ord('a'); $y=$N-$y; ($x, $y)} @_;
return @coords;
}
sub coords_from_positions { # assume only one position per element
map {$_->whichND->(:,(0))->dog} @_;
}
Using the reshape operator of PDL I can convert the matrix representation to and from
a column vector. Then, I can represent all the possible motions of a chess
piece, such as the knight, by an adjacency matrix which acting on a
vector of occupied positions yields the next possible occupied
positions. To build the adjacency matrix I move east, west, (north)
and south the unit matrix, using a representation as a 4D data block
indexed by row&column of initial and final positions. The possible
motions of the knight are NEE, NNE, NNW, NWW, SWW, SSW, SSE, and
SEE. Going north is like going south but backwards.
my $matrix=adjacency();
sub adjacency { #Build adjacency matrix for knight
my $identity=identity($N2)->reshape($N,$N,$N,$N);# col,row,col',row'
# Possible south going movements of the knight
# North going movements are the transpose of south going.
my $SEE=$identity->rotate(2) # two steps to the east
->mv(1,0)->rotate(1)->mv(0,1) # one step to the south
->sever; # disconnect this pdl from $identity
$SEE(0:1,:).=0; # zero out unreachable rows and columns.
$SEE(:,0).=0; # Comment out for toroidal boards
my $SSE=$identity->rotate(1)->mv(1,0)->rotate(2)->mv(0,1)->sever;
$SSE(0,:).=0;
$SSE(:,0:1).=0;
my $SWW=$identity->rotate(-2)->mv(1,0)->rotate(1)->mv(0,1)->sever;
$SWW(-2:-1,:).=0;
$SWW(:,0).=0;
my $SSW=$identity->rotate(-1)->mv(1,0)->rotate(2)->mv(0,1)->sever;
$SSW(-1,:).=0;
$SSW(:,0:1).=0;
my $adjacency=lu_reduce {$a|$b} map {$_|$_->transpose}
map {$_->reshape($N2,$N2)} ($SEE, $SSE, $SWW, $SSW);
return $adjacency;
}
To find the sorthest path to a set of targets I repeatedly apply the adjancency matrix until the reached positions overlap the target position. I change the result to boolean 1/0 (reached or not) instead of the natural result (number of paths that reach a position), so that bitwise operators later on work properly. Then I choose arbitrarily one of the reached targets and propagate it back towards the starting position chosing at each stage any one of the intermediate positions that are also reachable from the starting point.
sub forward {
my ($current, $end)=@_;
my @forward=($current);
while(all(!(($current!=0)&($end!=0)))){
$current=(($matrix x ($current->copy->reshape(1,$N2)))->reshape($N,$N))!=0;
push @forward, $current;
}
return @forward;
}
sub backward {
my ($current,@forward)=@_;
my @reverse=($current);
pop @forward;
foreach(reverse @forward){
my $next=(($matrix x $current->copy->reshape(1,$N2))->reshape($N,$N)!=0) & ($_!=0);
my $index=whichND($next);
$current=$next->zeroes;
$current->indexND($index(:,0)).=1;
unshift @reverse, $current;
}
return @reverse;
}
sub path {
my($start, @target)=@_;
my $target=lu_reduce {$a|$b} @target; # all targets in one vector
my @forward=forward($start, $target);
my $reached_all=$forward[-1]&$target;
my $reached_one=first {($_&$reached_all)->any} @target; #choose one
my @backward=backward($reached_one, @forward); #and back-propagate
return @backward;
}
So in order to reach all the desired treasures from a starting position, I choose the shortest path to any of them, the closest, that is, the shortest path from the starting position to the set of targets. From the reached target (I choose one arbitrarily if there are two or more), I choose the shortest path to any of the remaining ones, and so on, until there are no remaining targets.
I read the starting position and the positions of the treasures from the command line and at the end I print the sequence of positions. I also print the board with all the visited sites and all the positions on the board.
my ($start, @treasures)=positions_from_names(@ARGV);
my @path=($start);
while(@treasures){
my @leg=path($path[-1], @treasures);
splice @path,-1,1,@leg;
my $last=$path[-1];
@treasures=grep {($_!=$last)->any} @treasures; # consume treasure
}
say "Path: ", join " ", names_from_positions(@path);
say "Visited sites: ", lu_reduce {$a|$b} @path;
say "Sequence of positions:\n", @path;
Example:
./ch-2.pl a8 a2 b1 b2 b3 c4 e6
Results:
Path: a8 b6 c4 b2 d3 b4 a2 c3 b1 d2 b3 c5 e6
Visited sites:
[
[1 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 1 0 0 1 0 0 0]
[0 0 1 0 0 0 0 0]
[0 1 1 0 0 0 0 0]
[0 1 1 1 0 0 0 0]
[1 1 0 1 0 0 0 0]
[0 1 0 0 0 0 0 0]
]
Sequence of positions:
[
[1 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 1 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 1 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 1 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 1 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 1 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[1 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 1 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 1 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 1 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 1 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 1 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]
[
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 1 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0]
]