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
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);
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{)};
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{)};