# Perl Weekly Challenge 257.

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

# Task 1: Smaller than Current

``````Submitted by: Mohammad Sajid Anwar
You are given a array of integers, @ints.

Write a script to find out how many integers are smaller than current
i.e. foreach ints[i], count ints[j] < ints[i] where i != j.

Example 1
Input: @ints = (5, 2, 1, 6)
Output: (2, 1, 0, 3)

For \$ints[0] = 5, there are two integers (2,1) smaller than 5.
For \$ints[1] = 2, there is one integer (1) smaller than 2.
For \$ints[2] = 1, there is none integer smaller than 1.
For \$ints[3] = 6, there are three integers (5,2,1) smaller than 6.
Example 2
Input: @ints = (1, 2, 0, 3)
Output: (1, 2, 0, 3)
Example 3
Input: @ints = (0, 1)
Output: (0, 1)
Example 4
Input: @ints = (9, 4, 9, 2)
Output: (2, 1, 2, 0)
``````

To solve this problem I sort the `uniq` numbers in the array, so that the number of smaller elements is their corresponding index. Then, I build a hash to store those numbers, and with that hash and the original numbers I build the result. This fits a oneliner.

Example 1:

``````perl -MList::Util=uniq -E '
@s=sort {\$a<=>\$b} uniq @x=@ARGV;\$c{\$s[\$_]}=\$_ for 0..@s-1; say "@x -> @c{@x}"
' 5 2 1 6
``````

Results:

``````5 2 1 6 -> 2 1 0 3
``````

Example 2:

``````perl -MList::Util=uniq -E '
@s=sort {\$a<=>\$b} uniq @x=@ARGV;\$c{\$s[\$_]}=\$_ for 0..@s-1; say "@x -> @c{@x}"
' 1 2 0 3
``````

Results:

``````1 2 0 3 -> 1 2 0 3
``````

Example 3:

``````perl -MList::Util=uniq -E '
@s=sort {\$a<=>\$b} uniq @x=@ARGV;\$c{\$s[\$_]}=\$_ for 0..@s-1; say "@x -> @c{@x}"
' 0 1
``````

Results:

``````0 1 -> 0 1
``````

Example 4:

``````perl -MList::Util=uniq -E '
@s=sort {\$a<=>\$b} uniq @x=@ARGV;\$c{\$s[\$_]}=\$_ for 0..@s-1; say "@x -> @c{@x}"
' 9 4 9 2
``````

Results:

``````9 4 9 2 -> 2 1 2 0
``````

The full code follows:

`````` 1  # Perl weekly challenge 257
2  # Task 1:  Smaller than Current
3  #
5  use v5.36;
6  use List::Util qw(uniq);
7  die <<~"FIN" unless @ARGV;
8      Usage: \$0 N1 [N2...]
9      to count how many numbers Nj are smaller than Ni
10      FIN
11  my @sorted=sort {\$a<=>\$b} uniq @ARGV;
12  my %count;
13  \$count{\$sorted[\$_]}=\$_ for 0..@sorted-1;
14  say "@ARGV -> @count{@ARGV}";
``````

Examples:

``````./ch-1.pl 5 2 1 6
./ch-1.pl 1 2 0 3
./ch-1.pl 0 1
./ch-1.pl 9 4 9 2
``````

Results:

``````5 2 1 6 -> 2 1 0 3
1 2 0 3 -> 1 2 0 3
0 1 -> 0 1
9 4 9 2 -> 2 1 2 0
``````

# Task 2: Reduced Row Echelon

``````Submitted by: Ali Moradi
Given a matrix M, check whether the matrix is in reduced row echelon form.

A matrix must have the following properties to be in reduced row echelon form:

1. If a row does not consist entirely of zeros, then the first
nonzero number in the row is a 1. We call this the leading 1.
2. If there are any rows that consist entirely of zeros, then
they are grouped together at the bottom of the matrix.
3. In any two successive rows that do not consist entirely of zeros,
the leading 1 in the lower row occurs farther to the right than
the leading 1 in the higher row.
4. Each column that contains a leading 1 has zeros everywhere else
in that column.
For example:

