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
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]) {
$matches++;
}
}
say $matches;
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;
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;