# Perl Weekly Challenge 218.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 218.

``````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  #
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
``````

``````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  #
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
``````
Written on May 22, 2023