All those Pasta Lies Led to a Lonely Ex

Wherein we ponder the little things taken together, an aggregate of each composed from the ones that came before it, and how these elements combine to make the building blocks of the things we use daily. Whether this leads to solace or seclusion remains uncertain, and we look for answers.

THE WEEKLY CHALLENGE – PERL & RAKU #77

---

episode 1
“The False Potato Pasta Incident”

---

TASK #1 › Fibonacci Sum

Submitted by: Mohammad S Anwar

You are given a positive integer $N.

UPDATE: 2020-09-07 09:00:00:
Write a script to find out all possible combination of Fibonacci Numbers required to get $N on addition.

You are NOT allowed to repeat a number. Print 0 if none found.

Example 1:

Input: $N = 6
Output:
    1 + 2 + 3 = 6
    1 + 5 = 6

Example 2:

Input: $N = 9
Output:
    1 + 8 = 9
    1 + 3 + 5 = 9

Method

As originally specced, this challenge was to find the shortest sequence of Fibonacci Numbers that sum to the desired target. This is not a particularly intuitive puzzle, but I came up with an algorithm to subtract the largest Fibonacci Number less than a running total until finished. However this method, while undoubtably efficient, was hard to prove to be the absolute shortest in all cases. A little coding problem was turning into a bit of a complicated math problem. Reasonably confident in my intuition I let things be and moved on to the Raku version.

With the Raku version complete, there it stood, until today, when copying the task over to lay out this page. Then I noticed the update. Hmm. Perhaps ensuring that the strategy was the shortest was more complicated than anyone had considered. In any case, now we were asked to show all possible combinations from the Fibonacci sequence that sum appropriately.

I had originally developed my strategy with the express intent of avoiding having to calculate every combination of the given elements. As the number of combinations of a set grows by the factorial of the set size, once the number of elements in the set of available options begins to grow things will get out of hand increasingly quickly. But when now required to find all the solutions, it was to either quickly find a simple, algorithmic, deep underlying pattern to the sums (unlikely) or just look at them all and check.

So I decided brute force would have to do. If we looked at every combination of those Fibonacci Numbers less than the target and summed them to see what stuck, I could load an array with the results and dump it at the end. We would just have to do what we could to make things as efficient as possible where we could.

The last thing to consider was a careful parsing the new directives. The big question was what to do with: “You are NOT allowed to repeat a number.” On the face of it this seems clear enough, except that two items of the sequence, F(1) and F(2) are the same, with value 1. Thus the question is the definition of “number” here — either a Fibonacci Number or just a plain old number. Either way makes sense in its way, but it determines whether we can use 1 once or twice. As there were already proving to be a large set of solutions once the numbers begin to gain a few digits, I figured I’d err on the side of parsimony and choose the more restrictive interpretation.

Likewise every successful solution is repeated nearly verbatim if we’re allowed to include F(0), which is 0. Obviously adding 0 to any sequence won’t change the sum, and I hardly see the point of doing so. Technically it is a different sequence, but practically it isn’t. It sort of depends on your ontological opinion about nothingness. Even though that discussion is legitimately fascinating, in this context it’s noticeably less so. So let’s go ahead and exclude those redundant solutions on the grounds of being boring, the ultimate sin in this existence.

I’m still bothered by that first algorithm I finished, removing the largest element of the sequence less than the running total. It works and it’s clean. It always seems to finish in the fewest steps for every number I check, but I’ve been too busy to rigorously think it through. As a matter of fact, I’m going to move on again right now. But after checking 1,000,000 just now:

1,000,000 = 55 + 144 + 46368 + 121393 + 832040

I’m convinced it’s correct.

Perl Solution

Having to start over and a little pressed for time, I decided to reach for the big guns, so to speak, and let the Algorithm::Combinatorics module do the heavy lifting with its combinations function. Further, we’ll use the iterator form to spit out incremental, individual combinations on demand to avoid blowing up memory.

Because of our very specific needs for the Fibonacci Sequence numbers, generating that sequence can be very quickly done with just an array and a loop, exiting out before the next number would exceed the target.

100,000 seems to work in a reasonable length of time. 1,000,000 maybe not so much. I wouldn’t go much more than that. YMMV.

