Perl Weekly Challenge 218.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 218.
Task 1: Maximum Product
Submitted by: Mohammad S Anwar
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
The largest product is obtained by multiplying the three largest numbers. Nevertheless, as there could be negative ones, I have to choose the three with the largest magnitude. However, if the number of negatives chosen is odd, I should replace the chosen negative closest to zero by the largest remaining positive number. This changes if all numbers are negative, in which case I must choose the three with the largest value, i.e., the smallest magnitude. Simple but confusing. Assuming that at least one number is positive, the solution fits a two liner. First I sort the input in increasing order. Then I sort the three first terms so that if there is a negative number, the one closest to zero comes first. Then I replace that number with succesive inputs until I get a positive product, the desired result.
Example 1:
perl -MList::Util=product -E '
@s=sort {abs($b) <=> abs($a)} @ARGV; @r=sort {$a<0?($b>=0?-1:$b<=>$a):$b<0?1:$a<=>$b} splice @s,0,3;
$r[0]=shift @s while((product @r) <= 0 && @s); say "@ARGV->", product @r;
' -- 3 1 2
Results:
3 1 2->6
Further examples:
perl -MList::Util=product -E '
@s=sort {abs($b) <=> abs($a)} @ARGV; @r=sort {$a<0?($b>=0?-1:$b<=>$a):$b<0?1:$a<=>$b} splice @s,0,3;
$r[0]=shift @s while((product @r) <= 0 && @s); say "@ARGV->", product @r;
' -- 4 1 3 2
perl -MList::Util=product -E '
@s=sort {abs($b) <=> abs($a)} @ARGV; @r=sort {$a<0?($b>=0?-1:$b<=>$a):$b<0?1:$a<=>$b} splice @s,0,3;
$r[0]=shift @s while((product @r) <= 0 && @s); say "@ARGV->", product @r;
' -- -1 0 1 3 1
perl -MList::Util=product -E '
@s=sort {abs($b) <=> abs($a)} @ARGV; @r=sort {$a<0?($b>=0?-1:$b<=>$a):$b<0?1:$a<=>$b} splice @s,0,3;
$r[0]=shift @s while((product @r) <= 0 && @s); say "@ARGV->", product @r;
' -- -8 2 -9 0 -4 3
Results:
4 1 3 2->24
-1 0 1 3 1->3
-8 2 -9 0 -4 3->216
An example with the wrong result
perl -MList::Util=product -E '
@s=sort {abs($b) <=> abs($a)} @ARGV; @r=sort {$a<0?($b>=0?-1:$b<=>$a):$b<0?1:$a<=>$b} splice @s,0,3;
$r[0]=splice(@s,0,1) while(($r=product @r) <= 0 && @s); say "@ARGV->", product @r;
' -- -1 -2 -3 -4
Results:
-1 -2 -3 -4->-12
This is wrong, as (-1)×(-2)×(-3)=-6 is larger than -12.
I can avoid the strange sort if instead of replacing the undesired negative number, I divide it out and multiply by the alternatives. However, the code is almost as long:
perl -MList::Util=product,max -E '
@s=sort {abs($b) <=> abs($a)} @ARGV; @r=splice @s,0,3; $x=$y=(max grep {$_<0} @r)//1;
$y=shift @s while((product @r)*$y/$x <= 0 && @s); say "@ARGV->", (product @r)*$y/$x;
' -- 3 1 2
perl -MList::Util=product,max -E '
@s=sort {abs($b) <=> abs($a)} @ARGV; @r=splice @s,0,3; $x=$y=(max grep {$_<0} @r)//1;
$y=shift @s while((product @r)*$y/$x <= 0 && @s); say "@ARGV->", (product @r)*$y/$x;
' -- 4 1 3 2
perl -MList::Util=product,max -E '
@s=sort {abs($b) <=> abs($a)} @ARGV; @r=splice @s,0,3; $x=$y=(max grep {$_<0} @r)//1;
$y=shift @s while((product @r)*$y/$x <= 0 && @s); say "@ARGV->", (product @r)*$y/$x;
' -- -1 0 1 3 1
perl -MList::Util=product,max -E '
@s=sort {abs($b) <=> abs($a)} @ARGV; @r=splice @s,0,3; $x=$y=(max grep {$_<0} @r)//1;
$y=shift @s while((product @r)*$y/$x <= 0 && @s); say "@ARGV->", (product @r)*$y/$x;
' -- -8 2 -9 0 -4 3
Results:
3 1 2->6
4 1 3 2->24
-1 0 1 3 1->3
-8 2 -9 0 -4 3->216
For the full code I add some tests and the case of all negative numbers.
1 # Perl weekly challenge 218
2 # Task 1: Maximum Product
3 #
4 # See https://wlmb.github.io/2023/05/22/PWC218/#task-1-maximum-product
5 use v5.36;
6 use List::Util qw(all product);
7 say <<~"FIN" unless @ARGV >= 3;
8 Usage: $0 N1 N2 N3 [N4...]
9 to find the maximum product of three numbers from
10 the list N1 N2...
11 FIN
12 my $no_positive= all {$_<=0} @ARGV;
13 my $result;
14 if($no_positive){
15 my @sorted=sort {$b <=> $a} @ARGV;
16 $result=product splice @sorted,0,3;
17 }else{
18 my @sorted = sort {abs($b) <=> abs($a)} @ARGV;
19 my @result = sort by_strange_criteria splice @sorted, 0, 3;
20 $result[0] = shift @sorted while((product @result) <= 0 && @sorted);
21 $result = product @result;
22 }
23 say "@ARGV->", $result;
24 sub by_strange_criteria {
25 return -1 if $a<0 and $b >=0;
26 return $b<=>$a if $a < 0 and $b < 0;
27 return 1 if $b<0 and $a >= 0;
28 return $a<=>$b;
29 }
Examples:
./ch-1.pl 3 1 2 # Ex. 1
./ch-1.pl 4 1 3 2 # Ex. 2
./ch-1.pl -1 0 1 3 1 # Ex. 3
./ch-1.pl -8 2 -9 0 -4 3 # Ex. 4
./ch-1.pl -1 -2 -3 -4 # All negative
Results:
3 1 2->6
4 1 3 2->24
-1 0 1 3 1->3
-8 2 -9 0 -4 3->216
-1 -2 -3 -4->-6
Task 2: Matrix Score
Submitted by: Mohammad S Anwar
You are given a m x n binary matrix i.e. having only 1 and 0.
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
Since the value of a matrix is linear in its entries, I guess it is safe to assume there are no local maxima, that is, if a given conversion increases the value of a matrix, it can be performed safely as a step in the route to the global maximum. Thus, I look at each row and each column, making a conversion whenever it yields a higher value, and continue until no further increase is possible. I use the Perl Data Language, PDL, to simplify reading and manipulating arrays. The results fit a three liner.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){$x=pdl($_);$p=2**$x->xvals->(-1:0);while(c()){} say "$_ -> ", v($x);}
sub c(){for(0,1){$s=$_?":,":"";for(0..$x->dim($_)-1){$y=$x->copy;$y("$s$_").=!$y("$s$_");
$x("$s$_").=$y("$s$_"),return 1 if v($y)>v($x);}}0} sub v($z){($z*$p)->sum}
' '[[0,0,1,1],[1,0,1,0],[1,1,0,0]]' '[[0]]'
Results:
[[0,0,1,1],[1,0,1,0],[1,1,0,0]] -> 39
[[0]] -> 1
Results:
39
The full code has some comments to explain what I’m doing:
1 # Perl weekly challenge 218
2 # Task 2: Matrix Score
3 #
4 # See https://wlmb.github.io/2023/05/22/PWC218/#task-2-matrix-score
5 use v5.36;
6 use PDL;
7 use PDL::NiceSlice;
8 use experimental qw(try);
9 say <<~"FIN" unless @ARGV;
10 Usage: $0 M1 M2...
11 to find the score of matrices M1, M2...,
12 where each M is of the form [[b_11, b_12...],[b_21, b_22...]...]
13 and each b_ij is a bit (0 or 1)
14 FIN
15 my $p;
16 for(@ARGV){
17 try {
18 my $x=pdl($_);
19 die "Matrix should be binary" unless (($x==0)|($x==1))->all;
20 die "Matrix should be 2D" unless $x->ndims==2;
21 $p=2**$x->xvals->(-1:0); # descending powers of 2, to convert from bit matrix to decimal
22 my $y;
23 $x=$y while(defined ($y=convert($x))); # Make as many conversions as possible
24 say "$_ -> ", value($x);
25 }
26 catch($e){
27 say "$e: $_";
28 }
29 }
30
31 sub convert($x){
32 for(0,1){ # rows or columns
33 my $s=$_ ? ":," : ""; # argument to slice second or first dimension
34 for(0..$x->dim($_)-1){ # for each column or each row
35 my $y=$x->copy; # make a copy of the argument
36 $y("$s$_").=!$y("$s$_"); # complement the bits of the row or column
37 return $y if value($y)>value($x); # return modified matrix if better
38 }
39 }
40 return; # undef if no conversion found, done
41 }
42
43 sub value($z){ # turn binary matrix into number
44 ($z*$p)->sum
45 }
46
Example:
./ch-2.pl '[[0,0,1,1],[1,0,1,0],[1,1,0,0]]' '[[0]]'
Results:
[[0,0,1,1],[1,0,1,0],[1,1,0,0]] -> 39
[[0]] -> 1