[
[1,0,0,1],
[0,1,0,2],
[0,0,1,3]
]
The above matrix is in reduced row echelon form since the first nonzero
number in each row is a 1, leading 1s in each successive row are farther
to the right, and above and below each leading 1 there are only zeros.

Example 1
Input: \$M = [
[1, 1, 0],
[0, 1, 0],
[0, 0, 0]
]
Output: 0
Example 2
Input: \$M = [
[0, 1,-2, 0, 1],
[0, 0, 0, 1, 3],
[0, 0, 0, 0, 0],
[0, 0, 0, 0, 0]
]
Output: 1
Example 3
Input: \$M = [
[1, 0, 0, 4],
[0, 1, 0, 7],
[0, 0, 1,-1]
]
Output: 1
Example 4
Input: \$M = [
[0, 1,-2, 0, 1],
[0, 0, 0, 0, 0],
[0, 0, 0, 1, 3],
[0, 0, 0, 0, 0]
]
Output: 0
Example 5
Input: \$M = [
[0, 1, 0],
[1, 0, 0],
[0, 0, 0]
]
Output: 0
Example 6
Input: \$M = [
[4, 0, 0, 0],
[0, 1, 0, 7],
[0, 0, 1,-1]
]
Output: 0
``````

To solve this problem I apply the definition. First I make an array of the indices of the first non-zero coefficient and check that it is increasing. Then I check that all zero rows, if any, are at the end. Then I check that the first non-null coefficient for each row is 1 and finally I check that all elements above it are zero (no need to check those below). The rows are input as space separated strings of numbers. The code fits a not too nice 3.5-liner. The full code explains it better.

Example 1:

``````perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {\$_} @\$_} @m;\$l=firstidx {\$_==-1}@i;\$l=@i if \$l==-1;
\$r=all{\$i[\$_]==-1}\$l+1..@i-1;\$r&&=all{\$i[\$_]<\$i[\$_+1]} 0..\$l-2;\$r&&=all{\$m[\$_][\$i[\$_]]==1} 0..\$l-1;
\$j=\$i[\$_],\$r&&=none{\$m[\$_][\$j]} (0..\$_-1) for 0..\$l-1;say join "\n", "[", map({join " ",
" [", @\$_, "]"}@m), "]", "-> ", \$r||0;
' "1 1 0" "0 1 0" "0 0 0"
``````

Results:

``````[
[ 1 1 0 ]
[ 0 1 0 ]
[ 0 0 0 ]
]
->
0
``````

Example 2:

``````perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {\$_} @\$_} @m;\$l=firstidx {\$_==-1}@i;\$l=@i if \$l==-1;
\$r=all{\$i[\$_]==-1}\$l+1..@i-1;\$r&&=all{\$i[\$_]<\$i[\$_+1]} 0..\$l-2;\$r&&=all{\$m[\$_][\$i[\$_]]==1} 0..\$l-1;
\$j=\$i[\$_],\$r&&=none{\$m[\$_][\$j]} (0..\$_-1) for 0..\$l-1;say join "\n", "[", map({join " ",
" [", @\$_, "]"}@m), "]", "-> ", \$r||0;
' "0 1 -2 0 1" "0 0 0 1 3" "0 0 0 0 0" "0 0 0 0 0"
``````

Results:

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

Example 3:

``````perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {\$_} @\$_} @m;\$l=firstidx {\$_==-1}@i;\$l=@i if \$l==-1;
\$r=all{\$i[\$_]==-1}\$l+1..@i-1;\$r&&=all{\$i[\$_]<\$i[\$_+1]} 0..\$l-2;\$r&&=all{\$m[\$_][\$i[\$_]]==1} 0..\$l-1;
\$j=\$i[\$_],\$r&&=none{\$m[\$_][\$j]} (0..\$_-1) for 0..\$l-1;say join "\n", "[", map({join " ",
" [", @\$_, "]"}@m), "]", "-> ", \$r||0;
' "1 0 0 4" "0 1 0 7" "0 0 1 -1"
``````

