Perl Weekly Challenge: Week 377
Challenge 1:
Reverse Existence
You are given a string.
Write a script to find whether any substring of length 2 is also present in the reverse of the given string.
Example 1
Input: $str = "abcba"
Output: true
Reverse of given string is "abcba".
The substring "ab" in original string is also present in the reverse string too.
Example 2
Input: $str = "racecar"
Output: true
The substring "ce" is present in both.
Example 3
Input: $str = "abcd"
Output: false
Example 4
Input: $str = "banana"
Output: true
The substring "an" is present in both.
Example 5
Input: $str = "hello"
Output: true
The substring "ll" is present in both.
I solved this challenge by creating two SetHashes. This is a Raku data structure
which holds a collection of objects. Unlike a Set which is immutable so you have to
load it's contents up front, you csn add elements to a SetHash at any time.
I'm bad at naming things but $strsubs is supposed to be the set of substrings of
$str and $revsubs is the set of substrings of $str reversed.
my $strsubs = SetHash.new;
my $revsubs = SetHash.new;
In a loop...
for 0 ..^ $str.chars - 1 -> $i {
We create each two character substring.
my $sub = $str.substr($i, 2);
The substring is added to $strsubs.
$strsubs.set($sub);
Originally, I was going to create a string, $reverse which is the reverse of $str
and then in a separate loop, create two character substrings of that and add them to
$revsubs but actually that's more work than necessary. We can simply reverse the
substrings we already have (with .flip()) and get the same result.
$revsubs.set($sub.flip);
}
The point of adding all those substrings to SetHashes is that we can now use
the intersection operator ∩ to easily get the elements both $strsubs and $revsubs
have in common. We count the results with .elems() convert the count to a boolean with
.so() (i.e. False if there were 0 substrings in common or True if there were one
or more) and print that with .say().
($strsubs ∩ $revsubs).elems.so.say;
Perl does not have a ∩ operator but I had a replacement function available from previous
challenges. intersection() operates on two array references so my Perl versions of
$strsubs and $revsubs are arrays.
my @strsubs;
my @revsubs;
for my $i (0 .. (length $str) - 2) {
my $sub = substr $str, $i, 2;
push @strsubs, $sub;
Also a little gotcha I ran into; reverse() normally reverses the order of a list.
By itself, it will assume $sub is a one-element list and seemingly do nothing. To
get the desired behavior, you have to force it into scalar context with scalar().
push @revsubs, scalar reverse $sub;
}
say scalar intersection(\@strsubs, \@revsubs) ? 'true' : 'false';
Challenge 2:
Prefix Suffix
You are given an array of strings.
Write a script to find if the two strings (str1, str2) in the given array such that str1 is prefix and suffix of str2. Return the total count of such pairs.
Example 1
Input: @array = ("a", "aba", "ababa", "aa")
Output: 4
$array[0], $array[1]: "a" is a prefix and suffix of "aba"
$array[0], $array[2]: "a" is a prefix and suffix of "ababa"
$array[0], $array[3]: "a" is a prefix and suffix of "aa"
$array[1], $array[2]: "aba" is a prefix and suffix of "ababa"
Example 2
Input: @array = ("pa", "papa", "ma", "mama")
Output: 2
$array[0], $array[1]: "pa" is a prefix and suffix of "papa"
$array[2], $array[3]: "ma" is a prefix and suffix of "mama"
Example 3
Input: @array = ("abao", "ab")
Output: 0
Example 4
Input: @array = ("abab", "abab")
Output: 1
$array[0], $array[1]: "abab" is a prefix and suffix of "abab"
Example 5
Input: @array = ("ab", "abab", "ababab")
Output: 3
$array[0], $array[1]: "ab" is a prefix and suffix of "abab"
$array[0], $array[2]: "ab" is a prefix and suffix of "ababab"
$array[1], $array[2]: "abab" is a prefix and suffix of "ababab"
Example 6
Input: @array = ("abc", "def", "ghij")
Output: 0
First we create a variable to hold the count of matched pairs.
my $count = 0;
Next we use a double-loop to compare all the strings with each other two by two.
for 0 ..^ @array.end -> $i {
for $i + 1 .. @array.end -> $j {
The Raku Str class has handy methods called .starts-with() and .ends-with()
which do exactly what we need to compaare two strings. We use them to see if the
first string is both a prefix and suffix of the scecond and if this is true, we
increment $count.
if @array[$j].starts-with(@array[$i]) && @array[$j].ends-with(@array[$i]) {
$count++;
}
}
}
After all pairs of strings have been compared, we print $count.
say $count;
The Perl version follows the same algorithm.
my $count = 0;
for my $i (0 .. scalar @array - 1) {
for my $j ($i + 1 .. scalar @array - 1) {
We don't have .starts-with() and .ends-with() like in Raku but we can use
a regular expression to achieve the same thing.
if ($array[$j] =~ /(?= ^$array[$i]) .* (?= $array[$i]$)/x) {
$count++;
}
}
}
say $count;