# Perl Weekly Challenge 211.

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

``````Submitted by: Mohammad S Anwar
You are given a matrix m x n.

Write a script to find out if the given matrix is Toeplitz
Matrix.

A matrix is Toeplitz if every diagonal from top-left to
bottom-right has the same elements.

Example 1
Input: @matrix = [ [4, 3, 2, 1],
[5, 4, 3, 2],
[6, 5, 4, 3],
]
Output: true
Example 2
Input: @matrix = [ [1, 2, 3],
[3, 2, 1],
]
Output: false
``````

The k-th diagonal has elements with indices k+i,i with the constraints 0<=k+i<N, 0<=i<M, and thus, -M<k<N. I read the space separated matrix elements from STDIN, one row at a time and then check that the diagonals have one `uniq` element each. This fits a 1.5 liner.

``````perl  -MList::Util=max,min,uniq -nE '\$m[\$N++]=[split " "];END {\$M=@{\$m};\$L=max(\$N,\$M);\$t=1;for \$k
(-\$M+1..\$N-1){\$t&&=1==uniq map {\$m[\$k+\$_][\$_]} max(0, -\$k)..min(\$M-1,\$N-\$k-1)}say \$t?"true":"false";}
' << FIN
4 3 2 1
5 4 3 2
6 5 4 3
FIN
``````

Results:

``````true
``````

Another example:

``````perl  -MList::Util=max,min,uniq -nE '\$m[\$N++]=[split " "];END {\$M=@{\$m};\$L=max(\$N,\$M);\$t=1;for \$k
(-\$M+1..\$N-1){\$t&&=1==uniq map {\$m[\$k+\$_][\$_]} max(0, -\$k)..min(\$M-1,\$N-\$k-1)}say \$t?"true":"false";}
' << FIN
1 2 3
3 2 1
FIN
``````

Results:

``````false
``````

An alternative is to use PDL, which has facilities for selecting unique elements and for manipulating the diagonals of a matrix. However, it only works for square matrices. Thus, I can extend a rectangular matrix into a square matrix by adding BAD values and then check its diagonals.

``````perl -MPDL -MPDL::LinearAlgebra -E 'while(@ARGV){\$m=pdl(shift);(\$M,\$N)=\$m->dims; \$L=pdl(\$N,\$M)->max;
say "\$m -> ",  pdl(map {\$n->diag(\$_)->uniq->nelem==1} -\$L+1..\$L-1)->all?"True":"False" }
' '[[4, 3, 2, 1],[5,4,3,2],[6,5,4,3]]'  '[[3,2,1],[1,2,3]]'
``````

Results:

``````[
[4 3 2 1]
[5 4 3 2]
[6 5 4 3]
]
-> True

[
[3 2 1]
[1 2 3]
]
-> False
``````

However, the code is neither shorter nor clearer, so I follow the first approach for the full code.

`````` 1  # Perl weekly challenge 211
2  # Task 1:  Toeplitz Matrix
3  #
5  use v5.36;
6  use List::Util qw(max min uniq);
7  my @matrix;
8  my \$N=0; # number of rows
9  while(<>){ # read the matrix, a space separated row at a time
10      \$matrix[\$N++]=[split " "];
11  }
12  my \$M=@{\$matrix}; # Number of columns
13  @{\$matrix[\$_]}==\$M || die "Not rectangular"  for(1..\$N-1);
14  my \$largest=max(\$N,\$M);
15  my \$toeplitz=1;      # matrix is toeplitz
16  for my \$diagonal(-\$M+1..\$N-1){
17      \$toeplitz &&=    # unless it is not
18          1==uniq
19  	map {\$matrix[\$diagonal+\$_][\$_]}
20          max(0, -\$diagonal)..min(\$M-1,\$N-\$diagonal-1);
21  }
22  say "@{\$matrix[\$_]}" for 0..\$N-1;
23  say " -> ", \$toeplitz?"true":"false";
``````

Example:

``````./ch-1.pl << FIN
4 3 2 1
5 4 3 2
6 5 4 3
FIN
``````

Results:

``````4 3 2 1
5 4 3 2
6 5 4 3
-> true
``````

Other example:

``````./ch-1.pl << FIN
3 2 1
1 2 3
FIN
``````

Results:

``````3 2 1
1 2 3
-> false
``````

# Task 2: Split Same Average

``````Submitted by: Mohammad S Anwar
You are given an array of integers.

Write a script to find out if the given can be split into two separate arrays whose
average are the same.

Example 1:
Input: @nums = (1, 2, 3, 4, 5, 6, 7, 8)
Output: true
(1 2 3 4 5 6 7 8)
We can split the given array into (1, 4, 5, 8) and (2, 3, 6, 7).
The average of the two arrays are the same i.e. 4.5.
Example 2:
Input: @list = (1, 3)
Output: false
``````

Of course each average should equal the average of all given numbers. So it is enough to find a proper subset whose average equals the global average. The simplest approach would be to filter all subsets until an appropriate one is found, although for large inputs it would be very slow. I generate all `subsets` using `Algorithm::Combinatorics` and `sum` them with `List::Util`. This yields a two liner.

``````perl -MAlgorithm::Combinatorics=subsets -MList::Util=sum -E '
@a=@ARGV; \$m=sum(@a)/@a; \$s=subsets(\@a); \$s->next; while(\$c=\$s->next){next if @\$c==0;
last if sum(@\$c)==\$m*@\$c} say("@a -> ", @\$c?"True: @\$c":"False")
' 1 2 3 4 5 6 7 8
``````

Results:

``````1 2 3 4 5 6 7 8 -> True: 1 2 3 6 7 8
``````

Another example:

``````perl -MAlgorithm::Combinatorics=subsets -MList::Util=sum -E '
@a=@ARGV; \$m=sum(@a)/@a; \$s=subsets(\@a); \$s->next; while(\$c=\$s->next){next if @\$c==0;
last if sum(@\$c)==\$m*@\$c} say("@a -> ", @\$c?"True: @\$c":"False")
' 1 3
``````

Results:

``````1 3 -> False
``````

The full code is similar.

`````` 1  # Perl weekly challenge 211
2  # Task 2:  Split Same Average
3  #
5  use v5.36;
6  use Algorithm::Combinatorics qw(subsets);
7  use List::Util qw(sum);
8  die <<~"FIN" unless @ARGV;
9      Usage: \$0 N1 [N2...]
10      to test if the set N1 N2... may be split into two proper subsets
11      with the same average
12      FIN
13  my \$avg=sum(@ARGV)/@ARGV;
14  my \$subsets=subsets(\@ARGV);
15  \$subsets->next; # Throw away the complete set
16  my \$candidate;
17  while(\$candidate=\$subsets->next){
18      next if @\$candidate==0;  # Throw away the empty set
19      last if sum(@\$candidate)==\$avg*@\$candidate; # success
20  }
21  say("@ARGV -> ", \$candidate && @\$candidate? "True: @\$candidate" : "False")
``````

Example:

``````./ch-2.pl 1 2 3 4 5 6 7 8
./ch-2.pl 1 3
``````

Results:

``````1 2 3 4 5 6 7 8 -> True: 1 2 3 6 7 8
1 3 -> False
``````
Written on April 3, 2023