Perl Weekly Challenge: Week 218
Challenge 1:
Maximum Product
You are given a list of 3 or more integers.
Write a script to find the 3 integers whose product is the maximum and return it.
Example 1
Input: @list = (3, 1, 2)
Output: 6
1 x 2 x 3 => 6
Example 2
Input: @list = (4, 1, 3, 2)
Output: 24
2 x 3 x 4 => 24
Example 3
Input: @list = (-1, 0, 1, 3, 1)
Output: 3
1 x 1 x 3 => 3
Example 4
Input: @list = (-8, 2, -9, 0, -4, 3)
Output: 216
-9 × -8 × 3 => 216
This can be solved in Raku as a one-liner. We take the command line arguments and find all combinations of three elements
using the .combinations() method. Then we convert each combination to its' product via .map() and the [*] hyper operator.
Then we find the largest product using .max() and print it out with .say().
@*ARGS.combinations(3).map({ [*] $_ }).max.say;
Perl is a bit more complicated because we need replacements for .combinations() and [*]. Fortunately I have those already from previous challenges. (the combinations() and products() functions.) Armed with these, the rest of the script is also a one-liner. 0+ has to be added to the beginning to prevent a warning about say() being treated as a function.
say 0+(sort { $b <=> $a } map { product($_) } combinations(\@ARGV, 3))[0];
Challenge 2:
Matrix Score
You are given a
m x nbinary matrix i.e. having only1and0.You are allowed to make as many moves as you want to get the highest score.
A move can be either toggling each value in a row or column.
To get the score, convert the each row binary to dec and return the sum.
Example 1
Input: @matrix = [ [0,0,1,1],
[1,0,1,0],
[1,1,0,0], ]
Output: 39
Move #1: convert row #1 => 1100
[ [1,1,0,0],
[1,0,1,0],
[1,1,0,0], ]
Move #2: convert col #3 => 101
[ [1,1,1,0],
[1,0,0,0],
[1,1,1,0], ]
Move #3: convert col #4 => 111
[ [1,1,1,1],
[1,0,0,1],
[1,1,1,1], ]
Score: 0b1111 + 0b1001 + 0b1111 => 15 + 9 + 15 => 39
Example 2
Input: @matrix = [ [0] ]
Output: 1
The first task is to assemble the matrix. I chose to enter it as a series of command-line arguments where each
argument represents a row of the matrix and the elements of each row are separated by commas. So for example 1,
the arguments would look like this: "0,0,1,1" "1,0,1,0" "1,1,0,0".
The code to convert that into a matrix looks like this:
my @matrix;
for 0 .. @args.end -> $i {
@matrix[$i].push(| @args[$i].split(/','/));
}
We need | to ensure that each row is an array not an array reference. Each element of the matrix is a string. I was
going to convert them to integers or booleans but we're not actually be doing any calculations with them so it wasn't worth it.
$m and $n are the dimensions of the matrix (rows and columns respectively.) Strictly speaking
they are not needed but they make the script a bit more readable.
my $m = @matrix.elems;
my $n = @matrix[0].elems;
One thing that immediately occurred to me (and I'm rather proud of being able to notice it given my usual math disability!) is that for the highest score, each row should begin with a 1 because binary digits double in value the further left you go.
So we go through the matrix by row...
for (0 ..^ $m) -> $i {
...and if the row begins with 0 it is toggled.
if @matrix[$i;0] eq '0' {
for (0 ..^ $n) -> $j {
@matrix[$i;$j] = (@matrix[$i;$j] eq '1' ?? '0' !! '1');
}
}
}
The columns have to be treated differently. Actually for the two examples given above, you could get away with simply toggling a column if it begin with a zero but according to this article what you really should do for an optimum score is only toggle a column if it has more zeros than ones.
So we traverse the matrix once again, this time by column...
for (0 ..^ $n) -> $i {
...and for each column we count up how many zeros and ones it has using .classify().
my %count = @matrix[0 ..^ $m;$i].classify({ $_; });
If there are more zeros than ones, the column is toggled.
if %count{0}.elems > %count{1}.elems {
for (0 ..^ $m) -> $j {
@matrix[$j;$i] = (@matrix[$j;$i] eq '1' ?? '0' !! '1');
}
}
}
Finally using .map() we convert each row of the matrix into a binary number by .join()ing up
the elements and prefixing them with 0b, summing up those numbers and printing the result.
@matrix.map({ '0b' ~ @$_.join(q{}) }).sum.say;
This is the Perl version.
my @matrix;
for my $i (0 .. scalar @ARGV - 1) {
my @row = split /,/, $ARGV[$i];
push @matrix, \@row;
}
my $m = scalar @matrix;
my $n = scalar @{$matrix[0]};
for my $i (0 .. $m - 1) {
if ($matrix[$i]->[0] eq '0') {
for my $j (0 .. $n - 1) {
$matrix[$i]->[$j] = ($matrix[$i]->[$j] eq '1' ? '0' : '1');
}
}
}
for my $i (0 .. $n - 1) {
Because we don't have .classify() we have to count zeros and ones in this more verbose way.
my $zeros = 0;
my $ones = 0;
for my $j (0 .. $m - 1) {
$matrix[$j]->[$i] eq '0' ? $zeros++ : $ones++;
}
if ($zeros > $ones) {
for my $j (0 .. $m - 1) {
$matrix[$j]->[$i] = ($matrix[$j]->[$i] eq '1' ? '0' : '1');
}
}
}
You can't do arithmetic on binary numbers in Perl so we have to convert them back into decimal with
oct(). We also don't have a standard sum() function so I provided my own.
say sum [ map { oct( '0b' . join q{}, @{$_} ) } @matrix ];