Perl Weekly Challenge: Week 313
Challenge 1:
Broken Keys
You have a broken keyboard which sometimes type a character more than once.
You are given a string and actual typed string.
Write a script to find out if the actual typed string is meant for the given string.
Example 1
Input: $name = "perl", $typed = "perrrl"
Output: true
Here "r" is pressed 3 times instead of 1 time.
Example 2
Input: $name = "raku", $typed = "rrakuuuu"
Output: true
Example 3
Input: $name = "python", $typed = "perl"
Output: false
Example 4
I have a sneaking suspicion that this is not the ideal way to solve this challenge but it seems to work.
I implemented the Perl solution first so I shall begin with that. As an initiial step we need to break up
each of the input strings into runs of the same character In Example 1 for instance, $name would become ('p', 'e', 'r', 'l')
whereas $typed would become ('p', 'e', 'rrr', 'l' ). To avoid code duplication, I split this out into a function.
sub breakup($str) {
I'll skip over this line for now.
my $i = 0;
Going from right to left, we first have a regular expression that looks for all groups of a character followed by 0 or more instances of the same character. Unfortunately due to the global nature of Perl's capture groups, what we get for e.g. $typed in
example 1 is ('p', 'p', 'e', 'e' 'rrr', 'r', 'l', 'l') It is only the even-indexed elements that we are interested in. Perhaps
some cleverer regex tricks could have surpressed the extras but I was unable to think of any. Anyway, the correct elements can be
extracted with grep() and that's why we needed to have the previous line, $i acts as the running index of the array,
return grep { $_ if $i++ % 2 == 0 } ($str =~ /((.)\2*)/g);
}
Back to MAIN(), we use breakup() on our two input strings:
my @nameParts = breakup($name);
my @typedParts = breakup($typed);
We also create a variable to hold the result and initialize it to true. (Once again, we are using the new, experimental builtin true and false values in modern varieties of Perl.)
my $result = true;
Now we compare the elements of @nameParts and @typedParts pairwise, and if the element from @nameParts fails to match
the corresponding element from @typedParts, we set the $result to false and stop comparison. Otherwise we continue to the
next pair.
for my $i (0 .. scalar @nameParts - 1) {
unless ($typedParts[$i] =~ /$nameParts[$i]/) {
$result = false;
last;
}
}
Finally we print the result. As true and false are not fully implemented yet (or atleast not in my version of Perl) we have'
to explicitly print true or false ourselves.
say $result ? "true" : "false";
Input: $name = "coffeescript", $typed = "cofffeescccript"
Output: true
The Raku version is the same length in lines but has some features that make the code simpler and easier to understand.
sub breakup($str) {
Raku has nested capture groups so we can dispense with grep().
return $str.match(/( (.) $0* )/, :g).List;
}
my @nameParts = breakup($name);
my @typedParts = breakup($typed);
my $result = True;
Raku's Z operator makes "zipping" two arrays easy.
for @typedParts Z @nameParts -> ($t, $n) {
unless $t.match(/$n/) {
$result = False;
last;
}
}
Raku has print support for Booleans.
say $result;
Challenge 2:
Reverse Letters
You are given a string.
Write a script to reverse only the alphabetic characters in the string.
Example 1
Input: $str = "p-er?l"
Output: "l-re?p"
Example 2
Input: $str = "wee-k!L-y"
Output: "yLk-e!e-w"
Example 3
Input: $str = "_c-!h_all-en!g_e"
Output: "_e-!g_nel-la!h_c"
First we make an array of reversed chaaracters by splitting $str into characters with .comb(), finding the
alphabetic characters with .grep() and then reversing it with .reverse().
my @reversed = $str.comb.grep({ /<alpha>/ }).reverse;
We will also need to keep track of the current index in that array.
my $index = 0;
Now we can just .subst()itute any alphabetic character in $str with its' equivalent in @reversed. Finally, we
print the result with .say().
($str.subst(/<alpha>/, { @reversed[$index++] }, :g)).say;
The Perl version is slightly more verbose but works the same way.
my @reversed = reverse grep { /[[:alpha:]]/ } split //, $str;
my $index = 0;
$str =~ s/[[:alpha:]]/$reversed[$index++]/g;
say $str;