Just another Perl shrine PerlMonks

### Re: Fast sliding submatrix sums with PDL (inspired by PWC 248 task 2)

by tybalt89 (Monsignor)
 on Dec 26, 2023 at 21:19 UTC Need Help??

Interesting problem...
Since it's that time of year...

```q(May all your Christmases be white.) =~ s/Christmase/loop/r =~ s/whit
+e/implicit/r

Inspired by mention of "sliding".

```#!/usr/bin/perl

use strict; # https://theweeklychallenge.org/blog/perl-weekly-challeng
use warnings;
use List::AllUtils qw( zip_by reduce );
use Data::Dump qw( pp );

sub slide
{
my @new;
reduce { push @new, \$a + \$b; \$b } @_;
@new;
}

for ( [ [1,  2,  3,  4],
[5,  6,  7,  8],
[9, 10, 11, 12] ],
[ [1, 0, 0, 0],
[0, 1, 0, 0],
[0, 0, 1, 0],
[0, 0, 0, 1] ],
)
{
print 'Input: \$a = ', pp(\$_), "\n";
my @new = zip_by { [ @_ ] } map [ slide @\$_ ],
zip_by { [ @_ ] } map [ slide @\$_ ], @\$_;
print 'Output: \$b = ', pp(\@new), "\n\n";
}

Outputs

```Input: \$a = [[1 .. 4], [5 .. 8], [9 .. 12]]
Output: \$b = [[14, 18, 22], [30, 34, 38]]

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

Replies are listed 'Best First'.
Re^2: Fast sliding submatrix sums with PDL (inspired by PWC 248 task 2)
by tybalt89 (Monsignor) on Dec 27, 2023 at 13:57 UTC

And here's a WxH version. It's interesting what can be found in List::AllUtils...

```#!/usr/bin/perl

use strict; # https://theweeklychallenge.org/blog/perl-weekly-challeng
use warnings;
use List::AllUtils qw( sum zip_by reductions );
use Data::Dump qw( pp );

sub nslide # size, elements
{
my @q = splice @_, 0, shift;
return reductions { push @q, \$b; \$a + \$b - shift @q } sum(@q), @_;
}

my (\$width, \$height) = (2, 2);
for ( [ [1,  2,  3,  4],
[5,  6,  7,  8],
[9, 10, 11, 12] ],
[ [1, 0, 0, 0],
[0, 1, 0, 0],
[0, 0, 1, 0],
[0, 0, 0, 1] ],
)
{
print 'Input: \$a = ', pp(\$_), "\n";
my @new = zip_by { [ @_ ] } map [ nslide \$height, @\$_ ],
zip_by { [ @_ ] } map [ nslide \$width, @\$_ ], @\$_;
print 'Output: \$b = ', pp(\@new), "\n\n";
}
And here's a WxH version

Excellent. And here a slope for you to slide, sort of in splendid isolation, from a plot fanatic:

```sub sms_WxH_Perl_sliding_tybalt89 ( \$m, \$width, \$height ) {
my @new = zip_by { [ @_ ] } map [ nslide \$height, @\$_ ],
zip_by { [ @_ ] } map [ nslide \$width, @\$_ ], @\$m;
return \@new
}

__END__

Time (s) vs. N (NxN submatrix, 1500x1500 matrix)
+-----------------------------------------------------------+
1.8 |-+  +      +      +      +       +      +      +      +  +-|
|    A                                                      |
|    A                                                      |
1.6 |-+                                                       +-|
|        A                                                  |
|                                                           |
1.4 |-+                                                       +-|
|           A                                               |
|                                                           |
1.2 |-+             A                                         +-|
|                                                           |
|                  A                                        |
|                      A                                    |
1 |-+                                                       +-|
|                         A                                 |
|                                                           |
0.8 |-+                           A                           +-|
|                                                           |
|                                 A                         |
0.6 |-+                                  A                    +-|
|                                        A                  |
|                                                           |
0.4 |-+                                         A             +-|
|                                               A           |
|                                                  A        |
0.2 |-+                                                       +-|
|                                                      A    |
|    +      +      +      +       +      +      +      +    |
0 +-----------------------------------------------------------+
0     200    400    600     800    1000   1200   1400
sms_WxH_Perl_sliding_tybalt89    A
+------+-------+
| N    | A     |
+------+-------+
| 2    | 1.700 |
| 10   | 1.725 |
| 100  | 1.538 |
| 200  | 1.387 |
| 300  | 1.259 |
| 400  | 1.131 |
| 500  | 1.016 |
| 600  | 0.894 |
| 700  | 0.784 |
| 800  | 0.678 |
| 900  | 0.578 |
| 1000 | 0.484 |
| 1100 | 0.394 |
| 1200 | 0.309 |
| 1300 | 0.231 |
| 1400 | 0.153 |
+------+-------+

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11156544]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (3)
As of 2024-06-25 01:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?
 • erzuuli ‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.