Perl Weekly Challenge: Week 308

Challenge 1:

Count Common

You are given two array of strings, @str1 and @str2.

Write a script to return the count of common strings in both arrays.

Example 1
Input: @str1 = ("perl", "weekly", "challenge")
       @str2 = ("raku", "weekly", "challenge")
Output: 2
Example 2
Input: @str1 = ("perl", "raku", "python")
       @str2 = ("python", "java")
Output: 1
Example 3
Input: @str1 = ("guest", "contribution")
       @str2 = ("fun", "weekly", "challenge")
Output: 0

This challenge gives us the opportunity for another Raku one-liner.

(@*ARGS[0].words ∩ @*ARGS[1].words).elems.say

(Full code on Github.)

I chose to represent the input as two command line argument where each argument is a string consisting of words seperated by spaces. So for example, the input to example 2 would be "perl rsku python" "python java"

We split up the input back into two lists of words with .words(). and find the words which are common to both lists with the or intersection operator. We count the result with .elems() and print it with .say().

For Perl we have to provide our own intersection() function but I already had this from previous challenges. Other than that, it works the same way as Raku.

my @str1 = split /\s+/, shift;
my @str2 = split /\s+/, shift;

say scalar intersection(\@str1, \@str2);

(Full code on Github.)

Challenge 2:

Decode XOR

You are given an encoded array and an initial integer.

Write a script to find the original array that produced the given encoded array. It was encoded such that encoded[i] = orig[i] XOR orig[i + 1].

Example 1
Input: @encoded = (1, 2, 3), $initial = 1
Output: (1, 0, 2, 1)

Encoded array created like below, if the original array was (1, 0, 2, 1)
$encoded[0] = (1 xor 0) = 1
$encoded[1] = (0 xor 2) = 2
$encoded[2] = (2 xor 1) = 3
Example 2
Input: @encoded = (6, 2, 7, 3), $initial = 4
Output: (4, 2, 0, 7, 4)

The key to solving this challenge is to realize that if you XOR two numbers and then XOR the result with one, you get the other back again.

We start by creating storage to hold the decoded digits. It has one element at first, $initial.

my @decoded = ($initial);

The reason for the previous line is that in the encoding code shown in the spec, each element is XORed with the element succeeding it. So to decode, we have to XOR an element with the one preceding it.

So in the loop below, we iterate through each element in @encoded and XOR it with the last element in @decoded. The result is appended to the end of @decoded so it will be the last element for the next round of the loop.

for @encoded -> $n {
    @decoded.push($n +^ @decoded[*-1]);
}

When we have decoded all the elements, we print them out. The rest of the code is just so the output will be formatted in the style of the spec.

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

(Full code on Github.)

Modulo syntax differences, the Perl version is exactly the same as Raku.

my @decoded = ($initial);

for my $n (@encoded) {
    push @decoded, $n ^ $decoded[-1];
}

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

(Full code on Github.)