PWC 268 Games Numbers Play
Tags: perl, perlweeklychallenge, pwc
Published: 2024-05-06 14:24:53


Two easy tasks this week, with a common thread that things get easier if data is re-arranged. (1) [Magic Number](#task-1-magic-number) (2) [Number Game](#task-2-number-game)

Musical reference: take your pick. Personally, I like the Joe South song.
[Games People Play (Joe South, 1970)](https://www.youtube.com/watch?v=hIBlCac8_wk)
[Games People Play (Spinners, 1975)](https://www.youtube.com/watch?v=I_4xktFy4Dw)
[Games People Play (Alan Parsons Project, 1980)](https://www.youtube.com/watch?v=SLi7Ljcy6n8)


## [Task 1: Magic Number](https://theweeklychallenge.org/blog/perl-weekly-challenge-268/#TASK1)

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

Write a script to find the magic number that,
when added to each element of one of the arrays,
gives the second array.
Element order is not important.
```
#### Example 1
- Input: `@x = (3, 7, 5)`, `@y = (9, 5, 7)`
- Output: 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`

#### Example 3
- Input: `@x = (2)`, `@y = (5)`
- Output: `3`

### Minimal work
If the arrays were sorted, it would be obvious that the magic number is the difference between any pair.  So let's find the lowest number in each array and find the difference.
```perl
sub magicNumber($x, $y)
{
    use List::Util qw/min/;
    return min($y->@*) - min($x->@*);
}
```
That's pretty lazy. I really should be validating that the inputs are the same length, and that the magic number works for mapping all elements of `$x` to `$y`. Let's add a `validate` function
```perl
sub validate($x, $y, $magic) { ... }
    ...
    return validate($x, $y, min($y->@*) - min($x->@*));
    ... 
```
`validate` will return either `$magic`, or `undef` if there is no number that works.

If `$magic` really is magic, then it will be true that adding it to every element of `$x` will create an element of `$y`. Let's do that.
```perl
    my %should_be_y;
    $should_be_y{ $_ + $magic } = $_  for $x->@*; 
```
Now, it should be true that all the keys of `%should_be_y` are elements of `$y`. If we delete all `$y` keys, then `%should_be_y` would be left empty.
```perl
    delete $should_be_y{$_}  for $y->@*; 
    return scalar(%should_be_y) == 0 ? $magic : undef;
```
Here's the whole `validate` function:
```perl
sub validate($x, $y, $magic)
{
    return undef if $x->$#* != $y->$#*;
    my %should_be_y;
    $should_be_y{$_ + $magic} = $_ for $x->@*;
    delete $should_be_y{$_} for $y->@*;
    return scalar(%should_be_y) == 0 ? $magic : undef;
}
```

Perl notes:
- It's inconvenient to pass multiple arrays as arguments. By default, they get flattened into a single array. It's possible to have two array arguments by using [old-school function prototypes](https://perldoc.perl.org/perlsub#Prototypes), but it conflicts with new-school function signatures, and the feature is obscure.  Instead, we pass arrays by reference.
    - How _would_ you declare a subroutine that takes two arrays as arguments?  It would look like this:
```perl
sub mn :prototype(\@@) {
    my @x = @{shift @_}; 
    my @y = @_; 
}
```
- That means we have to de-reference the arrays. I use post-fix notation here (`$y->@*`) because I find it readable; the other way to get the full array would be to use a prefix sigil (`@{$y}`). Notice that the last index of an array is available as `$x->$#*` and `$y->$#*`.


## [Task 2: Number Game](https://theweeklychallenge.org/blog/perl-weekly-challenge-268/#TASK2)
```text
You are given an array of integers, @ints,
with an 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 them to new array in
decreasing order, i.e. high to low. Keep doing 
this 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)`

### Look, Ma, no loops!
A bit of reflection reveals that all we're really doing here is swapping pairs of the sorted array.  We could literally follow the instructions of the task (find the lowest numbers, swap them, push them onto an array), but maybe we can do something that exploits Perl features better.

And by better, I mean using array operations.

If we had the `@ints` array sorted, then we would be selecting its elements in pairs: (1,0), (3,2), (5,4), etc.

If we had that list of indexes (1,0,3,2,5,4,...), then we could take a slice of the sorted array. So how could we generate the list of indexes?

That's odd and even indexes, which means pairs of 2*_n_+1 and 2*_n_. The range of numbers we need is half the length of the array, which is `$#ints/2`. We can map that range into pairs of corresponding odd and even numbers. The `map` operator can map each of its inputs to multiple output values, a useful behavior.
```perl
my @choose = map { 2 * $_ +1, 2*$_ } 0 .. ($#ints / 2)
```
Now all that remains is to use that generated array to take a slice of the sorted array.
```perl
@ints = sort { $a <=> $b } @ints; 
return @ints[ @choose ]; 
```
We can elide the temporary variables, at the cost of readability.
```perl
sub game(@ints)
{
    return [ (sort { $a <=> $b } @ints)[ map { 2*$_+1, 2*$_ } 0 .. $#ints/2 ] ];
}
```
Here we are returning a reference to the result instead of a list, for two reasons: (1) it avoids making a copy of the array as it's passed back up the stack, and (2) it's easier to use the function in a unit test.
```perl
sub runTest
{
    use Test2::V0;

    is( game(2,5,3,4),         [3,2,5,4], "Example 1");
    is( game(9,4,1,3,6,4,6,1), [1,1,4,3,6,4,9,6], "Example 2");
    is( game(1,2,2,3),         [2,1,3,2], "Example 3");

    done_testing;
}
```
Finished code is on [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/w268/challenge-268/bob-lied/perl)