Perl Weekly Challenge: Week 256
Challenge 1:
Maximum Pairs
You are given an array of distinct words,
@words.Write a script to find the maximum pairs in the given array. The words
$words[i]and$words[j]can be a pair one is reverse of the other.
Example 1
Input: @words = ("ab", "de", "ed", "bc")
Output: 1
There is one pair in the given array: "de" and "ed"
Example 2
Input: @words = ("aa", "ba", "cd", "ed")
Output: 0
Example 3
Input: @words = ("uv", "qp", "st", "vu", "mn", "pq")
Output: 2
Rakus' .combinations(2) method as the name suggests gives all 2 element combinations of the command-line arguments. For each
of these pairs, we filter out the ones where the first member is the same as the reversed second member with .grep(). They are
counted with .elems() and the result is printed with .say().
@*ARGS.combinations(2).grep({$_[0] eq $_[1].flip}).elems.say
Perl needed a combinations() function which I took from previous challenges. With that, it was almost as succint as Raku.
say scalar grep { $_->[0] eq reverse $_->[1] } combinations(\@ARGV, 2);
Challenge 2:
Most Frequent Word
You are given two strings,
$str1and$str2.Write a script to merge the given strings by adding in alternative order starting with the first string. If a string is longer than the other then append the remaining at the end.
Example 1
Input: $str1 = "abcd", $str2 = "1234"
Output: "a1b2c3d4"
Example 2
Input: $str1 = "abc", $str2 = "12345"
Output: "a1b2c345"
Example 3
Input: $str1 = "abcde", $str2 = "123"
Output: "a1b2c3de"
I was hoping this could be a very short Raku one-liner. This is what I tried:
($str1.comb Z~ $str2.comb).join.say;
.comb() splits each of the input strings into arrays of characters. The Z operator consecutively makes pairs, one from each array. In combination with the ~ operator, the pairs are joined into two-character strings. .join() joins all these little strings into one big one and finally, .say() prints it out.
Alas this only works for example 1. The problem is if the two arrays are of different lengths, Z~ will stop processing after the
shorter one ends. Which makes sense; at that point there is nothing for the elements of the longer list to pair with. But this is
no good for our problem. So I had to add extra code.
This variable will hold the part of the longer string which is beyond the length of the shorter string.
my $remainder = '';
If the length of $str1 is less than the length of $str2...
if $str1.chars < $str2.chars {
... the remainder becomes the extra characters of $str2 beyond the length of $str1, removed from $str2 with .splice().
Because .splice() is a method of the Array class, $str2 has to be converted with .comb() and .Array() first and then joined
back up into a string.
$remainder = $str2.comb.Array.splice($str1.chars, *).join;
If the length of $str1 is greater than the length of $str2, the same process occurs except the extra characters of $str1 are
removed to form the $remainder.
} elsif $str1.chars > $str2.chars {
$remainder = $str1.comb.Array.splice($str2.chars, *).join;
}
If both strings are the same length, nothing more needs to be done and $remainder can remain empty.
At this point, $str1 and $str2 should both be of the same length with a possible remainder. Now we can rewrite our original
line of code to perform the Z~ operation and append the remainder.
say ($str1.comb Z~ $str2.comb).join ~ $remainder;
For Perl, we need a replacement for Z~. I had already written one for challenge 138 but I took the opportunity to extend it beyond being just a Raku clone.
This function combines the splitting etc. functionality of my Raku solution with Z~.
sub Ztilde {
my @a = split //, $_[0];
my @b = split //, $_[1];
my $remainder = q{};
if (scalar @a < scalar @b) {
$remainder = join q{}, splice @b, scalar @a;
} elsif (scalar @a > scalar @b) {
$remainder = join q{}, splice @a, scalar @b;
}
my @result;
for my $i (0 .. scalar @b - 1) {
push @result, $a[$i], $b[$i];
}
push @result, $remainder;
return join q{}, @result;
}
As a result the main code in my Perl version only is this:
say Ztilde($str1, $str2);