Perl Weekly Challenge 337.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 337.
Task 1: Smaller Than Current
Submitted by: Mohammad Sajid Anwar
You are given an array of numbers, @num1.
Write a script to return an array, @num2, where $num2[i] is the count of all numbers
less than or equal to $num1[i].
Example 1
Input: @num1 = (6, 5, 4, 8)
Output: (2, 1, 0, 3)
index 0: numbers <= 6 are 5, 4 => 2
index 1: numbers <= 5 are 4 => 1
index 2: numbers <= 4, none => 0
index 3: numbers <= 8 are 6, 5, 4 => 3
Example 2
Input: @num1 = (7, 7, 7, 7)
Output: (0, 0, 0, 0)
Example 3
Input: @num1 = (5, 4, 3, 2, 1)
Output: (4, 3, 2, 1, 0)
Example 4
Input: @num1 = (-1, 0, 3, -2, 1)
Output: (1, 2, 4, 0, 3)
Example 5
Input: @num1 = (0, 1, 1, 2, 0)
Output: (0, 2, 2, 4, 0)
The examples are somewhat confusing. In example 2 with 4 sevens, each
of the four is equal to itself and to all others. Thus, the output
should have been (4,4,4,4) if we compare numbers to themselves, and
(3,3,3,3) if we only compare them to others. Thus, I will assume
that the problem is to count numbers that are strictly less, not less
or equal.
I will use the Perl Data Language PDL as it allows building a matrix in
which every number is compared to every other, and it can simply be
summed row-wise or columnwise. This yields a half-liner.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){$n=pdl($_); say "$_ -> ", ($n(*)>$n)->sumover}
' "[6 5 4 8]" "[7 7 7 7]" "[5 4 3 2 1]" "[-1 0 3 -2 1]" "[0 1 1 2 0]"
Results:
[6 5 4 8] -> [2 1 0 3]
[7 7 7 7] -> [0 0 0 0]
[5 4 3 2 1] -> [4 3 2 1 0]
[-1 0 3 -2 1] -> [1 2 4 0 3]
[0 1 1 2 0] -> [0 2 2 4 0]
The full code is:
1 # Perl weekly challenge 337
2 # Task 1: Smaller Than Current
3 #
4 # See https://wlmb.github.io/2025/08/31/PWC337/#task-1-smaller-than-current
5 use v5.36;
6 use PDL;
7 use PDL::NiceSlice;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 A1 A2...
10 to find for each number Ni in the array Ak how many numbers Nj
11 are less than Ni.
12 The arrays are input as strings of the form
13 "[N0 N1 ...]" where the Ni's are numbers
14 FIN
15 for(@ARGV){
16 my $array=pdl($_);
17 say "$_ -> ",($array(*1)>$array)->sumover; # compare array as cols vs. as rows
18 }
Example:
./ch-1.pl "[6 5 4 8]" "[7 7 7 7]" "[5 4 3 2 1]" "[-1 0 3 -2 1]" "[0 1 1 2 0]"
Results:
[6 5 4 8] -> [2 1 0 3]
[7 7 7 7] -> [0 0 0 0]
[5 4 3 2 1] -> [4 3 2 1 0]
[-1 0 3 -2 1] -> [1 2 4 0 3]
[0 1 1 2 0] -> [0 2 2 4 0]
Task 2: Odd Matrix
Submitted by: Mohammad Sajid Anwar
You are given row and col, also a list of positions in the matrix.
Write a script to perform action on each location (0-indexed)
as provided in the list and find out the total odd valued cells.
For each location (r, c), do both of the following:
a. Increment by 1 all the cells on row r.
b. Increment by 1 all the cells on column c.
Example 1
Input: $row = 2, $col = 3, @locations = ([0,1],[1,1])
Output: 6
Initial:
[ 0 0 0 ]
[ 0 0 0 ]
Apply [0,1]:
Increment row 0:
Before After
[ 0 0 0 ] [ 1 1 1 ]
[ 0 0 0 ] [ 0 0 0 ]
Increment col 1:
Before After
[ 1 1 1 ] [ 1 2 1 ]
[ 0 0 0 ] [ 0 1 0 ]
Apply [1,1]:
Increment row 1:
Before After
[ 1 2 1 ] [ 1 2 1 ]
[ 0 1 0 ] [ 1 2 1 ]
Increment col 1:
Before After
[ 1 2 1 ] [ 1 3 1 ]
[ 1 2 1 ] [ 1 3 1 ]
Final:
[ 1 3 1 ]
[ 1 3 1 ]
Example 2
Input: $row = 2, $col = 2, @locations = ([1,1],[0,0])
Output: 2
Initial:
[ 0 0 ]
[ 0 0 ]
Apply [1,1]:
Increment row 1:
Before After
[ 0 0 ] [ 0 0 ]
[ 0 0 ] [ 1 1 ]
Increment col 1:
Before After
[ 0 0 ] [ 0 1 ]
[ 1 1 ] [ 1 2 ]
Apply [0,0]:
Increment row 0:
Before After
[ 0 1 ] [ 1 2 ]
[ 1 2 ] [ 1 2 ]
Increment col 0:
Before After
[ 1 2 ] [ 1 2 ]
[ 1 2 ] [ 2 3 ]
(Wrong)
Final:
[ 1 2 ]
[ 2 3 ]
Example 3
Input: $row = 3, $col = 3, @locations = ([0,0],[1,2],[2,1)
Output: 0
Initial:
[ 0 0 0 ]
[ 0 0 0 ]
[ 0 0 0 ]
Apply [0,0]:
Increment row 0:
Before After
[ 0 0 0 ] [ 1 1 1 ]
[ 0 0 0 ] [ 0 0 0 ]
[ 0 0 0 ] [ 0 0 0 ]
Increment col 0:
Before After
[ 1 1 1 ] [ 2 1 1 ]
[ 0 0 0 ] [ 1 0 0 ]
[ 0 0 0 ] [ 1 0 0 ]
Apply [1,2]:
Increment row 1:
Before After
[ 2 1 1 ] [ 2 1 1 ]
[ 1 0 0 ] [ 2 1 1 ]
[ 1 0 0 ] [ 1 0 0 ]
Increment col 2:
Before After
[ 2 1 1 ] [ 2 1 2 ]
[ 2 1 1 ] [ 2 1 2 ]
[ 1 0 0 ] [ 1 0 1 ]
Apply [2,1]:
Increment row 2:
Before After
[ 2 1 2 ] [ 2 1 2 ]
[ 2 1 2 ] [ 2 1 2 ]
[ 1 0 1 ] [ 2 1 2 ]
Increment col 1:
Before After
[ 2 1 2 ] [ 2 2 2 ]
[ 2 1 2 ] [ 2 2 2 ]
[ 2 1 2 ] [ 2 2 2 ]
Final:
[ 2 2 2 ]
[ 2 2 2 ]
[ 2 2 2 ]
Example 4
Input: $row = 1, $col = 5, @locations = ([0,2],[0,4])
Output: 2
Initial:
[ 0 0 0 0 0 ]
Apply [0,2]:
Increment row 0:
Before After
[ 0 0 0 0 0 ] [ 1 1 1 1 1 ]
Increment col 2:
Before After
[ 1 1 1 1 1 ] [ 1 1 2 1 1 ]
Apply [0,4]:
Increment row 0:
Before After
[ 1 1 2 1 1 ] [ 2 2 3 2 2 ]
Increment col 4:
Before After
[ 2 2 3 2 2 ] [ 2 2 3 2 3 ]
Final:
[ 2 2 3 2 3 ]
Example 5
Input: $row = 4, $col = 2, @locations = ([1,0],[3,1],[2,0],[0,1])
Output: 8
Initial:
[ 0 0 ]
[ 0 0 ]
[ 0 0 ]
[ 0 0 ]
Apply [1,0]:
Increment row 1:
Before After
[ 0 0 ] [ 0 0 ]
[ 0 0 ] [ 1 1 ]
[ 0 0 ] [ 0 0 ]
[ 0 0 ] [ 0 0 ]
Increment col 0:
Before After
[ 0 0 ] [ 1 0 ]
[ 1 1 ] [ 2 1 ]
[ 0 0 ] [ 1 0 ]
[ 0 0 ] [ 1 0 ]
Apply [3,1]:
Increment row 3:
Before After
[ 1 0 ] [ 1 0 ]
[ 2 1 ] [ 2 1 ]
[ 1 0 ] [ 1 0 ]
[ 1 0 ] [ 2 1 ]
Increment col 1:
Before After
[ 1 0 ] [ 1 1 ]
[ 2 1 ] [ 2 2 ]
[ 1 0 ] [ 1 1 ]
[ 2 1 ] [ 2 2 ]
Apply [2,0]:
Increment row 2:
Before After
[ 1 1 ] [ 1 1 ]
[ 2 2 ] [ 2 2 ]
[ 1 1 ] [ 2 2 ]
[ 2 2 ] [ 2 2 ]
Increment col 0:
Before After
[ 1 1 ] [ 2 1 ]
[ 2 2 ] [ 3 2 ]
[ 2 2 ] [ 3 2 ]
[ 2 2 ] [ 3 2 ]
Apply [0,1]:
Increment row 0:
Before After
[ 2 1 ] [ 3 2 ]
[ 3 2 ] [ 3 2 ]
[ 3 2 ] [ 3 2 ]
[ 3 2 ] [ 3 2 ]
Increment col 1:
Before After
[ 3 2 ] [ 3 3 ]
[ 3 2 ] [ 3 3 ]
[ 3 2 ] [ 3 3 ]
[ 3 2 ] [ 3 3 ]
Final:
[ 3 3 ]
[ 3 3 ]
[ 3 3 ]
[ 3 3 ]
A straightforward solution is to simply follow the instructions using
PDL, as it allows incrementing row and column slices as single
operations. This yields a two-liner.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
for my($r,$c,$p)(@ARGV){$m=zeroes($c,$r);$l=pdl($p);$m(($_))++ for $l->slice("(1)")->dog;
$m(,($_))++ for $l->slice("(0)")->dog;say "R=$r, C=$c, L=$p -> ", ($m%2)->sum}
' 2 3 "[[0 1][1 1]]" 2 2 "[[1 1][0 0]]" 3 3 "[[0 0][1 2][2 1]]" \
1 5 "[[0 2][0 4]]" 4 2 "[[1 0][3 1][2 0][0 1]]"
Results:
R=2, C=3, L=[[0 1][1 1]] -> 6
R=2, C=2, L=[[1 1][0 0]] -> 0
R=3, C=3, L=[[0 0][1 2][2 1]] -> 0
R=1, C=5, L=[[0 2][0 4]] -> 2
R=4, C=2, L=[[1 0][3 1][2 0][0 1]] -> 8
Notice that example 2 in the problem statement is wrong. In the step where column 0 is to be incremented the example actually increments row 1.
The full code is:
1 # Perl weekly challenge 337
2 # Task 2: Odd Matrix
3 #
4 # See https://wlmb.github.io/2025/08/31/PWC337/#task-2-odd-matrix
5 use v5.36;
6 use PDL;
7 use PDL::NiceSlice;
8 use feature qw(try);
9 die <<~"FIN" unless @ARGV and @ARGV%3==0;
10 Usage: $0 R1 C1 P1 R2 C2 P2...
11 to find how many odd numbers are in a matrix of Ri rows and Ci columns
12 after the rows and columns corresponding to the points Pi are incremented,
13 where Pi is input as a string with the format "[[r1 c1][r2 c2]...]"
14 FIN
15 for my($rows,$cols,$points)(@ARGV){
16 try {
17 my $matrix=zeroes($cols,$rows);
18 my $locations=pdl($points);
19 $matrix(($_))++ for $locations->slice("(1)")->dog; # increment columns
20 $matrix(,($_))++ for $locations->slice("(0)")->dog; # increment rows
21 say "Rows=$rows, Cols=$cols, Locations=$points -> ", ($matrix%2)->sum
22 } catch($e) { say $e;}
23 }
24
Examples:
./ch-2.pl 2 3 "[[0 1][1 1]]" 2 2 "[[1 1][0 0]]" 3 3 "[[0 0][1 2][2 1]]" \
1 5 "[[0 2][0 4]]" 4 2 "[[1 0][3 1][2 0][0 1]]"
Results:
Rows=2, Cols=3, Locations=[[0 1][1 1]] -> 6
Rows=2, Cols=2, Locations=[[1 1][0 0]] -> 0
Rows=3, Cols=3, Locations=[[0 0][1 2][2 1]] -> 0
Rows=1, Cols=5, Locations=[[0 2][0 4]] -> 2
Rows=4, Cols=2, Locations=[[1 0][3 1][2 0][0 1]] -> 8
/;
Written on August 31, 2025