[colincrain:~/PWC]$  perl 77_1_your_pasta_lies_add_up.pl 1000000
target: 1000000
1 + 2 + 5 + 13 + 34 + 144 + 17711 + 28657 + 121393 + 317811 + 514229
1 + 2 + 5 + 13 + 34 + 144 + 17711 + 28657 + 121393 + 832040
1 + 2 + 5 + 13 + 34 + 144 + 17711 + 28657 + 46368 + 75025 + 121393 + 196418 + 514229
    ( ... )
8 + 13 + 34 + 55 + 89 + 987 + 1597 + 4181 + 10946 + 28657 + 46368 + 75025 + 317811 + 514229
8 + 13 + 34 + 55 + 89 + 987 + 1597 + 4181 + 10946 + 28657 + 46368 + 75025 + 832040

use warnings;
use strict;
use feature ":5.26";

use Algorithm::Combinatorics qw(combinations);
use List::Util qw(sum);

## ## ## ## ## MAIN:

my ($target) = shift @ARGV // 9999;

## make a fib sequence up to the target
my @fib = (0,1);
while (1) {
    push @fib,  $fib[-1]  + $fib[-2];
    last if $fib[-1]  + $fib[-2] > $target;
}
## remove 0, remove extra 1
splice @fib,  0, 2;

## work
my @output;
for my $len (1..@fib) {
    my $iter = combinations( \@fib, $len );
    while ( my $c = $iter->next ) {
        push @output, join " + ", @$c if sum( @$c ) == $target;
    }
}

## out
say "target: $target";
say $_ for sort @output;

Raku Solution

In Raku everything’s gloriously condensed to its essence. Having tail makes construction by drawing on the two previous elements of the sequence painless, likewise for nipping off F(0) and F(1) from the front of the list. The actual solutions are created with .combinations, then parallelized with `.race` to do the sum and search because we’re going to sort everything when we’re done anyway. A little tuning with the adverbs for my machine got me to 8 cores and batches of 200, for a speedup of about 400%.

unit sub MAIN (Int $target = 100000) ;

## make a fib sequence up to the target
my @fib = 0, 1 ;
while @fib.tail(2).sum <= $target {
    @fib.push: @fib.tail(2).sum ;
}

## remove F(0), F(1) -- choose to exclude
@fib .= tail(*-2);

## race runs the grep on 8 cores in batches of 200, for about a 3.75x speedup
my @output = @fib.combinations.race:8degree:200batch.grep( *.sum == $target );

say "target: $target";
(.join: ' + ').say for @output.sort;

---

episode 2
“The Lonely Ex”

---

TASK #2 › Lonely X

Submitted by: Mohammad S Anwar

You are given m x n character matrix consists of O and X only.
Write a script to count the total number of X surrounded by O only. Print 0 if none found.

Example 1:

Input: [ O O X ]
       [ X O O ]
       [ X O O ]

Output: 1 as there is only one X at the first row last column surrounded by only O.

Example 2:

Input: [ O O X O ]
       [ X O O O ]
       [ X O O X ]
       [ O X O O ]

Output: 2

    a) First  X found at Row 1 Col 3.
    b) Second X found at Row 3 Col 4.

DISCUSSION

Last week we expounded on the existential plight of primes, and how their isolation might affect their identity. There were some elaborate cultural references employed, culminating with the observation that “One is the Loneliest Number”.

This week we will revisit the psychological effects of isolation, starting with a means for identifying individuals removed from close proximity to their peer-groups.

Although the task directives only request the number of individuals present, in this day of contact tracing it seems prudent to extend our goals to include the last known location of those characters.

Method

In action, determining the contents of the points surrounding a given point shares much with last week’s word search problem. In this case, though, we need only look at a single square in each of the eight possible directions.

If any one of the surrounding locations is filled with an X, the given point is determined to have company. The process we’ll use will be similar: we traverse through each point in the grid, then examine the points around it in eight directions to determine the outcome. If no neighbor are to be found, the coordinate pair gets added to a results array. When finished, the results array is converted into an output report.

Any point along the edges of the grid will be missing some surrounding positions, and these points, undefined, obviously do not contain any Xs. Like living next to a graveyard, though, these positions may be quiet, but do not provide any social comfort along those faces.

