Perl Weekly Challenge 248.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 248.
Task 1: Shortest Distance
Submitted by: Mohammad S Anwar
You are given a string and a character in the given string.
Write a script to return an array of integers of size same as length of the
given string such that:
distance[i] is the distance from index i to the closest occurence of
the given character in the given string.
The distance between two indices i and j is abs(i - j).
Example 1
Input: $str = "loveleetcode", $char = "e"
Output: (3,2,1,0,1,0,0,1,2,2,1,0)
The character 'e' appears at indices 3, 5, 6, and 11 (0-indexed).
The closest occurrence of 'e' for index 0 is at index 3, so the distance
is abs(0 - 3) = 3.
The closest occurrence of 'e' for index 1 is at index 3, so the distance
is abs(1 - 3) = 2.
For index 4, there is a tie between the 'e' at index 3 and the 'e' at
index 5, but the distance is still the same: abs(4 - 3) == abs(4 - 5) = 1.
The closest occurrence of 'e' for index 8 is at index 6, so the distance is
abs(8 - 6) = 2.
Example 2
Input: $str = "aaab", $char = "b"
Output: (3,2,1,0)
This can be solved by making an array of the indices corresponding to the letter and treat it as the row of a matrix. I take all the indices corresponding to the string and treat them as a column of another matrices. I repeat the rows and the columns to make compatible matrices which I can subtract, take the absolute values, and finally, I take the minimum values for each row. This may be coded into a simple two-liner using PDL to manipulate the matrices.
Example 1:
perl -MPDL -E '
@a=@ARGV; @x=split "", $a[0]; $i=pdl(grep {$x[$_] eq $a[1]} 0..@x-1);
$j=sequence(0+@x); say "@a; $a[1] -> ", ($i->dummy(1)-$j->dummy(0))->abs->minover;
' loveleetcode e
Results:
loveleetcode e; e -> [3 2 1 0 1 0 0 1 2 2 1 0]
Example 2:
perl -MPDL -E '
@a=@ARGV; @x=split "", $a[0]; $i=pdl(grep {$x[$_] eq $a[1]} 0..@x-1);
$j=sequence(0+@x); say "@a; $a[1] -> ", ($i->dummy(1)-$j->dummy(0))->abs->minover;
' aaab b
Results:
aaab b; b -> [3 2 1 0]
The full code is similar:
1 # Perl weekly challenge 248
2 # Task 1: Shortest Distance
3 #
4 # See https://wlmb.github.io/2023/12/17/PWC248/#task-1-shortest-distance
5 use v5.36;
6 use PDL;
7 die <<~"FIN" unless @ARGV==2;
8 Usage: $0 string letter
9 to obtain the shortest distances.
10 FIN
11 my @letters=split "", $ARGV[0];
12 my $i=pdl(grep {$letters[$_] eq $ARGV[1]} 0..@letters-1);
13 my $j=sequence(0+@letters);
14 say "@ARGV; $ARGV[1] -> ", ($i->dummy(1)-$j->dummy(0))->abs->minover;
Examples:
./ch-1.pl loveleetcode e
./ch-1.pl aaab b
Results:
loveleetcode e; e -> [3 2 1 0 1 0 0 1 2 2 1 0]
aaab b; b -> [3 2 1 0]
Task 2: Submatrix Sum
Submitted by: Jorg Sommrey
You are given a NxM matrix A of integers.
Write a script to construct a (N-1)x(M-1) matrix B having elements
that are the sum over the 2x2 submatrices of A,
b[i,k] = a[i,k] + a[i,k+1] + a[i+1,k] + a[i+1,k+1]
Example 1
Input: $a = [
[1, 2, 3, 4],
[5, 6, 7, 8],
[9, 10, 11, 12]
]
Output: $b = [
[14, 18, 22],
[30, 34, 38]
]
Example 2
Input: $a = [
[1, 0, 0, 0],
[0, 1, 0, 0],
[0, 0, 1, 0],
[0, 0, 0, 1]
]
Output: $b = [
[2, 1, 0],
[1, 2, 1],
[0, 1, 2]
]
This is also a good example to show off PDL. The result fits a one and a half liner.
Example 1:
perl -MPDL -MPDL::NiceSlice -E '
$m=pdl(shift); $n=pdl($m(0:-2,0:-2),$m(1:-1,0:-2),$m(0:-2,1:-1),$m(1:-1,1:-1))
->mv(-1,0)->sumover; say "$m->$n"
' "[[1,2,3,4],[5,6,7,8],[9,10,11,12]]"
Results:
[
[ 1 2 3 4]
[ 5 6 7 8]
[ 9 10 11 12]
]
->
[
[14 18 22]
[30 34 38]
]
Example 2:
perl -MPDL -MPDL::NiceSlice -E '
$m=pdl(shift); $n=pdl($m(0:-2,0:-2),$m(1:-1,0:-2),$m(0:-2,1:-1),$m(1:-1,1:-1))
->mv(-1,0)->sumover; say "$m->$n"
' "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]"
Results:
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
->
[
[2 1 0]
[1 2 1]
[0 1 2]
]
The full code is almost identical.
1 # Perl weekly challenge 248
2 # Task 2: Submatrix Sum
3 #
4 # See https://wlmb.github.io/2023/12/17/PWC248/#task-2-submatrix-sum
5 use v5.36;
6 use PDL;
7 use PDL::NiceSlice;
8 die <<~"FIN" unless @ARGV==1;
9 Usage: $0 M
10 to sum 2x2 the overlapped submatrices of matrix M
11 FIN
12 my $m=pdl(shift);
13 my $n=pdl($m(0:-2,0:-2),$m(1:-1,0:-2),$m(0:-2,1:-1),$m(1:-1,1:-1))
14 ->mv(-1,0)->sumover;
15 say "$m->$n"
Examples:
./ch-2.pl "[[1,2,3,4],[5,6,7,8],[9,10,11,12]]"
./ch-2.pl "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]"
Results:
[
[ 1 2 3 4]
[ 5 6 7 8]
[ 9 10 11 12]
]
->
[
[14 18 22]
[30 34 38]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
->
[
[2 1 0]
[1 2 1]
[0 1 2]
]
Alternative
After E. Choroboa pointed out this entry: Fast sliding submatrix sums with PDL (inspired by PWC 248 task 2) I found another solution that may be easily generalized to arbitrary window size. I use conv2d from PDL::Image2D to make a convolution with a kernel of ones, effectively summing submatrices. I discard the edges of the result, where the kernel doesn’t fit. The solutionx fits a two liner.
perl -MPDL -MPDL::Image2D -E '
$m=pdl(shift); $w=shift; $h=shift;say "$m $w -> ", $m->conv2d(ones($w,$h))->
slice([floor(($w-1)/2),floor(-($w+1)/2)], [floor(($h-1)/2),floor(-($h+1)/2)]);
' "[[1,2,3,4],[5,6,7,8],[9,10,11,12]]" 2 2
perl -MPDL -MPDL::Image2D -E '
$m=pdl(shift); $w=shift; $h=shift;say "$m $w -> ", $m->conv2d(ones($w,$h))->
slice([floor(($w-1)/2),floor(-($w+1)/2)], [floor(($h-1)/2),floor(-($h+1)/2)]);
' "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 2 2
perl -MPDL -MPDL::Image2D -E '
$m=pdl(shift); $w=shift; $h=shift;say "$m $w -> ", $m->conv2d(ones($w,$h))->
slice([floor(($w-1)/2),floor(-($w+1)/2)], [floor(($h-1)/2),floor(-($h+1)/2)]);
' "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 2 3
perl -MPDL -MPDL::Image2D -E '
$m=pdl(shift); $w=shift; $h=shift;say "$m $w -> ", $m->conv2d(ones($w,$h))->
slice([floor(($w-1)/2),floor(-($w+1)/2)], [floor(($h-1)/2),floor(-($h+1)/2)]);
' "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 3 2
perl -MPDL -MPDL::Image2D -E '
$m=pdl(shift); $w=shift; $h=shift;say "$m $w -> ", $m->conv2d(ones($w,$h))->
slice([floor(($w-1)/2),floor(-($w+1)/2)], [floor(($h-1)/2),floor(-($h+1)/2)]);
' "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 3 3
Results:
[
[ 1 2 3 4]
[ 5 6 7 8]
[ 9 10 11 12]
]
2 ->
[
[14 18 22]
[30 34 38]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
2 ->
[
[2 1 0]
[1 2 1]
[0 1 2]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
2 ->
[
[2 2 1]
[1 2 2]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
3 ->
[
[2 1]
[2 2]
[1 2]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
3 ->
[
[3 2]
[2 3]
]
Full code:
use v5.36;
use PDL;
use PDL::Image2D;
die <<~"FIN" unless @ARGV==3;
Usage: $0 M W H
where M is a matrix "[[m11,m22...],[m21,m22....],...]"
and W and H are the size of a sliding window to make a matrix of HxW submatrices
and sum the submatrix matrix elements.
FIN
my $m=pdl(shift);
my $w=shift;
my $h=shift;
say "Input: $m Width $w, Height $h -> ",
$m->conv2d(ones($w,$h))->slice([floor(($w-1)/2),floor(-($w+1)/2)],
[floor(($h-1)/2),floor(-($h+1)/2)]);
Examples
./ch-2a.pl "[[1,2,3,4],[5,6,7,8],[9,10,11,12]]" 2 2
./ch-2a.pl "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 2 2
./ch-2a.pl "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 2 3
./ch-2a.pl "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 3 2
./ch-2a.pl "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 3 3
Results:
Input:
[
[ 1 2 3 4]
[ 5 6 7 8]
[ 9 10 11 12]
]
Width 2, Height 2 ->
[
[14 18 22]
[30 34 38]
]
Input:
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
Width 2, Height 2 ->
[
[2 1 0]
[1 2 1]
[0 1 2]
]
Input:
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
Width 2, Height 3 ->
[
[2 2 1]
[1 2 2]
]
Input:
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
Width 3, Height 2 ->
[
[2 1]
[2 2]
[1 2]
]
Input:
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
Width 3, Height 3 ->
[
[3 2]
[2 3]
]
FFT
For large matrices/kernels it might be preferable to use a Fourier transform to compute the convolution. It seems that the kernel must have a center, thus it must have odd dimensions. For even dimensions, I can zero the last row and/or column. The examples below are small, but serve to show the results are the expected ones. First I show a four-liner and then the full code.
perl -MPDL -MPDL::FFT -E '
$m=pdl(shift); $W=$w=shift; $H=$h=shift; $s=ones($w%2?$w:$w+1, $h%2?$h:$h+1);
$s->slice(-1).=0, ++$w unless $w%2; $s->slice([],-1).=0, ++$h unless $h%2;
$k=kernctr($m, $s); $r=$m->copy; $r->fftconvolve($k); say "$m $W $H -> ",
$r->slice([floor(($W-1)/2),floor(-($W+1)/2)], [floor(($H-1)/2),floor(-($H+1)/2)]);
' "[[1,2,3,4],[5,6,7,8],[9,10,11,12]]" 2 2
perl -MPDL -MPDL::FFT -E '
$m=pdl(shift); $W=$w=shift; $H=$h=shift; $s=ones($w%2?$w:$w+1, $h%2?$h:$h+1);
$s->slice(-1).=0, ++$w unless $w%2; $s->slice([],-1).=0, ++$h unless $h%2;
$k=kernctr($m, $s); $r=$m->copy; $r->fftconvolve($k); say "$m $W $H -> ",
$r->slice([floor(($W-1)/2),floor(-($W+1)/2)], [floor(($H-1)/2),floor(-($H+1)/2)]);
' "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 2 2
perl -MPDL -MPDL::FFT -E '
$m=pdl(shift); $W=$w=shift; $H=$h=shift; $s=ones($w%2?$w:$w+1, $h%2?$h:$h+1);
$s->slice(-1).=0, ++$w unless $w%2; $s->slice([],-1).=0, ++$h unless $h%2;
$k=kernctr($m, $s); $r=$m->copy; $r->fftconvolve($k); say "$m $W $H -> ",
$r->slice([floor(($W-1)/2),floor(-($W+1)/2)], [floor(($H-1)/2),floor(-($H+1)/2)]);
' "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 2 3
perl -MPDL -MPDL::FFT -E '
$m=pdl(shift); $W=$w=shift; $H=$h=shift; $s=ones($w%2?$w:$w+1, $h%2?$h:$h+1);
$s->slice(-1).=0, ++$w unless $w%2; $s->slice([],-1).=0, ++$h unless $h%2;
$k=kernctr($m, $s); $r=$m->copy; $r->fftconvolve($k); say "$m $W $H -> ",
$r->slice([floor(($W-1)/2),floor(-($W+1)/2)], [floor(($H-1)/2),floor(-($H+1)/2)]);
' "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 3 2
perl -MPDL -MPDL::FFT -E '
$m=pdl(shift); $W=$w=shift; $H=$h=shift; $s=ones($w%2?$w:$w+1, $h%2?$h:$h+1);
$s->slice(-1).=0, ++$w unless $w%2; $s->slice([],-1).=0, ++$h unless $h%2;
$k=kernctr($m, $s); $r=$m->copy; $r->fftconvolve($k); say "$m $W $H -> ",
$r->slice([floor(($W-1)/2),floor(-($W+1)/2)], [floor(($H-1)/2),floor(-($H+1)/2)]);
' "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 3 3
Results:
[
[ 1 2 3 4]
[ 5 6 7 8]
[ 9 10 11 12]
]
2 2 ->
[
[14 18 22]
[30 34 38]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
2 2 ->
[
[2 1 0]
[1 2 1]
[0 1 2]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
2 3 ->
[
[2 2 1]
[1 2 2]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
3 2 ->
[
[2 1]
[2 2]
[1 2]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
3 3 ->
[
[3 2]
[2 3]
]
The corresponding full code is:
use v5.36;
use PDL;
use PDL::FFT;
my $matrix=pdl(shift);
my $width=my $w=shift;
my $height=my $h=shift;
my $small=ones($w%2?$w:$w+1, $h%2?$h:$h+1);
$small->slice(-1).=0, ++$w unless $w%2; # zero row and/or column for even kernels
$small->slice([],-1).=0, ++$h unless $h%2;
my $kernel=kernctr($matrix, $small); #full kernel
my $result=$matrix->copy;
$result->fftconvolve($kernel);
say "$matrix $width $height -> ",
$result->slice([floor(($width-1)/2),floor(-($width+1)/2)],
[floor(($height-1)/2),floor(-($height+1)/2)]);
./ch-2b.pl "[[1,2,3,4],[5,6,7,8],[9,10,11,12]]" 2 2
./ch-2b.pl "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 2 2
./ch-2b.pl "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 2 3
./ch-2b.pl "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 3 2
./ch-2b.pl "[[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]" 3 3
Results:
[
[ 1 2 3 4]
[ 5 6 7 8]
[ 9 10 11 12]
]
2 2 ->
[
[14 18 22]
[30 34 38]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
2 2 ->
[
[2 1 0]
[1 2 1]
[0 1 2]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
2 3 ->
[
[2 2 1]
[1 2 2]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
3 2 ->
[
[2 1]
[2 2]
[1 2]
]
[
[1 0 0 0]
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
]
3 3 ->
[
[3 2]
[2 3]
]
Written on December 17, 2023