Perl Weekly Challenge: Week 211
Challenge 1:
Toeplitz Matrix
You are given a matrix
m x n.Write a script to find out if the given matrix is
Toeplitz Matrix.A matrix is Toeplitz if every diagonal from top-left to bottom-right has the same elements.
Example 1
Input: @matrix = [ [4, 3, 2, 1],
[5, 4, 3, 2],
[6, 5, 4, 3],
]
Output: true
Example 2
Input: @matrix = [ [1, 2, 3],
[3, 2, 1],
]
Output: false
The first problem I faced when attempting to solve this challenge was how to input the matrix from
the command line. I settled on having the first two arguments being the number of rows and columns
in the matrix and the rest of them being the matrix data. So, for instance, the inputs for example one would
look like this: 3 4 4 3 2 1 5 4 3 2 6 5 4 3.
sub MAIN(
$r,
$c,
*@args
) {
In order to build the matrix, we have to takes @args which is a flat list, and using .batch()
convert it into a 2d array consisting of a number of rows of $c columns each.
my @matrix = @args.batch($c);
Each diagonal starts on the 0th row at a particular column stretching from 0 to the end of $c.
The current position in the diagonal is encoded as $i for the current row and $j for the current column.
for 0 ..^ $c -> $col {
my $i = 0;
my $j = $col;
The value of the first position in the diagonal is the one we will check all the other elements of the diagonal against. my $same = @matrix[$i;$j];
Until we reach either the bottom or right hand edge of the matrix, we move down one row and right one column.
while $i < $r && $j < $c {
If the value of the element at that position isn't the same as that of the first position in the diagonal (i.e. $same,)
this isn't a Toeplitz matrix so we can print "false" and exit the script.
if @matrix[$i;$j] != $same {
say 'false';
exit;
}
If it is the same, we can move on to the next position in the diagonal.
$i++;
$j++;
}
}
The loop above, accounts for all diagonals that begin on the top edge (i.e. row 0,) but there are also diagonals that begin on the left edge (i.e. column 0.) So we have to loop again this time starting from a particular row instead of a column. The loop starts from 1 because we've already done the diagonal that starts from row 0 in the previous loop.
for 1 ..^ $r -> $row {
my $i = $row;
my $j = 0;
my $same = @matrix[$i;$j];
while $i < $r && $j < $c {
if @matrix[$i;$j] != $same {
say 'false';
exit;
}
$i++;
$j++;
}
}
If we manage to pass through both loops, we have determined that all diagonals have the same values and therefore, the matrix is a Toeplitz matrix. We print "true" and finish.
say 'true';
}
Although the code above works, it has a lot of redundancy in the two loops. So I refactored a bunch of code that is repeated into a separate function like this:
sub diagonal(@matrix, $r, $c, $row, $col) {
my $i = $row;
my $j = $col;
my $same = @matrix[$i;$j];
while $i < $r && $j < $c {
if @matrix[$i;$j] != $same {
return False;
}
$i++;
$j++;
}
return True;
}
Now the main body of the script looks like this:
sub MAIN(
$r,
$c,
*@args
) {
my @matrix = @args.batch($c);
for 0 ..^ $c -> $col {
unless diagonal(@matrix, $r, $c, 0, $col) {
say 'false';
exit;
}
}
for 1 ..^ $r -> $row {
unless diagonal(@matrix, $r, $c, $row, 0) {
say 'false';
exit;
}
}
say 'true';
}
Much cleaner don't you think?
For comparison, here is the Perl version. I also had to add code to emulate .batch() which Perl doesn't have.
sub diagonal {
my ($matrix, $r, $c, $row, $col) = @_;
my $i = $row;
my $j = $col;
my $same = $matrix->[$i]->[$j];
while ($i < $r && $j < $c) {
if ($matrix->[$i]->[$j] != $same) {
return undef;
}
$i++;
$j++;
}
return 1;
}
my $r = shift;
my $c = shift;
my @matrix = batch(\@ARGV, $c);
for my $col (0 .. $c - 1) {
unless (diagonal(\@matrix, $r, $c, 0, $col)) {
say 'false';
exit;
}
}
for my $row (1 .. $r - 1) {
unless (diagonal(\@matrix, $r, $c, $row, 0)) {
say 'false';
exit;
}
}
say "true";
Challenge 2:
Split Same Average
You are given an array of integers.
Write a script to find out if the given can be split into two separate arrays whose average are the same.
Example 1
Input: @nums = (1, 2, 3, 4, 5, 6, 7, 8)
Output: true
We can split the given array into (1, 4, 5, 8) and (2, 3, 6, 7).
The average of the two arrays are the same i.e. 4.5.
Example 2
Input: @list = (1, 3)
Output: false
To solve this challenge we need all the different permutations of two halves of the input
and Raku's aptly named .permutations() list method would seem to be exactly what we need. Actually
it is a little bit of overkill; (1 2 3 4) and (4 3 2 1) are treated as separate permutations which is normally
what you want but unnecessary when calculating the average. The .map() calling .batch() splits each permutation
into two equally sized parts.
for @nums.permutations.map({ @$_.batch(@$_.elems div 2) }) -> $i {
If the average of the two parts is the same, we have success. We print "true" and exit the script.
if average(@$i[0]) == average(@$i[1]) {
say "true";
exit;
}
I was somewhat surprised to find that Raku doesn't have an .average() method in the standard library but it was easy
enough to make one of my own:
sub average(@nums) {
return @nums.sum / @nums.elems;
}
If we make it through all the permutations without finding one whose two halves have the same average, we print "false".
}
say 'false';
As I wrote this, it occurred to me that I had assumed that both split parts of a permutation have to be of equal size but the
spec doesn't actually demand this. For instance (1 2 3 2 2 2 2) could be split into (1 2 3) and (2 2 2 2) both of which have
an average of 2. This led me to revise my code like this:
for @nums.permutations -> $i {
for 1 ..^ @$i.elems -> $j {
This was the only complication. .permutations() returns Lists but .splice() needs an Array.
my @array = $i.Array;
my @part1 = @array.splice(0, $j);
my @part2 = @array;
if average(@part1) == average(@part2) {
say "true";
exit;
}
}
}
say 'false';
This is the Perl version. Once again I had to deal with Perls lack of equivalents for Raku standard library methods.
This time I supplemented the code with permute() and sum().
sub average {
my ($nums) = @_;
return sum($nums) / scalar @{$nums};
}
my @permutations;
permute { push @permutations, \@_; } @ARGV;
my @nums;
for my $i (@permutations) {
for my $j (1 .. scalar @{$i} - 1) {
my @array = @{$i};
my @part1 = splice(@array, 0, $j);
my @part2 = @array;
if (average([@part1]) == average([@part2])) {
say "true";
exit;
}
}
}
say 'false';