Perl Weekly Challenge 253: Weakest Row and Schwartzian Transform
These are some answers to the Week 253, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 28, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
Task 2: Weakest Row
You are given an m x n
binary matrix i.e. only 0 and 1 where 1 always appear before 0.
A row i
is weaker than a row j
if one of the following is true:
a) The number of 1s in row i is less than the number of 1s in row j.
b) Both rows have the same number of 1 and i < j.
Write a script to return the order of rows from weakest to strongest.
Example 1
Input: $matrix = [
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 0],
[1, 0, 0, 0, 0],
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 1]
]
Output: (2, 0, 3, 1, 4)
The number of 1s in each row is:
- Row 0: 2
- Row 1: 4
- Row 2: 1
- Row 3: 2
- Row 4: 5
Example 2
Input: $matrix = [
[1, 0, 0, 0],
[1, 1, 1, 1],
[1, 0, 0, 0],
[1, 0, 0, 0]
]
Output: (0, 2, 3, 1)
The number of 1s in each row is:
- Row 0: 1
- Row 1: 4
- Row 2: 1 Transform
- Row 3: 1
Note first that, for the purpose of this task, we don't really care whether the 1s come before the 0s in any row. We count the number of 1s in a given row by simply adding the items of the row.
Next, such a task is a perfect opportunity to use a powerful and efficient functional programming syntax construct called Schwartzian transform, named after Randal Schwartz, a famous author of Perl books. In its canonical form, the Schwartzian transform is a data pipeline consisting of three steps: map ... sort ... map
(to be read from bottom to top and right to left), in which: 1. the first map
(on the right) prepares the data by adding additional information, 2. the sort
uses the data thus enriched to reorder the records, and 3. the last map
(on the left) extract the desired data from the structure generated by the sort
. The Schwartzian transform is quite commonly used in Perl, but less so in Raku, because the built-in Raku sort
has some powerful features which can often cache the intermediate results in a simpler manner without this construct. In the specific case at hand, I felt that using the Schwartzian tranform was simpler.
Weakest Row in Raku
The solution is quite simple once you understand the Schwartzian transform explained in the previous section. The input is simply a list of row indexes (bottom right). The first map
(at the bottom) creates a list of records containing the index and sum of items for each row, the sort
sorts the record according to the row sum and, in the event of a draw, the row index, ands, finally the last map
(at the top) extracts the row index from each record.
sub weakest-row (@matrix) {
# Schwartzian transform
return map { $_[0] },
sort { $^a[1] <=> $^b[1] || $^a[0] <=> $^b[0]},
map { [ $_, @matrix[$_].sum ] }, 0..@matrix[0].end;
}
my @tests = (
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 0],
[1, 0, 0, 0, 0],
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 1]
),
(
[1, 0, 0, 0],
[1, 1, 1, 1],
[1, 0, 0, 0],
[1, 0, 0, 0]
);
for @tests -> @test {
printf "%-12s ... %-12s => ", "@test[0]", "@test[*-1]";
say weakest-row @test;
}
This program displays the following output:
$ raku ./weakest-row.raku
1 1 0 0 0 ... 1 1 1 1 1 => (2 0 3 1 4)
1 0 0 0 ... 1 0 0 0 => (0 2 3 1)
For the purpose of formatting the output on a reasonable line length, I only displayed the first and last rows of the input matrix.
Weakest Row in Perl
This is a port to Perl of the Raku program above, also using the Schwartzian transform described in the above sections. The only significant difference is that I have added a sum
helper subroutine to compute the sum of the items of an input array.
use strict;
use warnings;
use feature 'say';
sub sum {
my $sum = 0;
$sum += $_ for @_;
return $sum;
}
sub weakest_row {
my @matrix = @_;
my $row_end = @{$matrix[0]} -1;
# Schwartzian transform
return map { "$_->[0] " }
sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0]}
map { [ $_, sum @{$matrix[$_]} ] } 0..$row_end;
}
my @tests = ( [
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 0],
[1, 0, 0, 0, 0],
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 1]
],
[
[1, 0, 0, 0],
[1, 1, 1, 1],
[1, 0, 0, 0],
[1, 0, 0, 0]
]
);
for my $test (@tests) {
printf "%-10s ... %-10s => ",
"@{$test->[0]}", "@{$test->[-1]}";
say weakest_row @$test;
}
This program displays the following output:
$ perl ./weakest-row.pl
1 1 0 0 0 ... 1 1 1 1 1 => 2 0 3 1 4
1 0 0 0 ... 1 0 0 0 => 0 2 3 1
Wrapping up
The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on February 4, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
Leave a comment