Results:

``````[
[ 1 0 0 4 ]
[ 0 1 0 7 ]
[ 0 0 1 -1 ]
]
->
1
``````

Example 4:

``````perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {\$_} @\$_} @m;\$l=firstidx {\$_==-1}@i;\$l=@i if \$l==-1;
\$r=all{\$i[\$_]==-1}\$l+1..@i-1;\$r&&=all{\$i[\$_]<\$i[\$_+1]} 0..\$l-2;\$r&&=all{\$m[\$_][\$i[\$_]]==1} 0..\$l-1;
\$j=\$i[\$_],\$r&&=none{\$m[\$_][\$j]} (0..\$_-1) for 0..\$l-1;say join "\n", "[", map({join " ",
" [", @\$_, "]"}@m), "]", "-> ", \$r||0;
' "0 1 -2 0 1" "0 0 0 0 0" "0 0 0 1 3" "0 0 0 0 0"
``````

Results:

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

Example 5:

``````perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {\$_} @\$_} @m;\$l=firstidx {\$_==-1}@i;\$l=@i if \$l==-1;
\$r=all{\$i[\$_]==-1}\$l+1..@i-1;\$r&&=all{\$i[\$_]<\$i[\$_+1]} 0..\$l-2;\$r&&=all{\$m[\$_][\$i[\$_]]==1} 0..\$l-1;
\$j=\$i[\$_],\$r&&=none{\$m[\$_][\$j]} (0..\$_-1) for 0..\$l-1;say join "\n", "[", map({join " ",
" [", @\$_, "]"}@m), "]", "-> ", \$r||0;
' "0 1 -2 0 1" "0 0 0 0 0" "0 0 0 1 3" "0 0 0 0 0"
' "0 1 0" "1 0 0" "0 0 0"
``````

Results:

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

Example 6:

``````perl -MList::AllUtils=firstidx,reduce,all,none -E '
push @m, map {[split " "]} @ARGV;@i=map {firstidx {\$_} @\$_} @m;\$l=firstidx {\$_==-1}@i;\$l=@i if \$l==-1;
\$r=all{\$i[\$_]==-1}\$l+1..@i-1;\$r&&=all{\$i[\$_]<\$i[\$_+1]} 0..\$l-2;\$r&&=all{\$m[\$_][\$i[\$_]]==1} 0..\$l-1;
\$j=\$i[\$_],\$r&&=none{\$m[\$_][\$j]} (0..\$_-1) for 0..\$l-1;say join "\n", "[", map({join " ",
" [", @\$_, "]"}@m), "]", "-> ", \$r||0;
' "4 0 0 0" "0 1 0 7" "0 0 1 -1"
``````

Results:

``````[
[ 4 0 0 0 ]
[ 0 1 0 7 ]
[ 0 0 1 -1 ]
]
->
0
``````

The full code follows:

`````` 1  # Perl weekly challenge 257
2  # Task 2:  Reduced Row Echelon
3  #
5  use v5.36;
6  use List::AllUtils qw(firstidx reduce all none);
7  die <<~"FIN" unless @ARGV;
8      Usage: \$0 R0 [R1...]
9      where Rn is a space separated row of the form
10      "Mn0 Mn1... Mnm"
11      and Mij are numbers, the entries of a matrix M,
12      to test if M is a reduced row echelon matrix
13      FIN
15  my @matrix;
16  push @matrix, map {[split " "]} @ARGV;
17  my @indices_first=map {firstidx {\$_} @\$_} @matrix; #indices of first non null element of each row
18  my \$first_empty=firstidx {\$_==-1}@indices_first;   # first row of zeroes
19  \$first_empty=@indices_first if \$first_empty==-1;   # none found
20  my \$result=all{\$indices_first[\$_]==-1}\$first_empty+1..@indices_first-1; # all zero rows at end
21  \$result &&= all{\$indices_first[\$_] < \$indices_first[\$_+1]} 0..\$first_empty-2; # to right of previous
22  \$result&&=all{\$matrix[\$_][\$indices_first[\$_]]==1} 0..\$first_empty-1;   #leading non zero are ones
23  for(0..\$first_empty-1){
24      my \$j=\$indices_first[\$_];
25      \$result &&= none{\$matrix[\$_][\$j]} (0..\$_-1);   # check zeroes above first non-zero
26  }
27  say join "\n", "[", map({join " ", " [", @\$_, "]"}@matrix), "]", "-> ", \$result||0, "\n";
``````

