Perl Weekly Challenge 163.

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

Task 1: Sum Bitwise Operator

Submitted by: Mohammad S Anwar
You are given list positive numbers, @n.

Write script to calculate the sum of bitwise & operator for
all unique pairs.

Example 1
Input: @n = (1, 2, 3)
Output: 3

Since (1 & 2) + (2 & 3) + (1 & 3) => 0 + 2 + 1 =>  3.
Example 2
Input: @n = (2, 3, 4)
Output: 2

Since (2 & 3) + (2 & 4) + (3 & 4) => 2 + 0 + 0 =>  2.

According to the examples, 1&1, 2&2, etc. don’t count as ‘unique pairs’ If I interpret ‘unique pairs’ as elements with different indices, then there is a very simple solution using PDL:

perl -MPDL -E '$n=pdl(@ARGV); say "Input: $n Output: ", (($n&$n->dummy(0))->sum-$n->sum)/2;
   '  1 2 3
perl -MPDL -E '$n=pdl(@ARGV); say "Input: $n Output: ", (($n&$n->dummy(0))->sum-$n->sum)/2;
   '  2 3 4

I first build a 1D array $n. The I build a matrix $n&$n->dummy(0) containing the bitwise & of all pairs of elements of $n. To that end, I apply the operator & to the (row) N vector $n and the column vector, i.e., the 1xN matrix, $n->dummy(0), obtained by adding a dummy index. Then I sum all the entries. That sum contains the elements of the diagonal, which should be excluded, and it contains both $n($i)&$n($j) and $n($j)&$n($i). Thus I remove the sum over the diagonal and divide the result by two.

The results are:

Input: [1 2 3] Output: 3
Input: [2 3 4] Output: 2

The code above fails if not all input numbers differ, as there would be additional repeated pairs to exclude. The problem is fixed by only keeping unique numbers in the input. Thus, a second version is:

perl -MPDL -E '$n=($i=pdl(@ARGV))->uniq; say "Input: $i Output: ", (($n&$n->dummy(0))->sum-$n->sum)/2;
   '  1 2 3
perl -MPDL -E '$n=($i=pdl(@ARGV))->uniq; say "Input: $i Output: ", (($n&$n->dummy(0))->sum-$n->sum)/2;
   '  1 2 3 1 2 3
perl -MPDL -E '$n=($i=pdl(@ARGV))->uniq; say "Input: $i Output: ", (($n&$n->dummy(0))->sum-$n->sum)/2;
   '  2 3 4

The full code is:

 1  # Perl weekly challenge 163
 2  # Task 1: Sum bitwise operator
 3  #
 4  # See https://wlmb.github.io/2022/05/02/PWC163/#task-1-sum-bitwise-operator
 5  use v5.12;
 6  use warnings;
 7  use PDL;
 8  die "Usage: ./ch-1.pl n1 [n2....] ...\n",
 9      "to calculate the sum of n_i&n_j for all unique non-repeating pairs n_i, n_j\n"
10      unless @ARGV;
11  my $in=pdl(@ARGV);
12  my $n=$in->uniq; # filter out repeated elements
13  my $r=where($n&$n->dummy(0), $n^$n->dummy(0))->sum/2;
14  say "Input: $in Output: $r";

Here instead of subtracting the diagonal I filter the repeated pairs using their ‘exclusive or’ (xor, ‘^’) as a mask.

Examples:

./ch-1.pl 1 2 3
./ch-1.pl 1 2 3 1 2 3
./ch-1.pl 2 3 4

Results:

Input: [1 2 3] Output: 3
Input: [1 2 3 1 2 3] Output: 3
Input: [2 3 4] Output: 2

Notice that it would be simple to generalize the program above to an arbitrary, user supplied binary operator instead of &.

Task 2: Summations

Submitted by: Mohammad S Anwar
You are given a list of positive numbers, @n.

Write a script to find out the summations as described below.

Example 1
Input: @n = (1, 2, 3, 4, 5)
Output: 42

    1 2 3  4  5
      2 5  9 14
        5 14 28
          14 42
             42

The nth Row starts with the second element of the (n-1)th
row. The following element is sum of all elements except first
element of previous row.
You stop once you have just one element in the row.
Example 2
Input: @n = (1, 3, 5, 7, 9)
Output: 70

    1 3  5  7  9
      3  8 15 24
         8 23 47
           23 70
              70

Notice that the end result is a linear combination of the input vector, ∑i fNi×ni, where fNi counts how many times does the i-th element of the N-th row contributes to the final result. For convenience, I will reverse the input and put the final result at the top, so I drop the rightmost terms as I go upward. Therefore, I rewrite example 1 as the table vij:

| i\j |  0 |  1 | 2 | 3 | 4 |
|   0 | 42 |    |   |   |   |
|   1 | 42 | 14 |   |   |   |
|   2 | 28 | 14 | 5 |   |   |
|   3 | 14 |  9 | 5 | 2 |   |
|   4 |  5 |  4 | 3 | 2 | 1 |

The final row (v4,j)=(5,4,3,2,1) is the reversed input.

For N=0 we have f00=1, i.e., the input is the result (42 in the row 0 of the table above). For N=1 we have f10=1 and f11=0, as the element v11 (the 14 in the row 1) doesn’t contribute to the result, which is given by v1,0 (the 42 in row 1). Similarly, f22=0 as v22 (the 5 in row 2) doesn’t contribute to the result. f21=2 as v21 (the 14 in row 2) contributes to v11 (the 14 above) and to v10 (the 42 above). Furthermore, f20=1 as v20 (the 28 in row 2) only contributes to v10 (the 42 above). Continuing this way, we construct the table fij

| i\j | 0 | 1 | 2 | 3 | 4 |
|   0 | 1 |   |   |   |   |
|   1 | 1 | 0 |   |   |   |
|   2 | 1 | 1 | 0 |   |   |
|   3 | 1 | 2 | 2 | 0 |   |
|   4 | 1 | 3 | 5 | 5 | 0 |

Notice a simple recursive rule: fij=fi-1,j+fi,j-1 with the left boundary conditions fi,0=1 and the upper right boundary conditions fi,i=0. Thus, the coefficients f may be calculated recursively, memoizing the results to avoid repetition. Notice that once calculated, they may be employed for multiple input vectors.

A twoliner solution is

perl -MMemoize -E 'memoize f; $N=@ARGV-1; $s+=f($N,$_)*$ARGV[-1-$_] for(0..$N); say join " ", "In: @ARGV Out:",
    $s; sub f{my ($n,$m)=@_; return 1 if $m==0; return 0 if $n==$m; f($n-1, $m)+f($n,$m-1)}
' 1 2 3 4 5
perl -MMemoize -E 'memoize f; $N=@ARGV-1; $s+=f($N,$_)*$ARGV[-1-$_] for(0..$N); say join " ", "In: @ARGV Out:",
    $s; sub f{my ($n,$m)=@_; return 1 if $m==0; return 0 if $n==$m; f($n-1, $m)+f($n,$m-1)}
' 1 3 5 7 9

Results:

In: 1 2 3 4 5 Out: 42
In: 1 3 5 7 9 Out: 70

The corresponding full code follows.

 1  # Perl weekly challenge 163
 2  # Task 2: Summations
 3  #
 4  # See https://wlmb.github.io/2022/05/02/PWC163/#task-2-summations
 5  use v5.12;
 6  use warnings;
 7  use Memoize;
 8  memoize 'f';
 9  die 'Usage: ./ch-2.pl "N0 [N1..]" "M0 [M1..]"...',
10      'to obtain the strange summation of N0 N1..., of M0 M1..., etc.'
11      unless @ARGV;
12  for(@ARGV){
13      my @in=reverse split /\s+/;
14      my $N=@in-1;
15      my $sum=0;
16      $sum+=f($N, $_)*$in[$_] for(0..$N);
17      say "Input: $_ Output: $sum";
18  }
19  sub f{
20      my ($n,$m)=@_;
21      return 1 if $m==0;
22      return 0 if $n==$m;
23      f($n-1, $m)+f($n,$m-1);
24  }

./ch-2.pl "1 2 3 4 5" "1 3 5 7 9" "1 2 3 4 5 6 7 8 9 10"

Results:

Input: 1 2 3 4 5 Output: 42
Input: 1 3 5 7 9 Output: 70
Input: 1 2 3 4 5 6 7 8 9 10 Output: 16796

I added some code to count and report the number of calls to the recursive subroutine f above. Using memoize there were 13 calls for the argument “1 2 3 4 5”, no further calls for the argument “1 3 5 7 9”, and 40 additional calls for the argument “1 2 3 4 5 6 7 8 9 10”. In contrast, without memoization, the program used 41 calls for “1 2 3 4 5”, another 41 calls for the argument “1 3 5 7 9”, and 13826 calls for the argument “1 2 3 4 5 6 7 8 9 10”. Memoizing is a big time saver.

Written on May 2, 2022