Author: Colin Crain

Wherein we get knocked down, but we get up again.
You’re never gonna keep us. down

THE WEEKLY CHALLENGE – PERL & RAKU #222 task 2

---

“Let me not then die ingloriously and without a struggle, but let me first do some great thing that shall be told among men hereafter.“

— Hector, Iliad book XXII, lines 304-5

---

Last Member

Submitted by: Mohammad S Anwar

You are given an array of positive integers, @ints.

Write a script to find the last member if found otherwise return 0. Each turn pick 2 biggest members (x, y) then decide based on the following conditions, continue this until you are left with 1 member or none.

a) if x == y then remove both members

b) if x != y then remove both members and add new member (y-x)

Example 1:

Input: @ints = (2, 7, 4, 1, 8, 1)
Output: 1

Step 1: pick 7 and 8, we remove both 
          and add new member 1 => (2, 4, 1, 1, 1).
Step 2: pick 2 and 4, we remove both 
          and add new member 2 => (2, 1, 1, 1).
Step 3: pick 2 and 1, we remove both 
          and add new member 1 => (1, 1, 1).
Step 4: pick 1 and 1, we remove both => (1).

Example 2:

Input: @ints = (1)
Output: 1

Example 3:

Input: @ints = (1, 1)
Output: 0

Step 1: pick 1 and 1, we remove both and are left with none.

ANALYSIS

There is, as has often been noted on these pages, more than one way to do it. This mantra is good general advice in life, and Perl goes as far as to take the expression as its credo.

So what exactly is this thing we are tasked to do? The algorithm as described could be reduced to the steps of sorting, selecting, processing and repeating, with a check at every pass as to whether we have less than two elements to compare. That is, basically, what is being said.

And direct process, as written, seems like it should work quite nicely. Build a loop, set the stepwise process and bang we’re in. On the other hand… you do have to sort the array over and over as you insert the reduced elements back in, which frankly sounds kind of boring and inefficient. Now, if we were in a hurry — for whatever reason — we would refrain from the cardinal sin of premature optimization, but here in this sandbox we suffer no such constraints. So how, he says, could we just reinsert the difference at the right place in the sorted array when we compute it, obviating any need to resort?

And yes, I do use words like “obviate” in normal speech. It’s a pretty great word, as words go. It sounds very active, in a negating sort of way, which makes it inherently colorful. I like that.

But I digress.

The tradeoff, then, is between repeatedly sorting the whole array versus just looking for the correct insertion point for our newly created differential value. But here’s the thing: sorting the array, no matter the algorithm we use to go about it, will always require us to handle each and every element. Alternately, if we just examine the array elements from smallest upward, we can stop when the next element is larger and insert there.

It does seem like that will shed some unnecessary effort.

METHOD

PERL 5 SOLUTION

We’ll make copious use of splice to directly manipulate the array in its gradual erosion. To find the insertion point we can conditionally increment a zeroed counter until either the next element is greater than the computed difference or the end of the array is reached. Repeat until done.

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

use constant { VERBOSE => 1};

my @arr = @ARGV;
@arr == 0 and @arr = (1,1,1,15,7);
@arr = sort {$a<=>$b} @arr;
VERBOSE && say "@arr";

## let the games begin!
while (@arr > 1) {

    ## remove the last two elements and test their difference
    ## scan the remaining array and reinsert at the point
    ## where the next element is larger or the array ends
    my ($second, $last) = splice @arr, -2;
    if (my $diff = $last - $second) {
        my $c = 0;
        ## post-increment until the next element 
        $c++ while (exists $arr[$c] and $arr[$c] < $diff);
        splice @arr, $c, 0, $diff;
        VERBOSE && say "@arr";
    }
}

say( @arr ? $arr[0]
          : 0        
);

Raku Solution

In Raku, things tighten up a bit. Again we erode the array two elements at a time using splice and then calculate the difference between the larger and smaller. Because the variable for the difference is not important outside the loop we can just assign it to the topic.

Next, using first with the :k parameter we can find the first occurrence of an element greater than the topic, applied to a slip of the array values and the difference we are assured a match at the last element. Done this way we don’t need a further separate test to make sure we are still in bounds.

unit sub MAIN ( *@arr ) ;

my $VERBOSE = 1;  ## show progress of array reduction?
@arr .= sort;

while @arr.elems > 1 {
    $VERBOSE && say @arr;
    $_ = [-] (@arr.splice(*-2).reverse) || next;
    @arr.splice( ((|@arr, $_).first: * >= $_, :k), 0, $_ );     
}

say @arr.defined ?? @arr[0] !! 0;