Examples:

``````./ch-2.pl "1 1 0" "0 1 0" "0 0 0"
./ch-2.pl "0 1 -2 0 1" "0 0 0 1 3" "0 0 0 0 0" "0 0 0 0 0"
./ch-2.pl "1 0 0 4" "0 1 0 7" "0 0 1 -1"
./ch-2.pl "0 1 -2 0 1" "0 0 0 0 0" "0 0 0 1 3" "0 0 0 0 0"
./ch-2.pl "0 1 0" "1 0 0" "0 0 0"
./ch-2.pl "4 0 0 0" "0 1 0 7" "0 0 1 -1"
``````

Results:

``````[
[ 1 1 0 ]
[ 0 1 0 ]
[ 0 0 0 ]
]
->
0

[
[ 0 1 -2 0 1 ]
[ 0 0 0 1 3 ]
[ 0 0 0 0 0 ]
[ 0 0 0 0 0 ]
]
->
1

[
[ 1 0 0 4 ]
[ 0 1 0 7 ]
[ 0 0 1 -1 ]
]
->
1

[
[ 0 1 -2 0 1 ]
[ 0 0 0 0 0 ]
[ 0 0 0 1 3 ]
[ 0 0 0 0 0 ]
]
->
0

[
[ 0 1 0 ]
[ 1 0 0 ]
[ 0 0 0 ]
]
->
0

[
[ 4 0 0 0 ]
[ 0 1 0 7 ]
[ 0 0 1 -1 ]
]
->
0
``````

## Alternative solution with PDL

An alternative solution may be obtained with the Perl Data Language PDL. I read the matrices from @ARGV, convert them to ndarrays, add guard columns at the beginning (zeroes) and at the end (a unit matrix) to simplify the tests, and run-length-encode the matrix to find for each row its repeated elements and their frequency. The frequencies are the positions of the first nonzero element. Thus, check that the frequencies are never decreasing (they should be strictly increasing, but a later check makes this unnecessary). Then check that the second value (the first non-zero) is a one for all rows. Finally check that in the column above the first non-zero elements there are just zeroes. This yields a 2.5liner.

``````perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){\$m0=pdl(0)->glue(0,\$m=pdl(\$_),identity(\$m->dim(1)));(\$f,\$v)=\$m0->rle;\$f=\$f((0));
\$r=all(\$f==\$f->qsort);\$r&&=all(\$v((1))==1);for(1..\$m->dim(1)-1){\$j=\$f((\$_));
\$r&&=all(\$m0->((\$j),0:\$_-1)==0)}say "\$m -> \$r"}
'    "[[1 1 0][0 1 0][0 0 0]]" "[[0 1 -2 0 1][0 0 0 1 3][0 0 0 0 0][0 0 0 0 0]]" \
"[[1 0 0 4][0 1 0 7][0 0 1 -1]]" "[[0 1 -2 0 1][0 0 0 0 0][0 0 0 1 3][0 0 0 0 0]]" \
"[[0 1 0][1 0 0][0 0 0]]" "[[4 0 0 0][0 1 0 7][0 0 1 -1]]"
``````

Results:

``````[
[1 1 0]
[0 1 0]
[0 0 0]
]
-> 0

