Perl Weekly Challenge: Week 249

Challenge 1:

Equal Pairs

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)

There are 6 elements in @ints.
They should be divided into 6 / 2 = 3 pairs.
@ints is divided into the pairs (2, 2), (3, 3), and (2, 2) satisfying all the conditions.
Example 2
Input: @ints = (1, 2, 3, 4)
Output: ()

There is no way to divide @ints into 2 pairs such that the pairs satisfy every condition.

It occurred to me that the spec requires that the array consists of an even amount of each number.

So the first step is to count how many of each integer we have. The .classify() method handily sorts a list into a hash (defined in the method itself) where the keys are elements and the value the occurrences of that element in the list.

@ints.classify({ $_ }, :into(my %elements;) );

If all the values in our hash are even...

if all %elements.values.map({ @$_.elems % 2 == 0 }) {

    %elements.values

...We can split each value into pairs of elements with .batch(2)

        .map({| @$_.batch(2) })

The rest of the code is for pretty-printing these pairs for output.

        .map({ q{(} ~ @$_.join(q{, }) ~ q{)} })
        .join(q{, })
        .say;

If however at least one value was not even, we just output empty parentheses.

} else {
    say '()';
}

(Full code on Github.)

Perl doesn't have .classify, all and .batch() so we're going to have to structure the Perl solution a little differently.

We have to create the %elements hash by hand. Unlike in Raku, the values of our hash will be the count of occurrences of a particular integer, not the elements themselves. It's all we really need anyway.

my %elements;
for my $int (@ints) {
    $elements{$int}++;
}

A list is created to store the output.

my @output;

As we traverse through the hash...

for my $k (keys %elements) {

...if we find a key with an odd value, we immediately output empty parentheses and bail out.

    if (scalar $elements{$k} % 2 == 1) {
        say '()';
        exit;
    }

If the key has an even value, we divide the value by two and make that many arrays (Perl require array references actually) consisting of two instances of the key and add them to @output.

    for (0 .. $elements{$k} / 2 - 1) {
        push @output, [ $k, $k ];
    }
}

Finally we print out @output nicely just as we did for Raku.

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

(Full code on Github.)

Challenge 2:

DI String Match

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)

First, $str is split up into a list of characters with .comb().

my @chars = $str.comb;

The numbers we will be using for the output are defined next.

my @numbers = 0 .. $str.chars;

And the array which will hold the output too.

my @s;

Now we go through the list of characters.

for @chars -> $c {

If it is a D, we take a number off the right end of @numbers with .pop() and add it to the output.

    if $c eq 'D' {
        @s.push(@numbers.pop);
    }

If it is an I, we take a number off the left end of @numbers with .shift() and add it to the output.

    if $c eq 'I' {
        @s.push(@numbers.shift);
    }
}

After all the characters have been looked at, there will be one number left in @numbers. We just add it to the end of the output.

@s.push(@numbers.shift);

Then we print the output out in the style suggested by the examples.

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

(Full code on Github.)

Nothing much to say about the Perl version. It is a straightforward translation of the Raku code.

my @chars = split //, $str;
my @numbers = 0 .. length $str;
my @s;

for my $c (@chars) {
    if ($c eq 'D') {
        push @s, pop @numbers;
    }
    if ($c eq 'I') {
        push @s, shift @numbers;
    }
}
push @s, shift @numbers;

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

(Full code on Github.)