laurent_r

These are some answers to the Week 248, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on December 24, 2023, at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Submatrix Sum

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 not very difficult. To keep it simple, we simply need to work row by row, and make sure we don't mess indices around.

Submatrix Sum in Raku

As said above, it is quite simple if we work row by row.

sub submatrix-sum (@in) {
    my $max-row = @in.end;
    my $max-col = @in[0].end;
    my @result;
    for 0..^$max-row -> $i {
        my @row;
        for 0..^$max-col -> $j {
            push @row, @in[$i][$j] + @in[$i][$j+1] + 
                @in[$i+1][$j] + @in[$i+1][$j+1];
        }
        push @result, @row; # push doesn't flatten 
    }
    return @result;
}

my @tests = [
              [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]
            ];
for @tests -> @test {
    print @test.gist, " => ";;
    say submatrix-sum @test;
}

This program displays the following output:

$ raku ./submatrix-sum.raku
[[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]]

Submatrix Sum in Perl

This a port to Perl of the above Raku program. It is slightly more complicated in Perl than in Raku, because we need to use references for nested data structures, but it is really not that difficult.

use strict;
use warnings;
use feature 'say';

sub submatrix_sum {
    my @in = @_;
    my $max_row = $#in - 1;
    my $max_col = $#{$in[0]};
    my @result;
    for my $i (0..$max_row ) {
        my @row;
        for my $j (0..$max_col - 1) {
            push @row, $in[$i][$j] + $in[$i][$j+1] + 
                $in[$i+1][$j] + $in[$i+1][$j+1];
        }
        push @result, [@row];
    }
    return @result;
}

my @tests = ([
              [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]
             ]);
for my $test (@tests) {
    print join ", ", map { "[@$_]" } @$test;
    print " => ";
    say join ", ", map { "[@$_]" } submatrix_sum @$test;
}

This program displays the following output:

$ perl  ./submatrix-sum.pl
[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]

Wrapping up

Season's greetings to everyone. The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on December 31, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.