PWC 249 Equal pairs and DI strings
Published: 2023-12-28 03:34:33

Winter holidays are winding down. The kitchen is a mountain of dirty dishes and half-eaten leftovers; the living room is strewn with boxes and already-boring toys. The [Advent of Perl](https://perladvent.org/2023/) has wrapped up and the [Advent of Code](https://adventofcode.com) has reached its annual insoluble apex. But the Perl Weekly Challenge is here for a light respite.

## [Task 1 Equal Pairs](https://theweeklychallenge.org/blog/perl-weekly-challenge-248/#TASK1)
### Task Description
```text
You are given an array of integers with even number of elements.
Write a script to divide the given array into equal pairs such that:
a) Each element belongs to exactly one pair.
b) The elements present in a pair are equal.
```
#### Example 1
Input: `@ints = (3, 2, 3, 2, 2, 2)`
Output: `(2, 2), (3, 3), (2, 2)`
#### Example 2
Input: `@ints = (1, 2, 3, 4)`
Output: `()`

An easy warmup, although why that order of output in Example 1 is unclear at the moment. We need even counts of the elements, and then to generate pairs.  I'm not going to actually shuffle elements around the array.  I'll use `frequency` from `List::MoreUtils` to get counts and check for odd quantities.
```perl
    my %freq = frequency @ints;
    return [] if any { $_ % 2 == 1 } values %freq;
```
To check for odd quantities, I'm ignoring the numbers and looking only at the counts using `values` to extract from a hash table. It's far more common to use `keys` and then look up the values, but sometimes we just want the "other half" of the hash.

My comparison uses `List::MoreUtils::any`.  I like using `any` and `all` because they will stop scanning the list as soon as they know the condition can (`any`) or can't (`all`) be met, which can be more efficient.

Knowing now that we have even quantities of each element, we can generate the pairs. I throw in a sort so that I get deterministic order for unit testing.
```perl
    my @pair;
    for my $n ( sort { $a <=> $b } keys %freq )
    {
        push @pair, [ $n, $n ] for 1 .. $freq{$n}/2;
    }
    return \@pair;
```
That's not quite satisfying.  Example 1 clearly shows a pair of 2's, a pair of 3's and then another pair of 2's. I infer that what's happening is that the numbers are taken in order, generating a pair for each, and then the order is repeated until the pairs are exhausted.

Using the frequency hash that we've already decided on, how do we extract pairs in that order? Let's empty the hash in order by the keys, one pair at a time:
```perl
    my @pair;
    while ( %freq )
    {
        for my $n ( sort { $a <=> $b } keys %freq )
        {
            push @pair, [ $n, $n ];
            $freq{$n} -= 2;
            delete $freq{$n} if $freq{$n} == 0;
        }
    }
    return \@pair;
}
```
The condition `while(%freq)` exploits the feature of Perl that a hash variable taken in scalar context (a `while` conditional expression is a scalar context) will yield the number of keys in the hash, as of Perl 5.26 (circa 2017). Before that, it returned some statistic about hash efficiency, although it did usefully return 0 for an empty hash.

## [Task 2: DI String Match](https://theweeklychallenge.org/blog/perl-weekly-challenge-249/#TASK2)
### Task Description
```text
You are given a string s, consisting of only the
characters "D" and "I". Find a permutation of the
integers [0 .. length(s)] such that for each 
character s[i] in the string:
    s[i] == 'I' ⇒ perm[i] < perm[i + 1]
    s[i] == 'D' ⇒ perm[i] > perm[i + 1]
```
#### Example 1
Input: `$str = "IDID"`
Output: `(0, 4, 1, 3, 2)`
#### Example 2
Input: `$str = "III"`
Output: `(0, 1, 2, 3)`
#### Example 3
Input: `$str = "DDI"`
Output: `(3, 2, 0, 1)`

### Discourse
DI? Drill instructor? Donor insemination? Diagnostic imaging? It took a moment of poring over the examples to understand what this is getting at. "I" and "D" apparently are subtly named to imply "Increase" and "Decrease". An "I" is an instruction to create a pair of numbers that increase; and a "D" is an instruction to create a pair of numbers that decrease. This is weird; I'm not sure what context would make this useful. [Why do you build me up, buttercup. just to let me down?](https://www.youtube.com/watch?v=w0kLkDCoRXc)

So here's my brilliant insight.  If we take the I's out of the string and number them, they will form an increasing sequence. If we take the D's out of the sequence and number them, they will form a decreasing sequence. The two sequences are interleaved according to where the I's and D's are in the original string.

Let's make a sequence from 0 to length of `s`, because the task strongly hints that would be helpful.  Each time we see an I in `s`, we'll take the lowest number off the left end -- an increasing sequence -- and that means the subsequent number we take off `@idx` must be greater, as required.  Each time we see a D, we'll take the highest number off the right end -- a decreasing sequence -- and that means the subsequent number will be lower, as required. At the end of the string, that will leave one element, which completes the permutation.
```perl
sub di($s)
{
    my @perm;
    my @idx = 0 .. length($s);

    for my $di ( split("", $s) )
    {
        if   ( $di eq "I" ) { push @perm, shift @idx } #lowest
        else                { push @perm, pop   @idx } #highest
    }
    push @perm, shift @idx;
    return \@perm;
}
```
Perl operators `push`, `pop`, `unshift`, and `shift` give us the flexibility to treat any array as a stack, queue, or double-ended queue (dequeue).  Here, our `@idx` array acts as a dequeue (`shift` takes off the left end; `pop` takes off the right end), and `@perm` is built up like a stack, using `@push`.