Perl Weekly Challenge: Week 339
Challenge 1:
Max Diff
You are given an array of integers having four or more elements.
Write a script to find two pairs of numbers from this list (four numbers total) so that the difference between their products is as large as possible.
In the end return the max difference.
With Two pairs (a, b) and (c, d), the product difference is (a * b) - (c * d).
Example 1
Input: @ints = (5, 9, 3, 4, 6)
Output: 42
Pair 1: (9, 6)
Pair 2: (3, 4)
Product Diff: (9 * 6) - (3 * 4) => 54 - 12 => 42
Example 2
Input: @ints = (1, -2, 3, -4)
Output: 10
Pair 1: (1, -2)
Pair 2: (3, -4)
Example 3
Input: @ints = (-3, -1, -2, -4)
Output: 10
Pair 1: (-1, -2)
Pair 2: (-3, -4)
Example 4
Input: @ints = (10, 2, 0, 5, 1)
Output: 50
Pair 1: (10, 5)
Pair 2: (0, 1)
Example 5
Input: @ints = (7, 8, 9, 10, 10)
Output: 44
Pair 1: (10, 10)
Pair 2: (7, 8)
This solution stretches the definition of a one-liner a little bit but it still counts in my book.
First we get all combinations of 4 command-line parameters with .combinations(4). Then for each combination (uaing
.map(),) because we don't know which order of elements will give the best answer, we use .permutations() to get all the possible orderings. For each of these (using .map() again,) we do the product difference calculation as
shown in the spec. We get the permutation with the largest product difference with .max(). Now we know the largest
product differnce for each 4-element combination so we use .max() again to get the largest one overall and print that
out with .say().
@*ARGS.combinations(4).map({ .permutations.map({ $_[0] * $_[1] - $_[2] * $_[3] }).max }).max.say
We can't do the Perl version in one line because we need replacements for combinations(), permutations() and max(). However with those, the core of the script is one line. Also as we are not space-constrained any more, I made the
product difference calculation into a subroutine for added clarity.
sub productDifference($arr) {
return $arr->[0] * $arr->[1] - $arr->[2] * $arr->[3];
}
say max(map { max(map { productDifference($_) } permute @{$_}) } combinations(\@ARGV, 4));
Challenge 2:
Peak Point
You are given an array of altitude gain.
Write a script to find the peak point gained.
Example 1
Input: @gain = (-5, 1, 5, -9, 2)
Output: 1
start: 0
1st change: 0 + (-5) = -5
2nd change: -5 + 1 = -4
3rd change: -4 + 5 = 1
4th change: 1 + (-9) = -8
5th change: -8 + 2 = -6
max(0, -5, -4, 1, -8, -6) = 1
Example 2
Input: @gain = (10, 10, 10, -25)
Output: 30
start: 0
1st change: 0 + 10 = 10
2nd change: 10 + 10 = 20
3rd change: 20 + 10 = 30
4th change: 30 + (-25) = 5
max(0, 10, 20, 30, 5) = 30
Example 3
Input: @gain = (3, -4, 2, 5, -6, 1)
Output: 6
start: 0
1st change: 0 + 3 = 3
2nd change: 3 + (-4) = -1
3rd change: -1 + 2 = 1
4th change: 1 + 5 = 6
5th change: 6 + (-6) = 0
6th change: 0 + 1 = 1
max(0, 3, -1, 1, 6, 0, 1) = 6
Example 4
Input: @gain = (-1, -2, -3, -4)
Output: 0
start: 0
1st change: 0 + (-1) = -1
2nd change: -1 + (-2) = -3
3rd change: -3 + (-3) = -6
4th change: -6 + (-4) = -10
max(0, -1, -3, -6, -10) = 0
Example 5
Input: @gain = (-10, 15, 5)
Output: 10
start: 0
1st change: 0 + (-10) = -10
2nd change: -10 + 15 = 5
3rd change: 5 + 5 = 10
max(0, -10, 5, 10) = 10
This one was relatively easy. Here is a solution as a Raku one-liner;
First we create an array @a to hold the changes. We could have saved this step if we used the topic variable @_
but apparently we can't if we are also using $_. Maybe it is possible but I did not investigate thoroughly as I
was a little pressed for time and creating @a was easy enough. It is initialized to 0 as that is the initial change.
Now for each command-line argument, we compare it to the most recent element in @a (i.e. index *-1.) That is the next change and it is appended to @a with .push().
Finally we find the maximum element in @a with .max() and print it with .say().
@a = (0); for @*ARGS { @a.push(@a[*-1] + $_)}; @a.max.say
Alas for Perl we are again robbed of the possiblility of a one-liner by the need to provide functions missing from
the Perl standard library, in this case max(). Or I suppose I could have used the trick of sorting @changes numerically and then taking the last element but that would have made the code a bit long for one line. So I just
wrote it the long way like this:
my @changes = (0);
for (@ARGV) {
push @changes, $changes[-1] + $_;
}
say max(@changes);