Perl Weekly Challenge: Week 351
Challenge 1:
Special Average
You are given an array of integers.
Write a script to return the average excluding the minimum and maximum of the given array.
Example 1
Input: @ints = (8000, 5000, 6000, 2000, 3000, 7000)
Output: 5250
Min: 2000
Max: 8000
Avg: (3000+5000+6000+7000)/4 = 21000/4 = 5250
Example 2
Input: @ints = (100_000, 80_000, 110_000, 90_000)
Output: 95_000
Min: 80_000
Max: 110_000
Avg: (100_000 + 90_000)/2 = 190_000/2 = 95_000
Example 3
Input: @ints = (2500, 2500, 2500, 2500)
Output: 0
Min: 2500
Max: 2500
Avg: 0
Example 4
Input: @ints = (2000)
Output: 0
Min: 2000
Max: 2000
Avg: 0
Example 5
Input: @ints = (1000, 2000, 3000, 4000, 5000, 6000)
Output: 3500
Min: 1000
Max: 6000
Avg: (2000 + 3000 + 4000 + 5000)/4 = 14000/4 = 3500
I thought "this is easy" that it could be a one-liner even. There were a couple of wrinkles that made it not completely smooth sailing however.
In my first attempt I first .sort() the command-line arguments in ascending numeric order and take a slice of the
result that excludes the first element (I.e. the minimum) and the last element (i.e. the maximum.). The values in the array
slice are totalled up with .sum() and divided by the number of elements in the array minus two for the two elements we removed.
Finally the result is outputted with say().
say @*ARGS.sort({$^a <=> $^b})[1..*-2].sum / (@*ARGS.elems - 2)
This should do the trick and indeed it works for examples 1,2 and 5 but it fails for examples 3 and 4. In example 3 for instance, all values in the array are the same as the minimum (or maximum) so all should be removed giving an answer of 0. The same applies to example 4 where there is only one value.
So in my next try, first I aliased @*ARGS to @a to save some characters and so I can manipulate the array. (@*ARGS is immutable.) Then I used the set difference operator ∖ on @a. and a list consisting of the minimum and maximum elements (found
with .min() and .max() respectively.) This operator returns a Set that contains all the elements of its' first operand which
are not elements of the second operand. We want a List of values not a Set and the shortest way to get that is with
.keys(). Now we can divide the sum of the elements by their number to find the average as we did above.
my @a = @*ARGS; @a = (@a ∖ (@a.min, @a.max)).keys; say @.sum / @a.elems
But we're not completely out of the woods yet. In both examples 3 and 4, we will end up with a set of 0 elements and division
by 0 fails. So using the ternerey operator ?? .. !! I explicity check if @a is not empty and if it is empty the calculation is
skipped and 0 is printed instead.
my @a = @*ARGS; @a = (@a ∖ (@a.min, @a.max)).keys; say @a ?? @a.sum /@a.elems !! 0
For the Perl version, we need to provide our own min(), max() and sum() functions, so it's definitely not a one-liner. Also
as we lack sets and set operators, I used a double grep() instead.
@ints = grep { $_ != min(@ints) } grep { $_ != max(@ints) } @ints;
say @ints ? sum(@ints) / @ints : 0;
Challenge 2:
Arithmetic Progression
You are given an array of numbers.
Write a script to return true if the given array can be re-arranged to form an arithmetic progression, otherwise return false.
A sequence of numbers is called an arithmetic progression if the difference between any two consecutive elements is the same.
Example 1
Input: @num = (1, 3, 5, 7, 9)
Output: true
Already AP with common difference 2.
Example 2
Input: @num = (9, 1, 7, 5, 3)
Output: true
The given array re-arranged like (1, 3, 5, 7, 9) with common difference 2.
Example 3
Input: @num = (1, 2, 4, 8, 16)
Output: false
This is geometric progression and not arithmetic progression.
Example 4
Input: @num = (5, -1, 3, 1, -3)
Output: true
The given array re-arranged like (-3, -1, 1, 3, 5) with common difference 2.
Example 5
Input: @num = (1.5, 3, 0, 4.5, 6)
Output: true
The given array re-arranged like (0, 1.5, 3, 4.5, 6) with common difference 1.5.
First we sort @nums in ascending numeric order as any arithmetic progression will have this order.
my @sorted = @nums.sort({ $^a <=> $^b });
The absolute value of the first teo sorted elements is taken and assigned to $difference. This quantity
will always be the difference between any two successive elements of an array which exhibits arithmetic progression,
my $difference = (@sorted[1] - @sorted[0]).abs;
We need a flag to determine if this array is arithmetically progressing. Initially it will be set to True.
my $isArithmeticProgression = True;
Now we can go through the sorted array from the third element (i.e. index 2) onwards and compare each element with
the one before it. If the difference between them is anything other than $difference, we are no longer in an arithmetic
progression. The flag is set to False and we stop processing.
for 2 .. @sorted.end -> $i {
if @sorted[$i] - @sorted[$i - 1] != $difference {
$isArithmeticProgression = False;
last;
}
}
Finally we print the value of the flag.
say $isArithmeticProgression;
For once, the Perl version doesn't need any extra code. It is the exact equivalent to the Raku version.
my @nums = sort { $a <=> $b } @ARGV;
my $difference = abs($nums[1] - $nums[0]);
my $isArithmeticProgression = true;
for my $i (2 .. scalar @nums - 1) {
if ($nums[$i] - $nums[$i - 1] != $difference) {
$isArithmeticProgression = false;
last;
}
}
say $isArithmeticProgression ? 'true' : 'false';