[
[ 0  1 -2  0  1]
[ 0  0  0  1  3]
[ 0  0  0  0  0]
[ 0  0  0  0  0]
]
-> 1

[
[ 1  0  0  4]
[ 0  1  0  7]
[ 0  0  1 -1]
]
-> 1

[
[ 0  1 -2  0  1]
[ 0  0  0  0  0]
[ 0  0  0  1  3]
[ 0  0  0  0  0]
]
-> 0

[
[0 1 0]
[1 0 0]
[0 0 0]
]
-> 0

[
[ 4  0  0  0]
[ 0  1  0  7]
[ 0  0  1 -1]
]
-> 0
``````

The corresponding full code is

`````` 1  # Perl weekly challenge 257
2  # Task 2:  Reduced Row Echelon. PDL solution
3  #
5  use v5.36;
6  use PDL;
7  use PDL::NiceSlice;
8  die <<~"FIN" unless @ARGV;
9      Usage: \$0 M1 [M2...]
10      to check if the matrices Mn is a reduced row echelon matrix.
11      The matrices are strings of the form
12      "[[M11 M12..][M21 M22...]...]" where each Mij is a number,
13      the element in the i-th row and j-th column.
14      FIN
15  for(@ARGV){
16      my \$matrix=pdl(\$_);
17      my \$extended_matrix=pdl(0)->glue(0, \$matrix, identity(\$matrix->dim(1)));
18      my (\$freq,\$vals)=\$extended_matrix->rle; # run length encode
19      \$freq=\$freq((0));                       # number of leading zeroes
20      my \$result=all(\$freq==\$freq->qsort);    # check non-decreasing
21      \$result &&= all(\$vals((1))==1);         # leading non-zero is 1
22      for(1..\$matrix->dim(1)-1){
23          my \$j=\$freq((\$_));                  # position of first non zero of \$_ row
24          \$result &&= all(\$extended_matrix((\$j),0:\$_-1)==0)
25      }
26      say "\$matrix -> \$result"
27  }
``````

Examples:

``````./ch-2a.pl "[[1 1 0][0 1 0][0 0 0]]" "[[0 1 -2 0 1][0 0 0 1 3][0 0 0 0 0][0 0 0 0 0]]" \
"[[1 0 0 4][0 1 0 7][0 0 1 -1]]" "[[0 1 -2 0 1][0 0 0 0 0][0 0 0 1 3][0 0 0 0 0]]" \
"[[0 1 0][1 0 0][0 0 0]]" "[[4 0 0 0][0 1 0 7][0 0 1 -1]]"
``````

Results:

``````[
[1 1 0]
[0 1 0]
[0 0 0]
]
-> 0

[
[ 0  1 -2  0  1]
[ 0  0  0  1  3]
[ 0  0  0  0  0]
[ 0  0  0  0  0]
]
-> 1

[
[ 1  0  0  4]
[ 0  1  0  7]
[ 0  0  1 -1]
]
-> 1

[
[ 0  1 -2  0  1]
[ 0  0  0  0  0]
[ 0  0  0  1  3]
[ 0  0  0  0  0]
]
-> 0

[
[0 1 0]
[1 0 0]
[0 0 0]
]
-> 0

[
[ 4  0  0  0]
[ 0  1  0  7]
[ 0  0  1 -1]
]
-> 0
``````

## Yet another alternative with PDL

I guess a more PDL-idiomatic, more elegant solution, without perl loops, may be found using the index routines using the `index` families or routines. Using `rle` as above and `index1d`, I may build a submatrix with the columns that contain the first non-zero value of each row of the matrix. If I extend the matrix as above, prepending a column of zeroes and appending an identity matrix, the result should be the unit matrix. The result is a slightly more compact 2+liner

Examples:

