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 has wrapped up and the Advent of Code has reached its annual insoluble apex. But the Perl Weekly Challenge is here for a light respite.

Task 1 Equal Pairs

Task Description

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.

    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.

    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:

    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

Task Description

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?

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.

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.