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 #
4 # See https://wlmb.github.io/2024/02/20/PWC257/#task-1-smaller-than-current
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.
For more information check out this wikipedia article.
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 #
4 # See https://wlmb.github.io/2024/02/20/PWC257/#task-2-reduced-row-echelon
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
14 # Read matrix
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 #
4 # See https://wlmb.github.io/2024/02/20/PWC257/#task-2-reduced-row-echelon
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 #
5 # See https://wlmb.github.io/2024/02/20/PWC257/#task-2-reduced-row-echelon
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