# Perl Weekly Challenge 248.

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

``````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  #
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]
``````

``````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  #
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