Perl Weekly Challenge: Week 257
Challenge 1:
Smaller Than Current
You are given a array of integers,
@ints.Write a script to find out how many integers are smaller than current i.e. foreach
ints[i], countints[j] < ints[i]wherei != j.
Example 1
Input: @ints = (5, 2, 1, 6)
Output: (2, 1, 0, 3)
For $ints[0] = 5, there are two integers (2,1) smaller than 5.
For $ints[1] = 2, there is one integer (1) smaller than 2.
For $ints[2] = 1, there is none integer smaller than 1.
For $ints[3] = 6, there are three integers (5,2,1) smaller than 6.
Example 2
Input: @ints = (1, 2, 0, 3)
Output: (1, 2, 0, 3)
Example 3
Input: @ints = (0, 1)
Output: (0, 1)
Example 4
Input: @ints = (9, 4, 9, 2)
Output: (2, 1, 2, 0)
In Raku the solution takes two lines of code.
First we sort @ints in ascending numeric order with .sort() and create a hash with it using .kv() and .Hash().
The keys of this hash will be the indices of the sorted elements of @ints and the values the elements themselves.
As an array index starts from 0 upwards, this has the added benefit of telling us how many smaller elements there are before
this one. Actually we want it the other way i.e. the elements as keys and the number of smaller integers as values so we reverse the hash with .antipairs().
my %sorted = @ints.sort.kv.Hash.antipairs;
Now all we need to do is go through @ints with .map() and replace each element with the value of its' key in %sorted. The rest of the line is just for pretty-printing the output.
say q{(}, @ints.map({ %sorted{$_} }).join(q{, }), q{)};
In Perl, we have the problem of not having .kv() so I emulated it by incrementinting a key starting from 0 for each element within a map() call. This has the fortunate side effect of not needing to be reversed afterwards as in Raku.
my $n = 0;
my %sorted = map { $_ => $n++ } sort { $a <=> $b } @ints;
And this does the same as the equivalent line in the Raku solution.
say q{(}, ( join q{, }, map { $sorted{$_} } @ints ), q{)};
So far so good. We get the proper answers for examples 1 to 3. With example 4 however, we get (3, 1, 3, 0) instead of the expected answer. What happened? The input has two elements with the same value. The first time, my code sees a 9, it is at
index 2 in the sorted array which is entered as its' value in the %sorted hash as it should be because there are two elements, 0 and 1 which are smaller than 9. However the second 9 is at index 3 and this overwrites the previous hash entry.
There are several ways I could have dealt with this but what I chose to do is go backwards like this:
my $n = scalar @ints - 1;
my %sorted = map { $_ => $n-- } reverse sort { $a <=> $b } @ints;
I start from the largest key i.e. the one at the end of the sorted array and assign values backwards starting from the last index and decrementing to 0. Now 9 => 3 gets added to the hash first but is overwritten by 9 => 2. We now get the correct answer.
Challenge 2:
Reduced Row Echelon
Given a matrix M, check whether the matrix is in reduced row echelon form.
A matrix must have the following properties to be in reduced row echelon form:
1. If a row does not consist entirely of zeros, then the first
nonzero number in the row is a 1. We call this the leading 1.
2. If there are any rows that consist entirely of zeros, then
they are grouped together at the bottom of the matrix.
3. In any two successive rows that do not consist entirely of zeros,
the leading 1 in the lower row occurs farther to the right than
the leading 1 in the higher row.
4. Each column that contains a leading 1 has zeros everywhere else
in that column.
For example:
[
[1,0,0,1],
[0,1,0,2],
[0,0,1,3]
]
The above matrix is in reduced row echelon form since the first nonzero number in each row is a 1, leading 1s in each successive row are farther to the right, and above and below each leading 1 there are only zeros.
For more information check out this wikipedia article.
Example 1
Input: $M = [
[1, 1, 0],
[0, 1, 0],
[0, 0, 0]
]
Output: 0
Example 2
Input: $M = [
[0, 1,-2, 0, 1],
[0, 0, 0, 1, 3],
[0, 0, 0, 0, 0],
[0, 0, 0, 0, 0]
]
Output: 1
Example 3
Input: $M = [
[1, 0, 0, 4],
[0, 1, 0, 7],
[0, 0, 1,-1]
]
Output: 1
Example 4
Input: $M = [
[0, 1,-2, 0, 1],
[0, 0, 0, 0, 0],
[0, 0, 0, 1, 3],
[0, 0, 0, 0, 0]
]
Output: 0
Example 5
Input: $M = [
[0, 1, 0],
[1, 0, 0],
[0, 0, 0]
]
Output: 0
Example 6
Input: $M = [
[4, 0, 0, 0],
[0, 1, 0, 7],
[0, 0, 1,-1]
]
Output: 0
The most "challenging" thing about this challenge was not the difficulty of the problem per se but how to organize the several checks we need to do efficiently. I am not sure if the code belowe is the most concise possible but it is better than my previous attempts.
We start in MAIN() by reading in a matrix. I did this the same way as in a couple of recent challenges by taking them from the command-line arguments. E.g. for example 4 they would look like this "0 1 -2 0 1" "0 0 0 0 0" "0 0 0 1 3" "0 0 0 0 0"
my @matrix = @args.map({ [ $_.words.map({ .Int }) ] });
Then a function isRREF() is called to check the status of the matrix. It returns True or False and this is converted
to 1 or 0 for output.
# Check if the matrix is in RREF
say isRREF(@matrix) ?? 1 !! 0; # Output: True
}
This is isRREF().
sub isRREF(@matrix) {
We will need to keep track of which column in the matrix has the leading 1.
my $leading = -1;
And if a row consisting of all 0s has been found.
my $zeroRow = False;
We iterate through each row of the matrix...
for @matrix.keys -> $row {
...and try and find a leading 1.
my $currentLeading = -1;
for @matrix[$row].keys -> $col {
if @matrix[$row;$col] == 1 {
$currentLeading = $col;
last;
}
}
If there was no leading 1...
if $currentLeading == -1 {
...we check if the row is all 0s. If it isn't, it means the there was a leading digit but it was something other than 1 which means this matrix is not in reduced row echelon form. It is pointless to continue so we simply return False.
if @matrix[$row].any > 0 {
return False;
}
If the row was all 0s, we set the $zeroRow flag to True and move on to the next row of the matrix.
$zeroRow = True;
next;
}
If we get here, we are processing a matrix row which does not contain all 0s. If the $zeroRow flag
is True, it implies that all the rows that contain all 0s are not at the bottom of the matrix. It is therefore not in reduced row echelon form so we return False.
if $zeroRow {
return False;
}
Another criterion is that if a leading 1 is seen in a matrix row, it should come after (i.e. be in a column to the right of)
any previously seen leading 1s. If it comes before, the matrix is not in reduced row echelon form so we return False.
if $currentLeading < $leading {
return False;
}
At this point we can be certain that the leading 1 of this row is the leading 1 of the matrix as a whole so far. So
$currentLeading is updated.
$leading = $currentLeading;
The current leading 1 should be the only element in its' column that is not 0. We check for this and if it is not true,
the matrix is not in reduced row echelon form so we return False.
if @matrix[*;$leading].grep({ $_ > 0 }) > 1 {
return False;
}
}
If every row in this matrix has successfully passed through this gauntlet of tests, the matrix is in reduced row echelon form so we return True.
return True;
}
The Perl version of isRREF() takes an array reference as an argument and returns 1 or 0.
sub isRREF {
my ($matrix) = @_;
my $leading = -1;
my $zeroRow = undef;
for my $row (keys @{$matrix}) {
my $currentLeading = -1;
for my $col (keys @{$matrix->[$row]}) {
if ($matrix->[$row][$col] == 1) {
$currentLeading = $col;
last;
}
}
if ($currentLeading == -1) {
if (grep { $_ > 1 } @{$matrix->[$row]}) {
return 0;
}
$zeroRow = 1;
next;
}
if ($zeroRow) {
return 0;
}
if ($currentLeading < $leading) {
return 0;
}
$leading = $currentLeading;
Getting a column out of a 2d array in Perl is awkward compared to Raku but it can be done with map().
if ((scalar grep { $_ > 0 } map { $matrix->[$_][$leading] } keys @{$matrix}) > 1) {
return 0;
}
}
return 1;
}