Perl Weekly Challenge: Week 222

Challenge 1:

Matching Members

You are given a list of positive integers, @ints.

Write a script to find the total matching members after sorting the list increasing order.

Example 1
Input: @ints = (1, 1, 4, 2, 1, 3)
Output: 3

Original list: (1, 1, 4, 2, 1, 2)
Sorted list  : (1, 1, 1, 2, 3, 4)

Compare the two lists, we found 3 matching members (1, 1, 2).
Example 2
Input: @ints = (5, 1, 2, 3, 4)
Output: 0

Original list: (5, 1, 2, 3, 4)
Sorted list  : (1, 2, 3, 4, 5)

Compare the two lists, we found 0 matching members.
Example 3
Input: @ints = (1, 2, 3, 4, 5)
Output: 5

Original list: (1, 2, 3, 4, 5)
Sorted list  : (1, 2, 3, 4, 5)

Compare the two lists, we found 5 matching members.

Raku (but of course) can solve this as a one-liner:

(@*ARGS Z @*ARGS.sort).grep({$_[0]==$_[1]}).elems.say

The Z operator "zips" two arrays and produces a new array consisting of pairs of elements interleaved from the operands. I used it to combine the command-line arguments with a sorted version of those arguments. Then for each pair, .grep() was used to filter those where the two members are equal. The number of matches is counted via .elems() and printed out.

This worked nicely but I wondered if I could make it even shorter. Z is a "meta-operator" meaning it can apply another operator as it zips. By combining it with == to make Z==, I got back an array of Booleans where pairs whose elements are equal are turned to True and those that are not become False. Changing the invocation of .grep() as shown below, filters out only the True elements which can then be counted etc.

(@*ARGS Z== @*ARGS.sort).grep({$_}).elems.say

Unfortunately, there doesn't seem to be any way of getting rid of .grep() altogether. But we can squeeze it just a little bit more. Z- subtracts the second element of each pair from the first. Now each pair whose elements are equal will be transformed into 0 which we can .grep() for without a block. My final version looks like this:

(@*ARGS Z- @*ARGS.sort).grep(0).elems.say

(Full code on Github.)

Can't do these clever tricks with Perl; we have to go the long way round and explicity loop through the arrays counting matches.

my @ints = @ARGV;
my @sorted = sort { $a <=> $b} @ints;
my $matches = 0;

for my $i (0 .. scalar @ints - 1) {
    if ($ints[$i] == $sorted[$i]) {

say $matches;

(Full code on Github.)

Challenge 2:

Last Member

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 we left with none.

This was a lot easier than it initiallly looked.

First I sorted the array of Ints in descending numeric order. This means the two biggest members of the array will always be the first two. Now I could have saved a few characters by not including a code block in the call to .sort() in which case Raku would have sorted in ascending numeric order by default. In that case the x and y would have been the last two elements. It's easy enough to access the last two elements of a list in Raku but the whole thing would have been less readable in my opinion so it is better to be a bit more verbose.

my @sorted = @ints.sort({ $^b <=> $^a });

We have to keep looping doing the step mentioned in the spec until we have one element left or none.

until @sorted.elems < 2 {

If condition a in the spec occurs we remove the first two elements (the two biggest if you recall) and re-sort the list.

    if @sorted[0] == @sorted[1] {
        @sorted = @sorted.splice(2).sort({ $^b <=> $^a });

If condition b occurs we need to subtract the second biggest element from the biggest. This has to be a separate operation because the first two elements will change after splicing, sorting etc.

The first two elements are removed from the list, the result of the subtraction is added to the end of it, and finally the list is re-sorted.

    } else {
        my $new = @sorted[0] - @sorted[1];
        @sorted = @sorted.splice(2).push($new).sort({ $^b <=> $^a });

If, after we break out of the loop, the list is not empty, it has one element. We print its' value. Or if the list is empty we just print 0.

say @sorted ?? @sorted[0] !! 0;

(Full code on Github.)

The Perl version is almost identical.

my @sorted = sort { $b <=> $a } @ints;

until (scalar @sorted < 2) {
    if ($sorted[0] == $sorted[1]) {
        @sorted = sort { $b <=> $a } splice @sorted, 2;
    } else {
        my $new = $sorted[0] - $sorted[1];

Except we can't chain methods together nicely like in Raku.

        @sorted = splice @sorted, 2;
        push @sorted, $new;
        @sorted = sort { $b <=> $a } @sorted;

say scalar @sorted ? $sorted[0] : 0;

(Full code on Github.)