Perl Solution

In Perl 5, we’ll use a pair of iterators to loop through the list of lists comprising the grid. If a given point contains an X, it is then checked with the is_lonely routine, which uses a list of eight offsets to generate the positions of the surrounding squares. If a position is out of bounds, having an index less than 0 or an undefined value, it is skipped. If a position contains an X, the function immediately returns false and the called point is not lonely.

The output is delivered in a spreadsheet-like notation, indexed on columns across then rows down to find the selected X.

[colincrain:~/PWC]$  perl 77_2_lonely_ex.pl OOXOO XOOOX XOXOO OXXXO OOOOX
O  O  X  O  O
X  O  O  O  X
X  O  X  O  O
O  X  X  X  O
O  O  O  O  X

the X at column → 3, row down ↓ 1 is lonely
the X at column → 5, row down ↓ 2 is lonely

use warnings;
use strict;
use feature ":5.26";
## ## ## ## ## MAIN:

## in
my @input = @ARGV;
@input = qw(OOXO XOOO XOOX OXOO) if scalar @input == 0 ;
our $mat = [ map { [ split //, $_ ] } @input ];

## work
my @lonely;
for my $y (0..scalar @$mat-1) {
    for my $x (0..scalar @{$mat->[0]}-1) {
        if ($mat->[$y][$x] eq 'X' and is_lonely($x, $y)) {
            push @lonely, [$x, $y];
        }
    }
}

## out
say (join '  ', $_->@*) for $mat->@*;
for ( @lonely ) {
    my ($col, $row) = map { ++$_ } @$_;
    say "the X at column → $col, row down ↓ $row is lonely";
}

## ## ## ## ## SUBS:

sub is_lonely {
    my ($x, $y) = @_;
    
    for my $offset ([1,0],[1,1],[0,1],[-1,1],[-1,0],[-1,-1],[0,-1],[1,-1]) {
        next if ($x + $offset->[0] < 0) || ($y + $offset->[1] < 0);
        next if ! defined $mat->[ $y + $offset->[1] ][ $x + $offset->[0] ];
        return 0 if $mat->[ $y + $offset->[1] ][ $x + $offset->[0] ] eq 'X';  
    }
    return 1;    
}

Raku Solution

In Raku we can generate a sequence of all points on the grid using the X cross-product operator, which is nice and simple. Using a similar trick, we can generate the offset pairs that lead to the surrounding points, by creating all combinations pairs for (-1,0,1) and removing the identity (0,0). In other respects it closely mirrors the Perl 5.

I moved all the logic in the “work” section into a single map function, but ultimately decided just too much as going on in one line and left it broken apart. There is a coolness in condensation, but also a cost in clarity. Clarity has value, and should be encouraged.

Following that logic, inlining the offset pairs rather than recomputing them would definitely make more sense, but I felt like exploring the X operator a little more so here we are. I freely admit my inconsistencies. In Raku there are often many ways to approach a problem, and I try and take the opportunity where I can to try them out.

unit sub MAIN (*@input) ;

## in
@input = qw<OOXO XOOO XOOX OXOO> if @input ~~ Empty;            
our @matrix = @input.map({.comb});
my @lonely;

## work
for ^@matrix[0].elems X ^@matrix.elems -> ($x, $y) {
    if (@matrix[$y][$x] eq 'X' and is_lonely($x, $y)) {
        @lonely.push: ($x, $y);
    }
}

## out
.join(' ').say for @matrix;
say '';
for @lonely -> @point {
    my ($col, $row) = @point.map({$_+1});
    say "the X at column → $col, row down ↓ $row is lonely";
}

sub is_lonely {
    my ($x, $y) = @_;
    
    for ((-1,0,1) X (-1,0,1)).grep( * !eqv (0,0)) -> $offset {
        next if 0 > any ($x + $offset[0]) | ($y + $offset[1]);
        next if ! defined @matrix[ $y + $offset[1] ][ $x + $offset[0] ];
        return 0 if @matrix[ $y + $offset[1] ][ $x + $offset[0] ] eq 'X';  
    }
    return 1;    
}