Perl Weekly Challenge 354.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 354.
Task 1: Min Abs Diff
Submitted by: Mohammad Sajid Anwar
You are given an array of distinct integers.
Write a script to find all pairs of elements with the minimum
absolute difference.
Rules (a,b):
1: a, b are from the given array.
2: a < b
3: b - a = min abs diff any two elements in the given array
Example 1
Input: @ints= (4, 2, 1, 3)
Output: [1, 2], [2, 3], [3, 4]
Example 2
Input: @ints = (10, 100, 20, 30)
Output: [10, 20], [20, 30]
Example 3
Input: @ints = (-5, -2, 0, 3)
Output: [-2, 0]
Example 4
Input: @ints = (8, 1, 15, 3)
Output: [1, 3]
Example 5
Input: @ints = (12, 5, 9, 1, 15)
Output: [9, 12], [12, 15]
If I first sort the given list, I just have to take differences between consecutive elements, as nonconsecutive elements are further apart. After sorting, I build an array of consecutive differences, sort the initical pair indices according to these differences, keep those that have the minimum differences and output the pairs. The result fits a 2.5-liner.
Examples:
perl -MList::UtilsBy=nsort_by -E '
for(@ARGV){@x=sort{$a<=>$b}split" ";@p=map{$x[$_+1]-$x[$_]}0..@x-2;@r=
nsort_by{$p[$_]}0..@x-2;$m=$p[$r[0]];say"$_ -> ",map{"[$x[$_],$x[$_+1]]"}
grep {$p[$_]==$m}@r;}
' -- "4 2 1 3" "10 100 20 30" "-5 -2 0 3" "8 1 15 3" "12 5 9 1 15"
Results:
4 2 1 3 -> [1,2][2,3][3,4]
10 100 20 30 -> [10,20][20,30]
-5 -2 0 3 -> [-2,0]
8 1 15 3 -> [1,3]
12 5 9 1 15 -> [9,12][12,15]
A slightly shorter 2-liner can be obtained using the Perl Data
Language PDL to manipulate the arrays.
perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){$x=pdl($_)->uniq->qsort;$p=$x(1:)-$x(:-2);$i=which($p==$p->min);
$r=pdl($x->index($i), $x->index($i+1))->mv(0,1);say "$_ -> $r";}
' "[4 2 1 3]" "[10 100 20 30]" "[-5 -2 0 3]" "[8 1 15 3]" "[12 5 9 1 15]"
Results:
[4 2 1 3] ->
[
[1 2]
[2 3]
[3 4]
]
[10 100 20 30] ->
[
[10 20]
[20 30]
]
[-5 -2 0 3] ->
[
[-2 0]
]
[8 1 15 3] ->
[
[1 3]
]
[12 5 9 1 15] ->
[
[ 9 12]
[12 15]
]
The full code is:
1 # Perl weekly challenge 354
2 # Task 1: Min Abs Diff
3 #
4 # See https://wlmb.github.io/2025/12/28/PWC354/#task-1-min-abs-diff
5 use v5.36;
6 use feature qw(try);
7 use PDL;
8 use PDL::NiceSlice;
9 die <<~"FIN" unless @ARGV;
10 Usage: $0 L0 L1...
11 to find the pairs of numbers from each list Ln whose
12 difference has a minimum absolute value.
13 Each Ln is a string of the form "[N0 N1...]", suitable
14 as input to pdl.
15 FIN
16 for(@ARGV){
17 try {
18 my $sorted=pdl($_)->uniq->qsort;
19 my $diff=$sorted(1:)-$sorted(:-2); # differences of consecutive pairs
20 my $indices=which($diff==$diff->min); # choose first indices of pairs
21 my $result=pdl( # consecutive pairs
22 $sorted->index($indices), $sorted->index($indices+1)
23 )->mv(0,1); # transpose
24 say "$_ -> $result";
25 }
26 catch($e){ warn $e; }
27 }
Examples:
./ch-1.pl "[4 2 1 3]" "[10 100 20 30]" "[-5 -2 0 3]" \
"[8 1 15 3]" "[12 5 9 1 15]"
Results:
[4 2 1 3] ->
[
[1 2]
[2 3]
[3 4]
]
[10 100 20 30] ->
[
[10 20]
[20 30]
]
[-5 -2 0 3] ->
[
[-2 0]
]
[8 1 15 3] ->
[
[1 3]
]
[12 5 9 1 15] ->
[
[ 9 12]
[12 15]
]
Task 2: Shift Grid
Submitted by: Mohammad Sajid Anwar
You are given m x n matrix and an integer, $k > 0.
Write a script to shift the given matrix $k times.
Each shift follow the rules:
Rule 1:
Element at grid[i][j] moves to grid[i][j + 1]
This means every element moves one step to the right within its row.
Rule 2:
Element at grid[i][n - 1] moves to grid[i + 1][0]
This handles the last column: elements in the last column of row i wrap to the first column of the next row (i+1).
Rule 3:
Element at grid[m - 1][n - 1] moves to grid[0][0]
This is the bottom-right corner: it wraps to the top-left corner.
Example 1
Input: @matrix = ([1, 2, 3],
[4, 5, 6],
[7, 8, 9],)
$k = 1
Output: ([9, 1, 2],
[3, 4, 5],
[6, 7, 8],)
Rule 1: grid[i][j] -> grid[i][j+1] for j < n-1.
We take elements from the original grid at (i, j) and put them into new_grid[i][j+1].
From original:
(0,0): 1 -> new_grid[0][1] = 1
(0,1): 2 -> new_grid[0][2] = 2
(1,0): 4 -> new_grid[1][1] = 4
(1,1): 5 -> new_grid[1][2] = 5
(2,0): 7 -> new_grid[2][1] = 7
(2,1): 8 -> new_grid[2][2] = 8
New grid looks after Rule 1:
([?, 1, 2],
[?, 4, 5],
[?, 7, 8],)
Rule 2: grid[i][n-1] -> grid[i+1][0] for i < m-1.
Elements from original last column (except last row) go to next row's first column.
From original:
(0,2): 3 -> new_grid[1][0] = 3
(1,2): 6 -> new_grid[2][0] = 6
Now new grid after Rules 1 + 2:
([?, 1, 2],
[3, 4, 5],
[6, 7, 8],)
Rule 3: grid[m-1][n-1] -> grid[0][0].
Original (2,2): 9 -> new_grid[0][0] = 9.
Now new_grid is complete:
([9, 1, 2],
[3, 4, 5],
[6, 7, 8],)
Example 2
Input: @matrix = ([10, 20],
[30, 40],)
$k = 1
Output: ([40, 10],
[20, 30],)
Rule 1 (move right in same row if not last column):
(0,0): 10 -> new[0][1] = 10
(1,0): 30 -> new[1][1] = 30
After Rule 1:
([?, 10],
[?, 30],)
Rule 2 (last col -> next row’s first col, except last row):
(0,1): 20 -> new[1][0] = 20
After Rule 2:
([?, 10],
[20, 30],)
Rule 3 (bottom-right to top-left):
(1,1): 40 -> new[0][0] = 40
After Rule 3:
([40, 10],
[20, 30],)
Example 3
Input: @matrix = ([1, 2],
[3, 4],
[5, 6],)
$k = 1
Output: ([6, 1],
[2, 3],
[4, 5],)
Rule 1:
(0,0): 1 -> new[0][1] = 1
(1,0): 3 -> new[1][1] = 3
(2,0): 5 -> new[2][1] = 5
After Rule 1:
( [?, 1],
[?, 3],
[?, 5],)
Rule 2:
(0,1): 2 -> new[1][0] = 2
(1,1): 4 -> new[2][0] = 4
After Rule 2:
([?, 1],
[2, 3],
[4, 5],)
Rule 3:
(2,1): 6 -> new[0][0] = 6
After Rule 3:
([6, 1],
[2, 3],
[4, 5],)
Example 4
Input: @matrix = ([1, 2, 3],
[4, 5, 6],)
$k = 5
Output: ([2, 3, 4],
[5, 6, 1],)
Shift 1
Rule 1
1 -> (0,1)
2 -> (0,2)
4 -> (1,1)
5 -> (1,2)
Rule 2
3 -> (1,0) (last column of row 0)
Rule 3
6 -> (0,0) (bottom-right corner)
Result
[6, 1, 2]
[3, 4, 5]
----------------------------
Shift 2
Starting from the previous matrix:
[6, 1, 2]
[3, 4, 5]
Rule 1
6 -> (0,1)
1 -> (0,2)
3 -> (1,1)
4 -> (1,2)
Rule 2
2 -> (1,0)
Rule 3
5 -> (0,0)
Result
[5, 6, 1]
[2, 3, 4]
----------------------------
Shift 3
[5, 6, 1]
[2, 3, 4]
Rule 2: 1 -> (1,0)
Rule 3: 4 -> (0,0)
Others follow Rule 1
Result
[4, 5, 6]
[1, 2, 3]
----------------------------
Shift 4
[4, 5, 6]
[1, 2, 3]
Result
[3, 4, 5]
[6, 1, 2]
----------------------------
Shift 5
[3, 4, 5]
[6, 1, 2]
Result
[2, 3, 4]
[5, 6, 1]
Final Output (after k = 5 shifts)
([2, 3, 4],
[5, 6, 1])
Example 5
Input: @matrix = ([1, 2, 3, 4])
$k = 1
Output: ([4, 1, 2, 3])
Rule 1:
(0,0): 1 -> new[0][1] = 1
(0,1): 2 -> new[0][2] = 2
(0,2): 3 -> new[0][3] = 3
After Rule 1:
([?, 1, 2, 3])
Rule 2:
(0,3): 4 -> new[1][0] ??
Wait — but i=0, n-1=3, next row i+1=1 doesn’t exist (m=1).
So this is actually a special case where Rule 2 should not apply.
because m=1, so (0,3) goes by Rule 3 actually.
The rules say:
grid[i][j] -> grid[i][j+1] for j < n-1.
grid[i][n-1] -> grid[i+1][0] for i < m-1.
grid[m-1][n-1] -> grid[0][0].
For m = 1:
Elements (0,0),(0,1),(0,2) follow Rule 1 -> (0,1),(0,2),(0,3).
Element (0,3) is (m-1, n-1), so follows Rule 3 -> (0,0).
Actually, that means after Rule 1:
We put 1,2,3 in positions 1,2,3, leaving position 0 empty.
Then Rule 3 puts 4 in position 0.
So final directly:
[4, 1, 2, 3]
This problem is trivial using the Perl Data Language PDL as it has
a method rotate precisely to circularly shift an array along its first
dimensions, and has a slicing method to choose and operate on an
individual column. These routines manage the marginal cases adequately. This
yields a 1.5-liner.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
for my($n,$k)(@ARGV){$r=($m=pdl($n))->copy;for(1..$k){$r.=$r->rotate(1);
$r((0)).=$r((0))->rotate(1)}say"$m $k -> $r"}
' "[[1 2 3][4 5 6][7 8 9]]" 1 "[[10 20][30 40]]" 1 \
"[[1 2][3 4][5 6]]" 1 "[[1 2 3][4 5 6]]" 5 \
"[[1 2 3 4]]" 1
Results:
[
[1 2 3]
[4 5 6]
[7 8 9]
]
, 1 ->
[
[9 1 2]
[3 4 5]
[6 7 8]
]
[
[10 20]
[30 40]
]
, 1 ->
[
[40 10]
[20 30]
]
[
[1 2]
[3 4]
[5 6]
]
, 1 ->
[
[6 1]
[2 3]
[4 5]
]
[
[1 2 3]
[4 5 6]
]
, 5 ->
[
[2 3 4]
[5 6 1]
]
[
[1 2 3 4]
]
, 1 ->
[
[4 1 2 3]
]
The full code is:
1 # Perl weekly challenge 354
2 # Task 2: Shift Grid
3 #
4 # See https://wlmb.github.io/2025/12/28/PWC354/#task-2-shift-grid
5 use v5.36;
6 use feature qw(try);
7 use PDL;
8 use PDL::NiceSlice;
9 die <<~"FIN" unless @ARGV && @ARGV%2==0;
10 Usage: $0 M0 k0 M1 k1
11 to shift the matrix Mn kn times.
12 Each shift consists of rotating the matrix one position
13 towards the right and rotating the first column downwards.
14 Each Mn is a string of the form "[[m00 m01...][m10 m11...]...]"
15 that may be intepreted by pdl.
16 FIN
17 for my($input,$k)(@ARGV){
18 try {
19 my $result=(my $matrix=pdl($input))->copy;
20 for(1..$k){
21 $result.=$result->rotate(1); # shift right
22 $result((0)).=$result((0))->rotate(1); # shift first column down
23 }
24 say"$matrix $k -> $result"
25 }
26 catch($e) { warn $e }
27 }
Examples:
./ch-2.pl \
"[[1 2 3][4 5 6][7 8 9]]" 1 \
"[[10 20][30 40]]" 1 \
"[[1 2][3 4][5 6]]" 1 \
"[[1 2 3][4 5 6]]" 5 \
"[[1 2 3 4]]" 1
/;
Written on December 28, 2025