Perl Weekly Challenge: Week 392
Challenge 1:
Convert Palindrome
You are given a string.
Write a script to convert the given string to palindrome by adding characters in front of it.
Example 1
Input: $str = "pinnipeds"
Output: "sdepinnipeds"
Example 2
Input: $str = "abcd"
Output: "dcbabcd"
Example 3
Input: $str = "bananas"
Output: "sananabananas"
Example 4
Input: $str = "dissident"
Output: "tnedissident"
Example 5
Input: $str = "cailliachs"
Output: "shcailliachs"
Because a scripts arguments are immutable in Raku, we first have to copy $str
into another string we can modify if needed.
my $palindrome = $str;
We also need to keep track of how many characters we are taking from the end and adding to the beginning of the string. Initially, it will be one.
my $len = 1;
In a loop we check if $palindrome is in fact a palindrome by comparing it to a
reversed (or .flip()ped) version of itself. If it is not a palindrome...
while $palindrome ne $palindrome.flip {
We take $len number of characters from the end of $str and prepend them
to its' front. This is the new value of $palindrome. We also increment $len
then continue the loop.
$palindrome = $str.substr(*-($len), $len).flip ~ $str;
$len++;
}
Eventually, we will end up with a palindrome and we can print it out.
say $palindrome;
The Perl version is the same as Raku.
my $palindrome = $str;
my $len = 1;
while ($palindrome ne reverse $palindrome) {
$palindrome = reverse(substr($str, -($len), $len)) . $str;
$len++;
}
say $palindrome;
Challenge 2:
Words Length Product
You are given an array of strings.
Write a script to return the maximum value of
len($words[i]) * len($words[j])where the two words do not share common letters. If no such two words exist, return0.
Example 1
Input: @words = ("a", "ab", "abc", "d", "de", "def")
Output: 9
Two words are "abc" and "def".
Example 2
Input: @words = ("a", "aa", "aaa", "aaaa")
Output: 0
Since no two words can be chosen without sharing letters, the result is 0.
Example 3
Input: @words = ("meet", "app", "code", "sky", "bold")
Output: 16
Two words are "meet" and "bold".
Example 4
Input: @words = ("a", "ab", "abc", "abcd", "efghi")
Output: 20
Two words are "abcd" and "efghi".
Example 5
Input: @words = ("xyz", "w", "abcdefg", "hij")
Output: 21
Two words are "abcdefg" and "hij".
The input is read from the command-line arguments where each argument is one word.
First we define storage for the maximum (i.e. longest) length. It is initialized to 0.
my $longest = 0;
Then in a double loop, we compare every word in the array starting from the second (index 1) to the word before it thereby ensuring all combinations of words are examined. (Actually in hindsight, I could have used the .combinations() method
for this.)
for 1 .. @words.end -> $i {
for 0 ..^ $i -> $j {
we split both words into lists of individual characters with .comb() and find
the intersection of the two lists with the ∩ operator. This results in a set
of characters which are found in both lists. If that Set should be empty...
if (@words[$i].comb ∩ @words[$j].comb).elems == 0 {
...we can multiply the length of both words as told in the spec.
my $len = @words[$i].chars * @words[$j].chars;
If this value is larger than the current value of $longest, it becomes the new $longest.
if $len > $longest {
$longest = $len;
}
}
}
}
Finally we print $longest. If no pair of dissimilar words had been found,
the value of $longest would still be 0 which fulfills the other stipulation
in the spec.
say $longest;
For Perl, we need a substitute intersection() function which, fortunately, I
already had. With this, the Perl version becomes just the same as Raku.
my $longest = 0;
for my $i (1 .. scalar @words - 1) {
for my $j (0 .. $i - 1) {
if (scalar intersection([split //, $words[$i]], [split //, $words[$j]]) == 0) {
my $len = length($words[$i]) * length($words[$j]);
if ($len > $longest) {
$longest = $len;
}
}
}
}
say $longest;