Perl Weekly Challenge: Week 298
Challenge 1:
Maximal Square
You are given an
m x nbinary matrix with0and1only.Write a script to find the largest square containing only
1's and return it’s area.
Example 1
Input: @matrix = ([1, 0, 1, 0, 0],
[1, 0, 1, 1, 1],
[1, 1, 1, 1, 1],
[1, 0, 0, 1, 0])
Output: 4
Two maximal square found with same size marked as 'x':
[1, 0, 1, 0, 0]
[1, 0, x, x, 1]
[1, 1, x, x, 1]
[1, 0, 0, 1, 0]
[1, 0, 1, 0, 0]
[1, 0, 1, x, x]
[1, 1, 1, x, x]
[1, 0, 0, 1, 0]
Example 2
Input: @matrix = ([0, 1],
[1, 0])
Output: 1
Two maximal square found with same size marked as 'x':
[0, x]
[1, 0]
[0, 1]
[x, 0]
Example 3
Input: @matrix = ([0])
Output: 0
We take input from the command-line where each argument represents a row of the matrix. So for example,
the input for example 1 would look like this: "10100" "10111" "11111" "10010". Each row is broken up
into individual characters with .comb() and .push()ed into @matrix making it a 2d array.
my @matrix;
for @args -> $row {
@matrix.push($row.comb);
}
For convenience, variables are assigned for the number of rows and columns in the matrix.
my $rows = @matrix.elems;
my $cols = @matrix[0].elems;
And a variable is created where we can store the length of a side of the maximal square.
my $maxSide = 0;
To store the running length of any squares we create another 2d array the same size as the matrix.
my @sl = (0 ..^ $rows).map({ [ (0) xx $cols ] });
Now we can iterate through the matrix...
for 0 ..^ $rows -> $i {
for 0 ..^ $cols -> $j {
... if the current cell contains a 1, and it is not on the left or top edges of the matrix,
we look at the cells to the left, the top, and the diagonal top-left of it in @sl and find the minimum
value contained in them. 1 is added to that and this becomes the value of the cell at the equivalent row and column
in @sl. If the cell was on the left or top edges of the matrix, we just put a 1 in the equivalent cell in @sl.
if @matrix[$i;$j] == 1 {
@sl[$i;$j] = ($i == 0 || $j == 0)
?? 1
!! minOf3(@sl[$i - 1;$j], @sl[$i;$j - 1], @sl[$i - 1;$j - 1]) + 1;
How did we find which of the three corner cells had the minimum value? You'll notice the use of a minOfThree()
function above. It looks like this:
sub minOf3($a, $b, $c) {
return $a < $b ?? ($a < $c ?? $a !! $c) !! ($b < $c ?? $b !! $c);
}
I must say I'm pretty pleased with my cleverness in fitting this into one line.
Back to the main code, if the value we just determined was greater than the existing value of $maxSide, it becomes the new value of $maxSide.
if @sl[$i][$j] > $maxSide {
$maxSide = @sl[$i;$j];
}
}
If the current cell contains a 0, we just ignore it anf go on to the next cell.
}
}
By now in $maxSide we have the length of a side of the maximal square. We can find the area simply
by squaring this number. One of the things I love about Raku is it makes extensive use of unicode. We
can simply use the 2 superscript character to perform the squaring operation.
say $maxSide²;
}
This is the Perl version:
sub minOf3($a, $b, $c) {
return $a < $b ? ($a < $c ? $a : $c) : ($b < $c ? $b : $c);
}
Having to simulate true 2d arrays with arrays of array references makes this code a little more awkward than Raku in my opinion.
my @matrix;
for my $row (@ARGV) {
push @matrix, [ split //, $row ];
}
my $rows = scalar @matrix;
my $cols = scalar @{$matrix[0]};
my $maxSide = 0;
my @sl = map { [(0) x $cols] } (0 .. $rows - 1);
for my $i (0 .. $rows - 1) {
for my $j (0 .. $cols - 1) {
if ($matrix[$i][$j] == 1) {
$sl[$i][$j] = ($i == 0 || $j == 0)
? 1
: minOf3($sl[$i - 1][$j],$sl[$i][$j -1 ],$sl[$i - 1][$j - 1]) + 1;
if ($sl[$i][$j] > $maxSide) {
$maxSide = $sl[$i][$j];
}
}
}
}
Because we don't have fancy unicode Raku operators, we have to sqaure $maxSide the
boring old-fashioned way.
say $maxSide * $maxSide;
Challenge 2:
Right Interval
You are given an array of
@intervals, where$intervals[i] = [starti, endi]and eachstartiis unique.The right interval for an interval
iis an intervaljsuch thatstartj >= endiandstartjis minimized. Please note thatimay equalj.Write a script to return an array of right interval indices for each interval
i. If no right interval exists for intervali, then put -1at indexi.
Example 1
Input: @intervals = ([3,4], [2,3], [1,2])
Output: (-1, 0, 1)
There is no right interval for [3,4].
The right interval for [2,3] is [3,4] since start0 = 3 is the smallest start that is >= end1 = 3.
The right interval for [1,2] is [2,3] since start1 = 2 is the smallest start that is >= end2 = 2.
Example 2
Input: @intervals = ([1,4], [2,3], [3,4])
Output: (-1, 2, -1)
There is no right interval for [1,4] and [3,4].
The right interval for [2,3] is [3,4] since start2 = 3 is the smallest start that is >= end1 = 3.
Example 3
Input: @intervals = ([1,2])
Output: (-1)
There is only one interval in the collection, so it outputs -1.
Example 4
Input: @intervals = ([1,4], [2, 2], [3, 4])
Output: (-1, 1, -1)
Once again we get the input from command-line arguments. For example 1, it would look like this: "3 4" "2 3" "1 2".
my @intervals = @args.map({ [ $_.split(/\s+/) ] });
We create a hash that maps each start time to its index in the @intervals array...
my %startIndices = @intervals.kv.map( -> $k, $v { @$v[0] => $k });
...and an array containing all start times, sorted in ascending numeric order.
my @starts = @intervals.map({ @$_[0] }).sort({ $^a <=> $^b });
And one more to store the results.
my @result;
Now we iterates over each interval.
for @intervals -> $interval {
For each interval, it finds the first start time in @starts that is greater than or equal to the end time of the current interval.
my $end = $interval[1];
my $rightInterval = @starts.first(* >= $end);
If such a start time is found, it pushes the corresponding index from %startIndices to @result.
if $rightInterval.defined {
@result.push(%startIndices{$rightInterval});
If no such start time is found, it pushes -1 to @result.
} else {
@result.push(-1);
}
}
Once all intervals have been processed, @result is printed out formatted in the style of the examples.
say q{(}, @result.join(q{, }), q{)};
The Perl version is quite similar to Raku.
my @intervals = map { [ split /\s+/ ] } @ARGV;
my %startIndices;
for my $k (keys @intervals) {
$startIndices{$intervals[$k]->[0]} = $k;
}
my @starts = sort { $a <=> $b } map { $_->[0] } @intervals;
my @result;
for my $interval (@intervals) {
my $end = $interval->[1];
my $rightInterval;
The only thing we lack is .first() so we have to simulate it with this loop.
for my $first (@starts) {
if ($first >= $end) {
$rightInterval = $first;
last;
}
}
if (defined $rightInterval) {
push @result, $startIndices{$rightInterval};
} else {
push @result, -1;
}
}
say q{(}, (join q{, }, @result), q{)};