Perl Weekly Challenge: Week 271
Challenge 1:
Maximum 1s
You are given a
m x nbinary matrix.Write a script to return the row number containing maximum ones, in case of more than one rows then return smallest row number.
Example 1
Input: $matrix = [ [0, 1],
[1, 0],
]
Output: 1
Row 1 and Row 2 have the same number of ones, so return row 1.
Example 2
Input: $matrix = [ [0, 0, 0],
[1, 0, 1],
]
Output: 2
Row 2 has the maximum ones, so return row 2.
Example 3
Input: $matrix = [ [0, 0],
[1, 1],
[0, 0],
]
Output: 2
Row 2 have the maximum ones, so return row 2.
There have been a number of matrix-related challenges lately including last week. So we already have code for creating a matrix from command-line argumentes.
my @matrix = @args.map({ [$_.words] });
For this challenge we will also need two additional variables to hold the most 1's found in a row of the matrix so far and the number of that row.
my $maxOnes = 0;
my $maxRow = 0;
Now we go through each row of the matrix noting the row number in $row.
for @matrix.keys -> $row {
We search for 1's in the row with .grep() and count how many we found with .elems().
my $ones = @matrix[$row].grep({ $_ == 1 }).elems;
If the number of 1's found is greater than our current value of $maxOnes...
if $ones > $maxOnes {
...we make it the new value of $maxOnes...
$maxOnes = $ones;
...and make the row number the new value of $maxRow. One thing that tripped me up is that
the spec assumes that rows are numbered starting from 1 not 0 as we normally do in computing. So we
have to add 1 to $row to get the right number.
$maxRow = $row + 1;
}
}
When we have proceessed all the rows, the answer will be in $maxRow so we print it out.
say $maxRow;
This is the Perl version which works exactly the same as in Raku.
my @matrix = map { [split /\s+/, $_] } @ARGV;
my $maxOnes = 0;
my $maxRow = 0;
for my $row (keys @matrix) {
my $ones = scalar grep { $_ == 1 } @{$matrix[$row]};
if ($ones > $maxOnes) {
$maxOnes = $ones;
$maxRow = $row + 1;
}
}
say $maxRow;
Challenge 2:
Sort by 1 Bits
You are give an array of integers,
@ints.Write a script to sort the integers in
ascendingorder by the number of1 bitsin their binary representation. In case more than one integers have the same number of1 bitsthen sort them inascending order.
Example 1
Input: @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8)
Output: (0, 1, 2, 4, 8, 3, 5, 6, 7)
0 = 0 one bits
1 = 1 one bits
2 = 1 one bits
4 = 1 one bits
8 = 1 one bits
3 = 2 one bits
5 = 2 one bits
6 = 2 one bits
7 = 3 one bits
Example 2
Input: @ints = (1024, 512, 256, 128, 64)
Output: (64, 128, 256, 512, 1024)
All integers in the given array have one 1-bits, so just sort them in ascending order.
We create a hash where the keys are elements of @ints and the values are the number of 1's in each element.
my %ones;
Then for each element...
for @ints -> $i {
...we convert it into binary with base(2) then split it into a list of binary digits with .comb() then
find all the 1's in that list with .grep() and count them with .elems(). This value is added to %ones with
the element as the key.
%ones{$i} = $i.base(2).comb.grep({ $_ == 1 }).elems;
}
Finally, we sort the keys of %ones (i.e. the elements of @ints) with the keys with a lower value of 1's coming
before the keys with more. In the event of a tie, the element that is numerically smaller comes first. The rest of the
line is just for printing out this sorted list in the style of the output in the examples.
say q{(}, %ones.keys.sort({ %ones{$^a} <=> %ones{$^b} || $^a <=> $^b }).join(q{, }), q{)};
Once again, the Perl solution is almost a direct translation of Raku.
my %ones;
for my $i (@ints) {
With one exception; Perl does not have .base(2) so we use sprintf("%b") instead.
$ones{$i} = scalar grep { $_ == 1} split //, sprintf("%b", $i);
}
say q{(}, (join q{, }, sort { $ones{$a} <=> $ones{$b} || $a <=> $b } keys %ones), q{)};