Perl Weekly Challenge: Week 87
Challenge 1:
Longest Consecutive Sequence
You are given an unsorted array of integers
@N.Write a script to find the longest consecutive sequence. Print 0 if none sequence found.
Example 1:
Input: @N = (100, 4, 50, 3, 2)
Output: (2, 3, 4)
Example 2:
Input: @N = (20, 30, 10, 40, 50)
Output: 0
Example 3:
Input: @N = (20, 19, 9, 11, 10)
Output: (9, 10, 11)
This is my Perl solution.
First the input (which I get from the command line) has to be sorted. It irks me
that Perl can't automatically sort lists of numbers without $a <=> $b. It trips
me up every time. Perl does all kinds of other things automagically so I don't
know why it can't do this especially as Raku manages it. Oh well.
my @N = sort { $a <=> $b } @ARGV;
I set up two arrays, @sequence which contains the current sequence (initially seeded
with the first element of @N) and @longest which is initially empty but will keep the
longest sequence found so far.
my @sequence = ( $N[0] );
my @longest;
Now we can just traverse @N starting from the second element and compare it to the
previous element. If it is 1 greater, it can be added to the running @sequence.
If @sequence is longer than @longest, it becomes @longest.
But if the current element is greater than one more than the previous element, @sequence
has to be restarted with the current element.
for my $i (1 .. scalar @N - 1) {
if ($N[$i] == $N[$i - 1] + 1) {
push @sequence, $N[$i];
if (scalar @sequence > scalar @longest) {
@longest = @sequence;
}
} else {
@sequence = ( $N[$i] );
}
}
By the end either we have a longest sequence which we can print (I've also chosen to add
() around it) or @sequence is empty and we print 0.
say scalar @longest ? (q{(} . (join q{, }, @longest) . q{)}) : 0;
This is the Raku version. It's just a straightforward port so there isn't more to say.
sub MAIN(*@N) {
my @n = @N.sort;
my @sequence = ( @n[0] );
my @longest;
for 1 ..^ @n.elems -> $i {
if @n[$i] == @n[$i - 1] + 1 {
@sequence.push(@n[$i]);
if @sequence.elems > @longest.elems {
@longest = @sequence;
}
} else {
@sequence = ( @n[$i] );
}
}
say @longest.elems ?? (q{(} ~ @longest.join(q{, }) ~ q{)}) !! 0;
}
Challenge 2:
Largest Rectangle
You are given matrix
m x nwith0and1.Write a script to find the largest rectangle containing only
1. Print0if none found.
Example 1:
Input:
[ 0 0 0 1 0 0 ]
[ 1 1 1 0 0 0 ]
[ 0 0 1 0 0 1 ]
[ 1 1 1 1 1 0 ]
[ 1 1 1 1 1 0 ]
Output:
[ 1 1 1 1 1 ]
[ 1 1 1 1 1 ]
Example 2:
Input:
[ 1 0 1 0 1 0 ]
[ 0 1 0 1 0 1 ]
[ 1 0 1 0 1 0 ]
[ 0 1 0 1 0 1 ]
Output: 0
Example 3:
Input:
[ 0 0 0 1 1 1 ]
[ 1 1 1 1 1 1 ]
[ 0 0 1 0 0 1 ]
[ 0 0 1 1 1 1 ]
[ 0 0 1 1 1 1 ]
Output:
[ 1 1 1 1 ]
[ 1 1 1 1 ]
My first impression was that this problem is quite similar to challenge 2 in week 84 and I hoped I would be able to reuse that code but in fact I had to modify it quite a bit because in that challenge we only needed to find the four corners of a rectangle whereas we need to know the value of all its internal points too. I'll show you my Raku solution first.
sub MAIN(
Str $file #= a file describing a matrix of 1's and 0's where every line
#= is a row in the matrix.
) {
The matrix is read from a file and a regular expression is used to extract the 1's and 0's
into a 2d array.
my @matrix;
for $file.IO.lines -> $line {
@matrix.push($line.match(/ (0|1) /, :g));
}
Two variables are set up to store the largest rectangle found so far. Only it's height and width need to be stored.
my $maxheight = 0;
my $maxwidth = 0;
Now we go through @matrix row by row and column by column.
for 0 ..^ @matrix.elems -> $m {
for 0 ..^ @matrix[$m].elems -> $n {
If a 1 is found, it is a potential rectangle. So we make some variables to record
its origin (the upper left corner) and its height and width.
if @matrix[$m][$n] == 1 {
my $row = $m;
my $col = $n;
my $left = $n;
my $height = 0;
my $width = 0;
We then see how many consecutive 1's there are on that row.
while $col < @matrix[$row].elems && @matrix[$row][$col] == 1 {
$width++;
$col++;
}
Then we see how many rows there are with the same number of 1's in the same position. Note
the use of .all() and an array slice to represent a row of the rectangle.
while $row < @matrix.elems && @matrix[$row][$left ..^ $left + $width].all == 1 {
$height++;
$row++;
}
This gives us a rectangle. We compare the area of this rectangle to the area of the previous largest rectangle if any. If the current rectangle is larger, it becomes the new largest rectangle.
if $height * $width > $maxheight * $maxwidth {
$maxheight = $height;
$maxwidth = $width;
}
}
}
}
When @matrix has been fully searched, we will know the size of the largest rectangle.
Apparently according to the examples given with the spec, 1x1 rectangles (i.e. single 1 values)
don't count for this challenge so we check if the area of the largest rectangle is 2 or more.
If it is, we print out a rectangle of 1s of similar size otherwise we print 0.
if $maxheight * $maxwidth < 2 {
say '0';
} else {
for 0 ..^ $maxheight {
say q{[ }, "1 " x $maxwidth, q{]};
}
}
}
The only big difference in the Perl code is that there is no .all() method so I wrote a quick subroutine to mimic it.
In retrospect, using grep() instead of a for loop would have been more concise.
sub all {
my @array = @_;
for (@array) {
if ($_ != 1) {
return undef;
}
}
return 1;
}
The rest is pretty much the same as Raku so I have not bothered reproducing it here.