``````perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){\$n=pdl(0)->glue(0,\$m=pdl(\$_),identity(\$m->dim(1)));(\$f,\$v)=\$n->rle;
\$f=\$f((0));\$r=all(\$f==\$f->qsort)&&all(\$n->index1d(\$f)==identity(\$f->dim(0)));
say "\$m -> \$r"}
'    "[[1 1 0][0 1 0][0 0 0]]" "[[0 1 -2 0 1][0 0 0 1 3][0 0 0 0 0][0 0 0 0 0]]" \
"[[1 0 0 4][0 1 0 7][0 0 1 -1]]" "[[0 1 -2 0 1][0 0 0 0 0][0 0 0 1 3][0 0 0 0 0]]" \
"[[0 1 0][1 0 0][0 0 0]]" "[[4 0 0 0][0 1 0 7][0 0 1 -1]]"
``````

Results:

``````[
[1 1 0]
[0 1 0]
[0 0 0]
]
-> 0

[
[ 0  1 -2  0  1]
[ 0  0  0  1  3]
[ 0  0  0  0  0]
[ 0  0  0  0  0]
]
-> 1

[
[ 1  0  0  4]
[ 0  1  0  7]
[ 0  0  1 -1]
]
-> 1

[
[ 0  1 -2  0  1]
[ 0  0  0  0  0]
[ 0  0  0  1  3]
[ 0  0  0  0  0]
]
-> 0

[
[0 1 0]
[1 0 0]
[0 0 0]
]
-> 0

[
[ 4  0  0  0]
[ 0  1  0  7]
[ 0  0  1 -1]
]
-> 0
``````

The full code is

`````` 1  # Perl weekly challenge 257
2  # Task 2:  Reduced Row Echelon. More compact, eliminate Perl loop in
3  #                               PDL solution
4  #
6  use v5.36;
7  use PDL;
8  use PDL::NiceSlice;
9  die <<~"FIN" unless @ARGV;
10      Usage: \$0 M1 [M2...]
11      to check if the matrices Mn is a reduced row echelon matrix.
12      The matrices are strings of the form
13      "[[M11 M12..][M21 M22...]...]" where each Mij is a number,
14      the element in the i-th row and j-th column.
15      FIN
16  for(@ARGV){
17      my \$matrix=pdl(\$_);
18      my \$extended_matrix=pdl(0)->glue(0, \$matrix, identity(\$matrix->dim(1)));
19      my (\$freq,\$vals)=\$extended_matrix->rle; # run length encode
20      \$freq=\$freq((0));                       # number of leading zeroes
21      my \$result=all(\$freq==\$freq->qsort)     # check non-decreasing
22                                              # check leading 1 and 0
23                                              # elsewhere in column
24          && all(\$extended_matrix->index1d(\$freq)==identity(\$freq->dim(0)));
25      say "\$matrix -> \$result"
26  }
``````

Examples:

``````./ch-2b.pl "[[1 1 0][0 1 0][0 0 0]]" "[[0 1 -2 0 1][0 0 0 1 3][0 0 0 0 0][0 0 0 0 0]]" \
"[[1 0 0 4][0 1 0 7][0 0 1 -1]]" "[[0 1 -2 0 1][0 0 0 0 0][0 0 0 1 3][0 0 0 0 0]]" \
"[[0 1 0][1 0 0][0 0 0]]" "[[4 0 0 0][0 1 0 7][0 0 1 -1]]"
``````

Results:

``````[
[1 1 0]
[0 1 0]
[0 0 0]
]
-> 0

[
[ 0  1 -2  0  1]
[ 0  0  0  1  3]
[ 0  0  0  0  0]
[ 0  0  0  0  0]
]
-> 1

[
[ 1  0  0  4]
[ 0  1  0  7]
[ 0  0  1 -1]
]
-> 1

[
[ 0  1 -2  0  1]
[ 0  0  0  0  0]
[ 0  0  0  1  3]
[ 0  0  0  0  0]
]
-> 0

[
[0 1 0]
[1 0 0]
[0 0 0]
]
-> 0

[
[ 4  0  0  0]
[ 0  1  0  7]
[ 0  0  1 -1]
]
-> 0
``````
Written on February 20, 2024