Originally published on 21 November 2020
It’s been a busy week both at work and at home so I wasn’t able to tackle last week’s Challenge 086 of the Perl Weekly Challenge. And truth be told, I doubt I would have been able to solve the Sodoku task either way! But I did manage to carve out some time during the evenings this week to try Challenge 087 and here is what I came up with. The deadline to submit solutions for this challenge is fast approaching so if you haven’t solved it yourself yet, you may want to come back to this post later.
Task #1, “Longest Consecutive Sequence”, asks the following:
You are given an unsorted array of integers @N.
Write a script to find the longest consecutive sequence. Print 0 if no 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: 0Example 3:
Input: @N = (20, 19, 9, 11, 10)
Output: (9, 10, 11)In what, as you’ll see later down in Task 2, is becoming a recurring trend, my solution to this problem was to use a naive, brute-force approach where something more sophisticated such as recursion or sorting the array may have been a better option. But as I was solving these tasks later at night when my brain power was nearly empty, this was the best I could come up with.
For each element ($i) stored our array @input, we simply check to see if the next integer, $checkFor, exists in the array. The money statement in this solution is the while loop:
while ( grep( $_ eq $checkFor, @input ) )which checks whether each subsequent integer exist in the array. If it does, increment the sequence length counter, add the integer to the @currentSequence array which holds the current longest sequence, and increment the $checkFor variable to look for the next number in the sequence.
As I mentioned earlier, in terms of efficiency, this solution won’t win any prizes. I suppose that as we add each subsequent integer to our @currentSequence array, we could pop it from the @input array to reduce our search space. But for inputs with moderately small numbers of elements, I didn’t feel the need to pursue further optimizations.
All in, our solution looks like the following:
use warnings;
use strict;
use feature 'say';
# run program as:
# $ ./ch-1.pl "100, 4, 50, 3, 2"
my @input = split /, /, $ARGV[0];
my $longestSequenceLength = 0;
my @longestSequence;
foreach my $i (@input) {
my @currentSequence;
push (@currentSequence, $i);
my $currentSequenceLength = 1;
my $checkFor = $i + 1;
while ( grep( $_ eq $checkFor, @input ) ) {
$currentSequenceLength++;
push (@currentSequence, $checkFor);
$checkFor++;
}
if ($currentSequenceLength > $longestSequenceLength) {
$longestSequenceLength = $currentSequenceLength;
@longestSequence = @currentSequence;
}
}
print "Output: ";
if ($longestSequenceLength > 1) {
say "(", join(", ", @longestSequence), ")";
} else {
say 0;
}Task #2, “Largest Rectangle”, took much longer to reach a solution and was much more complicated even though it seems deceptively straightforward. The task states:
You are given matrix m x n with 0 and 1.
Write a script to find the largest rectangle containing only 1. Print 0 if 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: 0Example 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 ]I made an assumption that the rectangle has to contain at least two rows and two columns so that a rectangle like this
[ 1 1 1 1 1 ]would not be valid but a square like this
[ 1 1 ]
[ 1 1 ]would be.
Like Task 2 from Challenge 084, the key for me in solving this was to break down the problem in a series of smaller, more manageable steps and then tackle them one at a time. At a high-level, those smaller steps were:
1.The solution I came up with is pretty naive and uses a brute-force technique as you’ll soon see.
The first sub-task was to figure out how to take the input and process it into a matrix, or a two-dimensional array. I just ended up re-using the subroutine &define_matrix that I came up with in Challenge 084 so that I could easily check that box off! My blog post for that challenge goes into more detail on how that subroutine works.
Next, I traverse the matrix and find all possible rectangles. I do this by looking at all possible positions and sizes of rectangles. To evaluate all the positions, we look for all possible locations of the top-left vertex of a rectangle:
X------------
| |
| |
| |
-------------To do this, I start at the top-left corner of the matrix itself (at row = 0; column = 0) and first work my way to the right (represented by the inner for $c loop) and then down the matrix (represented by the outer for $r loop):
for (my $r = 0; $r < ($num_rows - 1); $r++) {
for (my $c = 0; $c < ($num_columns - 1); $c++) {Once we locate the position of the top-left corner of a rectangle, I iterate through all possible sizes of that rectangle going from largest possible size to the smallest by locating all possible positions of the bottom-right corner the rectangle.
-------------
| |
| |
| |
------------XTo do this, I start at the bottom-right of the overall matrix (row = m; column = n) and first work my way up (represented by the inner for $bottom_row loop) and then to the left (represented by the outer for $right_column loop):
for (my $right_column = $num_columns - 1; $right_column > $c;
$right_column--) {
for (my $bottom_row = $num_rows - 1; $bottom_row > $r;
$bottom_row--) {Iterating through these four nested for loops allows us to identify all possible combinations of the top-left/bottom-right vertices (and thus all possible rectangles) within the matrix. As I mentioned above, this is a pretty good example of a brute-force approach. I imagine there are probably more elegant methods that employ recursion but as I mentioned in my last post, I still struggle with implementing recursive functions that go beyond the most basic applications.
Now that we know how to find all possible rectangles within the problem input, we can move onto step 3 from above and check whether that rectangle contains only the value 1 at all positions within it. I do this via a two-step process. First, we collect all the ones and zeros from the rectangle we have defined in step 2 and put them in the array @elements. I do this via yet another for loop where the row/column of the top-left corner of the rectangle are represented by $r and $c respectively and the row/column of the bottom-right vertex is stored in $bottom_row and $right_column, respectively:
for (my $y = $r; $y <= $bottom_row; $y++) {
my $rowref = $matrix[$y];
push (@elements, @$rowref[$c .. $right_column]);
}It took me awhile to come up with the @$rowref portion of the push statement as this required the use of array references as well as a lengthy discussion on the PerlMonks site. At this point, @elements now contains a list of all of the ones and zeros within the rectangle. We can pass it to the subroutine &all_ones which does the heavy lifting to see if all of the elements are equal to 1 using this if statement:
if (@_ == grep { $_ eq '1' } @_)I must admit that I did not come up with this expression myself but do appreciate the “Perlishness” of it. An alternative way to check this, assuming that all of the elements are either 0 or 1, is to see if the sum of the elements in the array equals the length of the array.
Assuming that our subroutine &all_ones returns true (meaning that the rectangle only contains all 1s), the penultimate step is to see if the area of the current rectangle exceeds that of the last rectangle we found that meets this condition. If it does, we store the rectangle’s area and coordinates for later use:
if ($area > $largest_rectangle_area) {
$largest_rectangle_area = $area;
@largest_rectangle_vertices = (
$c, $r, $right_column, $bottom_row);One optimization we can employ before we call &all_ones is to see whether the area of the rectangle we are currently on exceeds the area of the rectangle containing all 1s that we know of. If it does not, there’s no sense in calling &all_ones because even if it contained all 1s, it’s too small to be our winner. We can do this by inserting
last if ($area < $largest_rectangle_area);before we collect the rectangle’s elements in the for $y loop which then obviates the need to run the if ($area > $largest_rectangle_area) check. In that case, we already know that the rectangle’s area exceeds that of the current candidate so we can immediately go onto storing the $largest_rectangle_area and @largest_rectangle_vertices. In practice, however, at least for the datasets I was playing around with, I didn’t see any noticeable efficiencies.
The final step is to print our results. If we ended up finding a rectangle containing all 1s, we output it using the &print_solution subroutine. My only flourish here was to make it clearer where in the overall matrix we found the largest rectangle. For example:
Input:
[ 0 0 1 0 1 0 ]
[ 1 1 1 1 1 0 ]
[ 0 0 1 0 1 1 ]
[ 1 1 1 1 1 0 ]
[ 1 0 1 0 1 0 ]
[ 0 0 1 1 1 1 ]
[ 1 1 1 1 0 1 ]
[ 0 0 1 0 0 1 ]
[ 0 0 1 1 1 1 ]
[ 0 0 1 1 1 1 ]
Largest rectangle found here:
[ _ _ _ _ _ _ ]
[ _ _ _ _ _ _ ]
[ _ _ _ _ _ _ ]
[ _ _ _ _ _ _ ]
[ _ _ _ _ _ _ ]
[ _ _ _ _ _ _ ]
[ _ _ _ _ _ _ ]
[ _ _ _ _ _ _ ]
[ _ _ 1 1 1 1 ]
[ _ _ 1 1 1 1 ]That’s all there is to it! Putting it alll together, here is what I came up with to solve this task:
#!/usr/local/bin/perl
use v5.10;
use warnings;
use strict;
sub define_matrix {
open (INPUT, '<', $_[0]) or die "$!: could not open file $_[0]";
say "Input:";
my (@line, @matrix, $rows, $columns);
while (<INPUT>) {
chomp;
say $_;
s/\[ //;
s/ \]//;
@line = split / /, $_;
push (@matrix, [@line]);
}
close (INPUT) or die "$!: could not close file $_[0]";
$rows = scalar @matrix;
$columns = scalar @line;
return ($rows, $columns, @matrix);
}
sub all_ones {
if (@_ == grep { $_ eq '1' } @_) {
return 1;
} else {
return 0;
}
}
sub print_solution {
my ($rows, $columns, $topleft_column, $topleft_row,
$bottomright_column, $bottomright_row) = @_;
for (my $row = 0; $row < $rows; $row++) {
print "[ ";
for (my $column = 0; $column < $columns; $column++) {
if ($row < $topleft_row || $row > $bottomright_row) {
print "_ ";
} elsif ($column < $topleft_column || $column > $bottomright_column) {
print "_ ";
} else {
print "1 ";
}
}
print "]\n";
}
}
my ($num_rows, $num_columns, @matrix) = &define_matrix($ARGV[0]);
my $largest_rectangle_area = 0;
my @largest_rectangle_vertices;
for (my $r = 0; $r < ($num_rows - 1); $r++) {
for (my $c = 0; $c < ($num_columns - 1); $c++) {
for (my $right_column = $num_columns - 1;
$right_column > $c;
$right_column--) {
for (my $bottom_row = $num_rows - 1;
$bottom_row > $r;
$bottom_row--) {
my $area = ($right_column - $c + 1) *
($bottom_row - $r + 1);
# the next statement doesn't really save that much time but
# no need to check a rectangle whose area is less than one
# that has already been found
#last if ($area < $largest_rectangle_area);
my @elements;
for (my $y = $r; $y <= $bottom_row; $y++) {
my $rowref = $matrix[$y];
push (@elements, @$rowref[$c .. $right_column]);
}
if (&all_ones(@elements)) {
if ($area > $largest_rectangle_area) {
$largest_rectangle_area = $area;
@largest_rectangle_vertices = (
$c, $r, $right_column, $bottom_row);
} # end if $area
} # end if &all_ones
} # end for $bottom_row
} # end for $right_column
} # end for $c
} # end for $r
print "\n";
if ($largest_rectangle_area) {
say "Largest rectangle found here:";
&print_solution($num_rows, $num_columns, @largest_rectangle_vertices);
} else {
say "No rectangle found.";
}That’s it for this week’s challenge. This ended up being more difficult but more fun than I expected and am looking forward to seeing how everyone else solved this as well!