Tag: produce metaoperator

Wherein we plow forward into the unknown once more, hoping to find familiar shores soon…

THE WEEKLY CHALLENGE – PERL & RAKU #163 Task 2

---

“Experience is what you get while looking for something else.”

— Federico Fellini

---

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

Opening Commentary

Behold another piece of unusual operation assemblage, systematically reducing a list according to the baroque rules of an arcane process. Again I can’t immediately see a rationale for doing this particular task, but that’s no mind. I do things for no reason all the time. Why should today be any different?

Looking back on this comment, I acknowledge the sentiment is unsettling.

METHOD

Ok, it’s a metaphor for life. Let’s break it down.

At each iteration, we:

1. shift off the first value from the list
2. incrementally sum the list from left to right
3. at each position, add the running total to a new list
4. after filling the last postion, replace the old list with the new
5. repeat until there is only once value in the new list

Well when you put it like that, it doesn’t seem so bad.

PERL 5 SOLUTION

Implementing an opaque algorithm that reduces a list to a number is not the most satisfying thing, all-in-all. The result is hard to really appreciate without context. With this in mind installed a non-essential variable to hold the lists as they are formed. After the reduction we pull up a pretty-printing routine to review what happened.

Testing with the example lists:

trianglular reduction steps:

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

ok 1 - ex-1

trianglular reduction steps:

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

ok 2 - ex-2

See? Everything is going according to plan.

use warnings;
use strict;
use utf8;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';

use constant {VERBOSE => 1};
our @stack;

say trisum( @ARGV ) and exit if @ARGV ;

sub trisum (@list) {
    my $sum;
    my @new;
    @stack = [@list];

    while (@list > 1) {
        @new = ();
        $sum = 0;
        
        shift @list;
        for (keys @list) {
            $sum += $list[$_];
            push @new, $sum;
        }
        push @stack, [@new];
        @list = @new;
    }
    print_stack_and_flush() if VERBOSE;

    return shift @new;
}


sub print_stack_and_flush {
    my $elements   = @stack;
    my $max_digits = length $stack[-1]->[0];
    my $fmt = ('%' . ($max_digits + 3) . 's') x $elements;

    say "\ntrianglular reduction steps:\n";
    
    for my $row (@stack) {
        unshift $row->@*, '' while $row->@* < $elements;
        say sprintf $fmt, $row->@*;
    }
    
    say "sum  $stack[-1]->[-1]\n";
    
    @stack = ();
}

Raku Solution

In Raku we have another metaoperator that can help us along, produce with addition, [\+]. This is applied left-to-right across the list values, accumulating a value that is kept in a new list as it grows. The action decomposes to a single complex statement: while there’s still more than one element in the list, shift off an element and then work across the remaining list form left-to-right, adding each new element to an accumulating sum and substituting the sum for the added element. After this is done we return the list, now a single element, and print it.

```perl
unit sub MAIN ( *@input ) ;

put trisum( @input ) and exit if @input.elems > 0 ;


sub trisum (*@list) {
    shift @list and @list = [\+] @list while @list.elems > 1;
    @list;
}