Perl Weekly Challenge: Week 288
Challenge 1:
Closest Palindrome
You are given a string,
$str, which is an integer.Write a script to find out the closest palindrome, not including itself. If there are more than one then return the smallest.
The closest is defined as the absolute difference minimized between two integers.
Example 1
Input: $str = "123"
Output: "121"
Example 2
Input: $str = "2"
Output: "1"
There are two closest palindrome "1" and "3". Therefore we return the smallest "1".
Example 3
Input: $str = "1400"
Output: "1441"
Example 4
Input: $str = "1001"
Output: "999"
There is an easy solution to this one.
We start by define the numbers adjacent to our input number.
my $lower = $str - 1;
my $upper = $str + 1;
Then we loop continously...
loop {
...checking if either the $upper or $lower numbers is a palindrome. If it is
we output it and break out of the loop.
if (isPalindrome($lower)) {
say $lower;
last;
}
if (isPalindrome($upper)) {
say $upper;
last;
}
If neither are palindromes we move on to the next $lower and $upper numbers and try again.
$lower--;
$upper++;
}
This is the function that checks if a string is a palindrome by seeing if it is equal to its' reverse
(which is created with .flip().)
sub isPalindrome(Str $str) {
return $str eq $str.flip;
}
The Perl version is a direct translation from Raku.
my $lower = $str - 1;
my $upper = $str + 1;
while (1) {
if (isPalindrome($lower)) {
say $lower;
last;
}
if (isPalindrome($upper)) {
say $upper;
last;
}
$lower--;
$upper++;
}
The Perl version of isPalindrome() uses reverse().
sub isPalindrome($str) {
return $str eq reverse $str;
}
Challenge 2:
Contiguous Block
You are given a rectangular matrix where all the cells contain either
xoro.Write a script to determine the size of the largest contiguous block.
A contiguous block consists of elements containing the same symbol which share an edge (not just a corner) with other elements in the block, and where there is a path between any two of these elements that crosses only those shared edges.
Example 1
Input: $matrix = [
['x', 'x', 'x', 'x', 'o'],
['x', 'o', 'o', 'o', 'o'],
['x', 'o', 'o', 'o', 'o'],
['x', 'x', 'x', 'o', 'o'],
]
Output: 11
There is a block of 9 contiguous cells containing 'x'.
There is a block of 11 contiguous cells containing 'o'.
Example 2
Input: $matrix = [
['x', 'x', 'x', 'x', 'x'],
['x', 'o', 'o', 'o', 'o'],
['x', 'x', 'x', 'x', 'o'],
['x', 'o', 'o', 'o', 'o'],
]
Output: 11
There is a block of 11 contiguous cells containing 'x'.
There is a block of 9 contiguous cells containing 'o'.
Example 3
Input: $matrix = [
['x', 'x', 'x', 'o', 'o'],
['o', 'o', 'o', 'x', 'x'],
['o', 'x', 'x', 'o', 'o'],
['o', 'o', 'o', 'x', 'x'],
]
Ouput: 7
There is a block of 7 contiguous cells containing 'o'.
There are two other 2-cell blocks of 'o'.
There are three 2-cell blocks of 'x' and one 3-cell.
This solution is much more complex. But the MAIN() function is quite simple.
say largestContiguousBlock(load($filename));
Looking at this from inside to out, first we have the load() function.
We have to get input into the script. I chose to make the matrix a text file which looks like this for example 1:
xxxxo
xoooo
xoooo
xxxoo
A file like this is read in by load() and turned into a 2D array.
sub load($filename) {
The array that will hold the matrix is defined.
my @matrix;
For each line in the input file...
for $filename.IO.lines -> $line {
...it is split into an array of individual characters with .comb() and this array is added to @matrix.
@matrix.push($line.comb);
}
Then after all the lines have been processed, the matrix array is returned.
return @matrix;
}
The largestContiguousBlock() function as the name implies will actually find the size of the largest
contiguous block in the @matrix.
sub largestContiguousBlock(@matrix) {
A number of subsequent calculations will require the dimensions of the matrix. There is a .shape() method
for this but I wasn't able to get it to work for some reason.
my $rows = @matrix.elems;
my $cols = @matrix[0].elems;
The way this function will find the largest contiguous block is by treating the matrix as a graph and doing
a depth-first search from every node. This could be quite expensive so an optimization we need to make is to
keep track of nodes already visited so we don't have to process them again and again. This is done by creating a
2D array the same size as @matrix but consisting of Boolean values. Initially all will be set to False.
my @visited = (0 ..^ $rows).map({ [False xx $cols] });
And of course we need a variable to keep track of the largest block found so far.
my $maxSize = 0;
This double loop traverses all the elements of @matrix and calls the search() function to do the depth-first
search starting from the current element as long as it has not been visited. search() returns the size of the
contiguous block it has found (which could be 0.)
for 0 ..^ $rows -> $i {
for 0 ..^ $cols -> $j {
if !@visited[$i][$j] {
my $currentSize = search(@matrix, $rows, $cols, @visited, $i, $j, @matrix[$i][$j]);
If the block is larger than the largest block found so far it becomes the new largest block.
if $currentSize > $maxSize {
$maxSize = $currentSize;
}
}
}
}
Finally, the size of the largest block is returned.
return $maxSize;
}
The search() function looks like this:
sub search(@matrix, $rows, $cols, @visited, $x, $y, $symbol) {
If the element being search() is outside the bounds of the array, or has already been visited or is a different
symbol from the one we are currently searching for we can stop right there and return 0.
if (!inBounds($rows, $cols, $x, $y) || @visited[$x][$y] || @matrix[$x][$y] ne $symbol) {
return 0;
}
The function to check if the element is in bounds is very simple:
sub inBounds($rows, $cols, $x, $y) {
return $x >= 0 && $x < $rows && $y >= 0 && $y < $cols;
}
Back to search(); if we can continue, we mark this element as visited.
@visited[$x][$y] = True;
So far we know this is a block of size 1.
my $size = 1;
So now we try and expand the size of the block by recursively calling search() on all this elements
neighbors.
state @directions = ([0, 1], [1, 0], [0, -1], [-1, 0]);
for @directions -> $dir {
my ($dx, $dy) = @$dir;
$size += search(@matrix, $rows, $cols, @visited, $x + $dx, $y + $dy, $symbol);
}
Finally, we return the size.
return $size;
}
This is the Perl version.
say largestContiguousBlock(load($filename));
sub load($filename) {
my @matrix;
open my $file, '<', $filename or die "$!\n";
while (my $line = <$file>) {
push @matrix, [ split //, $line];
}
close $file;
return \@matrix;
}
sub inBounds($rows, $cols, $x, $y) {
return $x >= 0 && $x < $rows && $y >= 0 && $y < $cols;
}
sub largestContiguousBlock($matrix) {
my $rows = scalar @{$matrix};
my $cols = scalar @{$matrix->[0]};
Perl doesn't have a Boolean type so our version of @visiteduses 1'a and 0's.
my @visited = map { [(0) x $cols] } (0 .. $rows - 1);
my $maxSize = 0;
for my $i (0 .. $rows - 1) {
for my $j (0 .. $cols - 1) {
if (!$visited[$i][$j]) {
@bvisited has to be passed to search() by reference so all searches use the same copy.
my $currentSize = search($matrix, $rows, $cols, \@visited, $i, $j, $matrix->[$i][$j]);
if ($currentSize > $maxSize) {
$maxSize = $currentSize;
}
}
}
}
return $maxSize;
}
sub search($matrix, $rows, $cols, $visited, $x, $y, $symbol) {
if (!inBounds($rows, $cols, $x, $y) || $visited->[$x][$y] || $matrix->[$x][$y] ne $symbol) {
return 0;
}
$visited->[$x][$y] = 1;
my $size = 1;
state @directions = ([0, 1], [1, 0], [0, -1], [-1, 0]);
for my $dir (@directions) {
my ($dx, $dy) = @$dir;
$size += search($matrix, $rows, $cols, $visited, $x + $dx, $y + $dy, $symbol);
}
return $size;
}