Beefy Boxes and Bandwidth Generously Provided by pair Networks
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 ( [id://11156544]=note: print w/replies, xml ) Need Help??


in reply to Fast sliding submatrix sums with PDL (inspired by PWC 248 task 2)

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 +e-248/#TASK2 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 +e-248/#TASK2 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 | +------+-------+

Log In?
Username:
Password:

What's my password?
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.