Perl subtract values from two 2D arrays

user_14386453 0
Viewed 112

I have the following script:

#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw(sum);

my @a1=([1,2,3],
        [4,5,6],
        [7,8,9]);

my @a2=([4,3],
        [2,1]);

my @subtracted;

for (my $i=0; $i<=$#a2; $i++){
    for (my $j=0; $j<=$#a2; $j++){
        my $subtraction=$a1[$i][$j] - $a2[$i][$j];
        print "$subtraction\n";
        my $abs=abs($subtraction);
        push(@subtracted, $abs);
    }
}
my $sum=sum(@subtracted);
my $average=$sum/@subtracted;
print "Average=$average\n";

exit;

This prints:

-3
-1
2
4
Average=2.5

This is subtracting the following referenced elements:

$a1[0][0] - $a2[0][0]
$a1[0][1] - $a2[0][1]
$a1[1][0] - $a2[1][0]
$a1[1][1] - $a2[1][1]

But now I need it to do:

$a1[1][1] - $a2[0][0]
$a1[1][2] - $a2[0][1]
$a1[2][1] - $a2[1][0]
$a1[2][2] - $a2[1][1]

and print:

1
3
6
8
Average=4.5

So that the elements of @a2 are fixed but the elements of @a1 are moved 1 line and 1 column (the number of compared elements is always limited by the number of elements in @a2). But now I am completely stuck and have no idea of how to do it. So, thank you in advance for your ideas.

perl arrays
1 Answers
my $sum = 0;
for my $i (0..$#a2) {
   for my $j (0..$#{ $a2[0] }) {
      my $diff = $a1[$i+1][$j+1] - $a2[$i][$j];
      $sum += $diff;
   }
}

my $avg = $sum / ( @a2 * @{ $a2[0] } );
say "avg: $avg";

In a comment, you talk about wanting a single loop. It's unclear what you meant by that, but I think you meant that you want to loop for every possible offset.

my $n = @a2;
my $m = @{ $a2[0] };

for my $ofs (0..$#a1-$#a2) {
   my $sum = 0;
   for my $i (0..$n-1) {
      for my $j (0..$m-1) {
         my $diff = $a1[$i+$ofs][$j+$ofs] - $a2[$i][$j];
         $sum += $diff;
      }
   }

   my $avg = $sum / ( $n * $m );
   say "ofs: $ofs, avg: $avg";
}

Many of the terms from the sum of one offset are in common with the terms of the sum of the previous offset.

Illustration of common terms

As you can see, it involves fewer operations to calculate the delta of two subsequent sums than to calculate the sum from scratch. We can take advantage of that to optimize the solution for larger arrays.

my $n = @a2;
my $m = @{ $a2[0] };
my $nm = $n * $m;

my $sum = 0;
for my $i (0..$n-1) {
   for my $j (0..$m-1) {
      $sum -= $a2[$i][$j];
   }
}

for my $i (0..$n-2) {
   for my $j (0..$m-2) {
      $sum += $a1[$i][$j];
   }
}

for my $ofs (0..$#a1-$#a2) {
   $sum += $a1[ $_     + $ofs ][ ($m-1) + $ofs ] for 0..$n-2;
   $sum += $a1[ ($n-1) + $ofs ][ $_     + $ofs ] for 0..$m-2;
   $sum += $a1[ ($n-1) + $ofs ][ ($m-1) + $ofs ];

   my $avg = $sum / $nm;
   say "ofs: $ofs, avg: $avg";

   $sum -= $a1[ $_ + $ofs ][ 0  + $ofs ] for 1..$n-1;
   $sum -= $a1[ 0  + $ofs ][ $_ + $ofs ] for 1..$m-1;
   $sum -= $a1[ 0  + $ofs ][ 0  + $ofs ];
}

For mass number crunching, you might want to look at PDL.

user_5899240
Related