laurent_r

These are some answers to the Week 163 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 May 8, 2022 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Sum Bitwise Operator

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.

Sum Bitwise Operator in Raku

In Raku, the numeric bitwise AND is spelled ~&, not &. We will use it together with the reduction operator) [~&] on all possible unordered pairs (generated with the combinations method). We then sum the partial results.

for <1 2 3>, <2 3 4> -> @n {
    say @n, " -> ", ([~&] $_ for @n.combinations(2)).sum;
}

This script displays the following results:

$ raku ./bitwise-sum.raku
(1 2 3) -> 3
(2 3 4) -> 2

This is almost a one-liner, except for the fact that we need more than one line only because there are two tests. We can easily rewrite it as a pure Raku one-liner:

$ raku -e 'say ([~&] $_ for @*ARGS.combinations(2)).sum;' 1 2 3
3
$ raku -e 'say ([~&] $_ for @*ARGS.combinations(2)).sum;' 2 3 4
2

Sum Bitwise Operator in Perl

In Perl, we write a combine2 subroutine with two nested loops to generate a list of pairs. We then add the results of the & operators on such pairs.

use strict;
use warnings;
use feature "say";

sub combine2 {
    my @combinations;
    my @in = @_;
    for my $i (0..$#in) {
        for my $j ($i + 1 .. $#in) {
            push @combinations, [$in[$i], $in[$j]];
        }
    }
    return @combinations;
}

for my $test ([qw <1 2 3>], [qw <2 3 4>]) {
    my $sum = 0;
    $sum += $_->[0] & $_->[1] for combine2 @$test;
    say "@$test -> ", $sum;
}

This program displays the following output:

$ perl ./bitwise-sum.pl
1 2 3 -> 3
2 3 4 -> 2

Task 2: Summations

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

Summations in Raku

We will use the triangular reduction operator [\+]. It returns a lazy list of all intermediate partial results, which happens to be exactly what we need here.

sub summations (@in) {
    my @result = @in;
    for 1..@result.end {
        @result = [\+] @result[1..*-1];
        return @result[0] if @result.elems == 1;
    }
}

for <1 2 3 4 5>, <1 3 5 7 9> -> @test {
    say @test, " -> ", summations @test;
}

This program displays the following output:

$ raku ./summations.raku
(1 2 3 4 5) -> 42
(1 3 5 7 9) -> 70

Summations in Perl

We use a sum subroutine, which returns the sum of its arguments. We then use a for loop to compute the partial sums.

use strict;
use warnings;
use feature "say";

sub sum {
    my $sum = 0;
    $sum += $_ for @_;
    return $sum;
}

sub summations {
    my @result = @_;
    for (1..$#result) {
        my @temp;
        push @temp, sum (@result[1..$_]) for 1..$#result;
        @result = @temp;
        return $result[0] if @result == 1;
    }
}
for my $test ([qw <1 2 3 4 5>], [qw <1 3 5 7 9>]) {
    say "@$test -> ", summations @$test;
}

This program displays the following output:

$ perl ./summations.pl
1 2 3 4 5 -> 42
1 3 5 7 9 -> 70

Wrapping up

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 May 15, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.