This is my response to The Weekly Challenge #313.
Input: $name = "perl", $typed = "perrrl"
Output: true
Here "r" is pressed 3 times instead of 1 time.
Input: $name = "raku", $typed = "rrakuuuu"
Output: true
Input: $name = "python", $typed = "perl"
Output: false
Input: $name = "coffeescript", $typed = "cofffeescccript"
Output: true
I have chosen to use the variable names $in for the
input, and $out for whatever the typewriter chooses to print.
#! /usr/bin/env raku
unit sub MAIN (:i(:$in) where $in.chars > 0, # [1]
:o(:$out) where $out.chars > 0, # [2]
:v(:$verbose));
sub grouped ($str) # [3]
{
my @parts = gather # [4]
{
my $curr; # [5]
my $count = 0; # [6]
for $str.comb -> $char # [7]
{
if $count && $curr ne $char # [8]
{
take $curr x $count; # [9]
$count = 0; # [10]
}
$curr = $char; # [11]
$count++; # [12]
}
take $curr x $count; # [13]
}
say ": Grouped '$str' as { @parts.raku }" if $verbose;
return @parts; # [14]
}
my @in = grouped($in); # [15]
my @out = grouped($out); # [16]
my @combined = roundrobin(@in, @out); # [17]
say ": Zipped: {@combined.raku }" if $verbose;
my $status = True; # [18]
for @combined -> @pair # [19]
{
if @pair.elems == 1 # [20]
{
$status = False; # [20a]
say ": Trailing character: { @pair.flat }" if $verbose;
last; # [20b]
}
if @pair[0].substr(0,1) ne @pair[1].substr(0,1) # [21]
{
$status = False; # [21a]
say ": Different starting characters: { @pair[0].substr(0,1) } \
<> { @pair[1].substr(0,1) }" if $verbose;
last; # [21b]
}
if @pair[0].chars > @pair[1].chars # [22]
{
$status = False; # [22a]
say ": Not enough '{ @pair[0].substr(0,1) }' characters. Got \
{ @pair[1].chars } requires { @pair[0].chars } " if $verbose;
last; # [22b]
}
say ": Ok ('{ @pair[0] }' vs '{ @pair[1] }')" if $verbose;
}
say $status; # [23]
[1] The input.
[2] The (possibly legal) output.
[3] The procedure splitting the string into chunks of identical characters. We will use this to compare the chunks of the input and output one by one later on.
[4] This task is eminently suitable for
gather/take. We start here by collecting (or gathering,
to be pedantic) the values delivered (or taken, again pedantic) in
[9] and [13]. This is kind of like putting a glass under a leaking
faucet to cellect it all.
See my Raku Gather, I Take article or docs.raku.org/language/control#gather/take for more information about gather/take.
[5] The current character, initially none.
[6] The number of times we have encountered that character, also none initially.
[7] Iterate over each character, courtesy of comb on
the string.
See docs.raku.org/routine/comb for more information about comb.
[8] The same character as the previous one? Note the check on $count
to avoid setting it off on the very first character.
[9] Not the same character? Then return (with take) the
character repeated as many times as it occured in the original string
in this sequence. Note the use of the string repetition operator
x to get the correct length.
See docs.raku.org/routine/x for more information about x.
[10] Reset the number of times.
[11] Set the current character to the new one (or the same).
[12] Add the character to the count.
[13] Handle the last sequence of a character.
[14] Return the result.
[15] Split the input string,
[16] and the output string.
[17] Combine the two arrays with roundrobin, a zip
operator that allows for either array to be shorter than the other without
failing. The result is an array consisting of subarrays with two elements
each, one from the input array and one from the output array.
See docs.raku.org/routine/roundrobin for more information about roundrobin.
[18] We assume that this will work out, thus True. Falsification is
the name of the game. Or: failure to falsify means success.
[19] Iterate over the array, giving us the subarrays - one at a time.
[20] If the current subarray has one element only, regardless of which
one of them (input or output) that is missing, we certainly do not have a
matching pair of letters. Set the status to False [20a] and exit
the loop (with last) [20b].
[21] If the first characters differ, we have falsification.
[22] We have the same first character, courtesy of [21]. Now we check that the output has enough of them to match the input (i.e. the same number or more).
[23] Return the status.
The [20-22] parts could have been written as a single if
condition, if (pun intended) we had skipped the verbose output.
Running it:
$ ./broken-keys -i=perl -o=perrrl
True
3$ ./broken-keys -i=raku -o=rrakuuuu
True
$ ./broken-keys -i=python -o=perl
False
$ ./broken-keys -i=coffeescript -o=cofffeescccript
True
Looking good.
With verbose mode:
$ ./broken-keys -v -i=perl -o=perrrl
: Grouped 'perl' as ["p", "e", "r", "l"]
: Grouped 'perrrl' as ["p", "e", "rrr", "l"]
: Zipped: [("p", "p"), ("e", "e"), ("r", "rrr"), ("l", "l")]
: Ok ('p' vs 'p')
: Ok ('e' vs 'e')
: Ok ('r' vs 'rrr')
: Ok ('l' vs 'l')
True
$ ./broken-keys -v -i=raku -o=rrakuuuu
: Grouped 'raku' as ["r", "a", "k", "u"]
: Grouped 'rrakuuuu' as ["rr", "a", "k", "uuuu"]
: Zipped: [("r", "rr"), ("a", "a"), ("k", "k"), ("u", "uuuu")]
: Ok ('r' vs 'rr')
: Ok ('a' vs 'a')
: Ok ('k' vs 'k')
: Ok ('u' vs 'uuuu')
True
$ ./broken-keys -v -i=python -o=perl
: Grouped 'python' as ["p", "y", "t", "h", "o", "n"]
: Grouped 'perl' as ["p", "e", "r", "l"]
: Zipped: [("p", "p"), ("y", "e"), ("t", "r"), ("h", "l"), ("o",), ("n",)]
: Ok ('p' vs 'p')
: Different starting characters: y <> e
False
$ ./broken-keys -v -i=coffeescript -o=cofffeescccript
: Grouped 'coffeescript' as ["c", "o", "ff", "ee", "s", "c", "r", "i", "p", \
"t"]
: Grouped 'cofffeescccript' as ["c", "o", "fff", "ee", "s", "ccc", "r", \
"i", "p", "t"]
: Zipped: [("c", "c"), ("o", "o"), ("ff", "fff"), ("ee", "ee"), ("s", "s"), \
("c", "ccc"), ("r", "r"), ("i", "i"), ("p", "p"), ("t", "t")]
: Ok ('c' vs 'c')
: Ok ('o' vs 'o')
: Ok ('ff' vs 'fff')
: Ok ('ee' vs 'ee')
: Ok ('s' vs 's')
: Ok ('c' vs 'ccc')
: Ok ('r' vs 'r')
: Ok ('i' vs 'i')
: Ok ('p' vs 'p')
: Ok ('t' vs 't')
True
Input: $str = "p-er?l"
Output: "l-re?p"
Input: $str = "wee-k!L-y"
Output: "yLk-e!e-w"
Input: $str = "_c-!h_all-en!g_e"
Output: "_e-!g_nel-la!h_c"
File: reverse-letters
#! /usr/bin/env raku
unit sub MAIN ($str where $str.chars > 0, # [1]
:v(:$verbose));
my @str = $str.comb; # [2]
my @letters = @str.grep( /<:L>/ ); # [3]
if $verbose
{
say ": Letters: { @letters.join(",") }";
say ": Reverse: { @letters.reverse.join(",") }";
}
@str.map({ /<:L>/ ?? @letters.pop !! $_ }).join.say; # [4]
[1] Ensure at least one character in the string.
[2] Split the string into a list of separate characters with comb.
[3] An array with the letters only, courtesy of grep
and the Unicode letter character class <:L>.
See docs.raku.org/language/regexes for more information about Rexeces and the different character classes available.
[4]
Apply map to map (or translate) each character to
either a letter (from the end of the letters set up in [3]
with pop) or itself, using a ternary ??!!. Then
we join the characters into a single string and print it.
See
docs.raku.org/language/operators#index-entry-operator_ternary for more
information about the ternary operator ?? / !!.
Running it, using single quotes to protect the string from shell interference:
$ ./reverse-letters 'p-er?l'
l-re?p
$ ./reverse-letters 'wee-k!L-y'
yLk-e!e-w
$ ./reverse-letters '_c-!h_all-en!g_e'
_e-!g_nel-la!h_c
Looking good.
With verbose mode:
$ ./reverse-letters -v 'p-er?l'
: Letters: p,e,r,l
: Reverse: l,r,e,p
l-re?p
$ ./reverse-letters -v 'wee-k!L-y'
: Letters: w,e,e,k,L,y
: Reverse: y,L,k,e,e,w
yLk-e!e-w
$ ./reverse-letters -v '_c-!h_all-en!g_e'
: Letters: c,h,a,l,l,e,n,g,e
: Reverse: e,g,n,e,l,l,a,h,c
_e-!g_nel-la!h_c
And that's it.