Peter’s blog ✴ Week 222 ✴ 19 June 2023

THE WEEKLY CHALLENGE
Members’ week

The Perl Camel

Task 2

Last member

You are given an array of positive integers, @ints. Pick the biggest and next biggest members (x, y), apply the following rules, and repeat until you are left with 1 member (report it) or none (report 0).

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

Analysis

The rules are quite straightforward. Clearly the order of the integers is not material, so to make things easy I keep them in reverse sorted order.

That means that x and y are always the first two elements and I can quickly remove them using shift, and then if they differ, add the difference to @ints using unshift.

And I do all that as long as at least 2 elements remain, and when they don't, we have the answer.

Perl Weekly’s review

from PW issue 622

Get the special feeling and treat yourself with self explanatory solutions. Well done.

Try it 

Example: 1,3,5,7,9

Script


#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2023-06-19
use utf8;     # Week 222 task 2 - Last member
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

last_member(2, 7, 4, 1, 8, 1);
last_member(1);
last_member(1, 1);

# longer example
my ($j, @ints);
for $j (0 .. 9) {
    $ints[$j] = int(rand(49)) + 1;
}
last_member(@ints);

sub last_member {
    
    my (@ints, $diff, $legend);
    
    # initialise
    @ints = @_;
    $legend = '';
    
    # loop until 0 or 1 left
    while (scalar @ints > 1) {
        
        # sort remaining list in decreasing order
        @ints = sort { $b <=> $a } @ints;
        
        # remove two largest, and add difference if they differ
        $legend .= qq[\n  Pick $ints[0] and $ints[1], we remove both ];
        $diff = (shift @ints) - (shift @ints);
        unshift @ints, $diff if $diff;
        
        # and say what we've done
        $legend .= qq[and add new member $diff ] if $diff;
        $legend .= scalar @ints > 0 ? qq[=> (] . join(', ', @ints) . q[)] : q[and are left with none];
    }
    
    # report findings
    say qq[\nInput: \@ints = (] . join(', ', @_) . q[)];
    say qq[Output: ] . (defined $ints[0] ? $ints[0] : '0') . $legend;
}

13 lines of code

Output from script


Input: @ints = (2, 7, 4, 1, 8, 1)
Output: 1
  Pick 8 and 7, we remove both and add new member 1 => (1, 4, 2, 1, 1)
  Pick 4 and 2, we remove both and add new member 2 => (2, 1, 1, 1)
  Pick 2 and 1, we remove both and add new member 1 => (1, 1, 1)
  Pick 1 and 1, we remove both => (1)

Input: @ints = (1)
Output: 1

Input: @ints = (1, 1)
Output: 0
  Pick 1 and 1, we remove both and are left with none

Input: @ints = (4, 8, 20, 41, 27, 43, 41, 9, 8, 11)
Output: 2
  Pick 43 and 41, we remove both and add new member 2 => (2, 41, 27, 20, 11, 9, 8, 8, 4)
  Pick 41 and 27, we remove both and add new member 14 => (14, 20, 11, 9, 8, 8, 4, 2)
  Pick 20 and 14, we remove both and add new member 6 => (6, 11, 9, 8, 8, 4, 2)
  Pick 11 and 9, we remove both and add new member 2 => (2, 8, 8, 6, 4, 2)
  Pick 8 and 8, we remove both => (6, 4, 2, 2)
  Pick 6 and 4, we remove both and add new member 2 => (2, 2, 2)
  Pick 2 and 2, we remove both => (2)

 

Any content of this website which has been created by Peter Campbell Smith is in the public domain