Perl Weekly Challenge: Week 190
Challenge 1:
Capital Detection
You are given a string with alphabetic characters only:
A..Zanda..z.Write a script to find out if the usage of Capital is appropriate if it satisfies at least one of the following rules:
1) Only first letter is capital and all others are small.
2) Every letter is small.
3) Every letter is capital.
Example 1
Input: $s = 'Perl'
Output: 1
Example 2
Input: $s = 'TPF'
Output: 1
Example 3
Input: $s = 'PyThon'
Output: 0
Example 4
Input: $s = 'raku'
Output: 1
I'll start with Perl this week because this is the sort of simple validation script I used to bang out by
the dozens back in the good old days. We basically just test $s against a series of regular expressions and
if it passes them all, print 1 else 0.
say
$s =~ /^ [A-Z] [a-z]* $/x ||
$s =~ /^ [A-Z]* $/x ||
$s =~ /^ [a-z]* $/x
? 1 : 0;
I used the same approach in Raku but then I decided to get clever and redid my solution using a very powerful feature of Raku called grammars. A grammar creates a recursive descent parser for a mini-language you define. Here is my grammar, called Validator for the problem at hand; I'll go through it in reverse order.
We have two types of characters that we're interested in, upper-case letters and lower-case letters. We define them as tokens.
token upper { <[A .. Z]> }
token lower { <[a .. z]> }
Using these tokens, we can define rules that match the three conditions mentioned in the spec.
rule all-upper { <upper>+ }
rule all-lower { <lower>+ }
The rule for condition 1 gave me a small problem. Originally I wrote it like this for readability:
rule capitalized { <upper> <all-lower> }
(as you can see, a rule can include other rules. This prevents redundancy in definitions.) Try as I might, I could not get this rule to match e.g. "Perl". Then on a whim I changed it from a rule to a token, and suddenly it worked. I investigated and it turns out that whitespace is significant in a rule. My rule would have been able to match "P erl" for instance. The docs say to deal with this by changing the meaning of whitespace in your grammar but that sounded complicated. So I took the path of least resistance and just changed my rule to this.
rule capitalized { <upper><all-lower> }
Lastly, (or rather firstly,) the TOP rule says that a valid statement in our mini-language is one that meets one of the rules mentioned above.
rule TOP { <capitalized> | <all-upper> | <all-lower> }
Now we can check if any string is valid like this:
say Validator.parse($s) ?? 1 !! 0;
Challenge 2:
Decoded List
You are given an encoded string consisting of a sequence of numeric characters: 0..9,
$s.Write a script to find the all valid different decodings in sorted order.
Encoding is simply done by mapping A,B,C,D,… to 1,2,3,4,… etc.
Example 1
Input: $s = 11
Output: AA, K
11 can be decoded as (1 1) or (11) i.e. AA or K
Example 2
Input: $s = 1115
Output: AAAE, AAO, AKE, KAE, KO
Possible decoded data are:
(1 1 1 5) => (AAAE)
(1 1 15) => (AAO)
(1 11 5) => (AKE)
(11 1 5) => (KAE)
(11 15) => (KO)
Example 3
Input: $s = 127
Output: ABG, LG
Possible decoded data are:
(1 2 7) => (ABG)
(12 7) => (LG)
I'm still not 100% sure I understand the spec correctly but I am assuming it means a possible list can be a combination of single digits or double digits between 1 to 26. So this is my Raku solution:
First a list to hold the combinations.
my @combos;
The first combination consists of all the single digits.
@combos.push($s.comb);
The second combination consists of pairs of digits. If the length of $ is odd, the extra
digit will also get added.
@combos.push($s.comb(2));
Now this was the hard part; you can also have a combination with one double digit and seversl single digit elements.
I have a feeling there is a simpler way to do this in Raku but I couldn't figure it out. This may be a little long-winded
it works. I split the string into a list of digits. From the beginning of the list upto the element before the last, I take two elements, remove them from the list, join them together and add this new combined element back into the list at the position of the
old ones. The list is added to @combos.
for 0 ..^ $s.chars - 1 -> $n {
my @chars = $s.comb;
@chars.splice($n, 2, @chars[$n,$n + 1].join);
@combos.push(@chars);
}
Now we have all the combinations, we can encode them. But it is a little more complex than just processing the list
in @combinations. There is the possibility of duplicates. I dealt with this by the standard method of assigning each
result to a hash key.
my %results;
for @combos -> $combo {
Another thing we have to do is remove any combination with a a value that is not between 1 and 26.
unless @$combo.grep({ $_ < 1 || $_ > 26 }).elems {
If the criteria are met we can finally encode the combination, join it back into a string and add it to %results.
%results{$combo.map({ ('A' .. 'Z')[$_ -1] }).join}++;
}
}
The keys of %results are as I mentioned, unique encoded combinations. We sort them in alphabetic order and then print them
separated by commas.
%results.keys.sort.join(q{, }).say;
This is the Perl version.
my @combos;
push @combos, [ split //, $s ];
Most of it was easily translated from Raku but I had problems with an equivalent for .comb(2).
If the length of $s is odd, I push two combinations. One is a single digit followed by pairs of digits and the second
is pairs of digits followed by a single digit.
if ((length $s) % 2) {
push @combos, [ $s =~ /(.) ([0-9]{2})+ /gx ];
push @combos, [ $s =~ /([0-9]{2})+ (.) /gx ];
If the length of $s is even, I just push a list of pairs of digits.
} else {
push @combos, [ $s =~ /([0-9]{2})/g ];
}
for my $n (0 .. (length $s) - 2) {
my @chars = split //, $s;
The splice() that took one line in Raku had to be split into two lines in Perl.
my $long = join q{}, @chars[$n, $n + 1];
splice @chars, $n, 2, $long;
push @combos, \@chars;
}
my %results;
for my $combo (@combos) {
unless ( scalar grep { $_ < 1 || $_ > 26 } @{$combo}) {
$results{ join q{}, map { ('A' .. 'Z')[$_ -1] } @{$combo} }++;
}
}
say join q{, }, sort keys %results;