Perl Weekly Challenge: Week 268

Challenge 1:

Magic Number

You are given two arrays of integers of same size, @x and @y.

Write a script to find the magic number that when added to each elements of one of the array gives the second array. Elements order is not important.

Example 1
Input: @x = (3, 7, 5)
       @y = (9, 5, 7)
Output: 2

The magic number is 2.
@x = (3, 7, 5)
   +  2  2  2
@y = (5, 9, 7)
Example 2
Input: @x = (1, 2, 1)
       @y = (5, 4, 4)
Output: 3

The magic number is 3.
@x = (1, 2, 1)
   +  3  3  3
@y = (5, 4, 4)
Example 3
Input: @x = (2)
       @y = (5)
Output: 3

I chose to represent the input as two command-line arguments where each argument is a list of numbers separated by spaces. The first line of the solution separates each input string into individual numbers with .words() and then .sorts() them. Although the spec says element order is not important, we do in fsct need to sort the number lists in order to compare the elements with the most similar magnitudes. We can compare the sorted lists in one go using the Z- operator which takes elements in the same positions in both lists (i.e. @x[0] and @y[0], @x[1]and@y[1]` etc.) and subtracting one from the other.

my @diff = $x.words.sort Z- $y.words.sort; 

Now @diff is a list of differences. If .all() the differences are the same as the first difference (i,e, @diff[0]. Actually we could compare to any element but @diff[0] is guaranteed to exist.) it means we have a magic number. Because it could be negative and we don't care about the sign, we use .abs() to get rid of it. If, however, all the differences were not the same, it means there was no magic number. The spec doesn't say what to do in this case and it doesn't occur in any of the examples but in the event that it does, I chose to print the message "no magic number".

say @diff.all == @diff[0] ?? @diff[0].abs !! "no magic number";

(Full code on Github.)

This is the Perl version:

my @x = sort { $a <=> $b } split /\s+/, $ARGV[0];
my @y = sort { $a <=> $b } split /\s+/, $ARGV[1];

In Perl, we don't have Z- so we do the equivalent operation using a loop.

my @diff;

for my $i (0 .. scalar @x - 1) {
    push @diff, $x[$i] - $y[$i];

We don't have .all() either so we need a loop here too. If we find a difference that doesn't match the first one, we print our "no magic number" message and exit the script.

for my $i (1 .. scalar @diff - 1) {
    if ($diff[$i] != $diff[0]) {
        say "no magic number";

If all the differences are the same we have a magic number so we print it.

say abs $diff[0];

(Full code on Github.)

Challenge 2:

Number Game

You are given an array of integers, @ints, with even number of elements.

Write a script to create a new array made up of elements of the given array. Pick the two smallest integers and add it to new array in decreasing order i.e. high to low. Keep doing until the given array is empty.

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

Round 1: we picked (2, 3) and push it to the new array (3, 2)
Round 2: we picked the remaining (4, 5) and push it to the new array (5, 4)
Example 2
Input: @ints = (9, 4, 1, 3, 6, 4, 6, 1)
Output: (1, 1, 4, 3, 6, 4, 9, 6)
Example 3
Input: @ints = (1, 2, 2, 3)
Output: (2, 1, 3, 2)

This one sounds a little complicated but it really isn't.

First we sort the input smallest value to largest.

@ints = @ints.sort;

We create an array to hold the output.

my @output;

Now we take off the first two elements from @ints with .splice() and append them to @output. Because the list is sorted, we know they are the two smallest elements. As the spec wants them to be inserted high to low, we need to swap the order with .reverse() first. To prevent the elements being inserted as a list reference, they have to be "flattened" with |.

while (@ints) {
    @output.push(| @ints.splice(0, 2).reverse);

Finally we print the output in the style of the examples.

say q{(}, @output.join(q{, }), q{)};

(Full code on Github.)

For once, the Perl version doesn't require any extra code to replace Raku functionality.

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

while (@ints) {
    push @output, reverse splice @ints, 0, 2;

say q{(}, (join q{, }, @output), q{)};

(Full code on Github.)