Perl Weekly Challenge: Week 221

Challenge 1:

Good Strings

You are given a list of @words and a string $chars.

A string is good if it can be formed by characters from $chars, each character can be used only once.

Write a script to return the sum of lengths of all good strings in words.

Example 1
Input: @words = ("cat", "bt", "hat", "tree")
    $chars = "atach"
Output: 6

The good strings that can be formed are "cat" and "hat" so the answer is 3 + 3 = 6.
Example 2
Input: @words = ("hello", "world", "challenge")
    $chars = "welldonehopper"
Output: 10

The strings that can be formed are "hello" and "world" so the answer is 5 + 5 = 10.

This could possibly have been a one-liner in Raku but it would be a rather long line which goes against the one-liner ethos in my opinion. So my solution is two lines long and I've spread the second line out even more to make it more readable.

I assume the input will be taken from command-line arguments. The first argument is $chars and the rest will become @words.

First we split $chars into an array of individual characters.

my @chars = $chars.comb;

Then for each word...

@words

...we split it also into an array of individual characters.

    .map({ $_.comb })

We check that this array is a subset or equal to @chars using the subset or equal operator . If it is, this word is a good string.

    .grep({ @$_ ⊆ @chars })

We count the number of characters in each good string we found...

    .map({ @$_.elems })

...add all the counts together...

    .sum

...and print the result.

    .say;

(Full code on Github.)

For Perl we have to add missing functionality as usual. This time it is replacements for and .sum() we need. Also as usual, I have already written those replacements in previous weeks challenges. With them, the Perl version looks like this:

my @chars = split //, shift @ARGV;

say sum([
    map { scalar @{$_} }
    grep { isSubset($_, \@chars) }
    map { [ split //, $_ ] }
    @words
]);

(Full code on Github.)

Challenge 2:

Arithmetic Subsequence

You are given an array of integers, @ints.

Write a script to find the length of the longest Arithmetic Subsequence in the given array.

A subsequence is an array that can be derived from another array by deleting some or none elements without changing the order of the remaining elements.

A subsquence is arithmetic if ints[i + 1] - ints[i] are all the same value (for 0 <= i < ints.length - 1).

Example 1
Input: @ints = (9, 4, 7, 2, 10)
Output: 3

The longest Arithmetic Subsequence (4, 7, 10) can be derived by deleting 9 and 2.
Example 2
Input: @ints = (3, 6, 9, 12)
Output: 4

No need to remove any elements, it is already an Arithmetic Subsequence.
Example 3
Input: @ints = (20, 1, 15, 3, 10, 5, 8)
Output: 4

The longest Arithmetic Subsequence (20, 15, 10, 5) can be derived by deleting 1, 3 and 8.

I began my Raku solution by defining a variable to hold the result i.e. the length of the longest arithmetic subsequence.

my $longest = 0;

The spec mentions possibly removing elements from @ints in order to find arithmetic subsequences but a more straightforward way is to test combinations of elements from the array for the desired property. This is easily done in Raku with the .combinations() method. We find all combinations of elements from 3 to the entirity of @ints. Why 3? Obviously a single element cannot be considered a sequence. 2-length sequences will all automatically be considered arithmetic subsequences (as there is only 1 comparison of elements) so that's not interesting. 3 is the minimum number of elements we can look at to determine if a sequence is arithmetic.

COMBINATION is a label. It's use will be explained shortly.

COMBINATION: for @ints.combinations(3 .. @ints.elems) -> $combo {

For each combination, we look at the first two elements. The difference between them is stored in the variable $delta.

    my $delta = @$combo[1] - @$combo[0];

Now for every succeeding pair of elements in the combination, we check if the difference is equal to $delta. If it isn't, this is not an arithmetic subsequence so we can abandon it and move on to the next combination. Because this is a nested for loop, a plain next statement won't do; we have to jump to the outer one on the line marked by the label COMBINATION.

    for 2 .. @$combo.end -> $i {
        if @$combo[$i] - @$combo[$i - 1] != $delta {
            next COMBINATION;
        }
    } 

If we have gotten this far, the combination is an arithmetic subsequence so we measure its' length and if it is longer than the current value of $longest, it becomes the new value of $longest.

    if @$combo.elems > $longest {
        $longest = @$combo.elems;
    }

Now we can try the next combination.

}

By now we will have tried all possible combinations. All that remains is to print out the current value of $longest.

say $longest;

(Full code on Github.)

This is my Perl version. It uses a function combinations() I have used in previous challenges.

my $longest = 0;

Because combinations() can't take a range like in Raku, I needed an extra for loop to deal with all the possible lengths of combinations.

for my $n (3 .. scalar @ints) {
    COMBINATION: for my $combo (combinations(\@ints, $n)) {
        my $delta = $combo->[1] - $combo->[0];

        for my $i (2 .. scalar @{$combo} - 1) {
            if ($combo->[$i] - $combo->[$i - 1] != $delta) {
                next COMBINATION;
            }
        } 

        if (scalar @{$combo} > $longest) {
            $longest = scalar @$combo;
        }
    }
}

say $longest;

(Full code on Github.)