Perl Weekly Challenge 190: Capital Detection and Decoded List
These are some answers to the Week 190 of the Perl Weekly Challenge organized by Mohammad S. Anwar.
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on November, 13, 2022 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
Task 1: Capital Detection
You are given a string with alphabetic characters only: A..Z
and a..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
The easiest here is to use regexes to check whether letters are upper- or lowercase.
Capital Detection in Raku
Raku’s Regexes system has predefined character classes <:Ll>
and <:Lu>
for, respectively, lowercase and uppercase characters. It is pretty easy to combine them to fulfill the task.
sub is-correct-case ($str) {
# All lowercase or all uppercase:
return 1 if $str ~~ /^<:Ll>+$ | ^<:Lu>+$ /;
# One uppercase followed by only lowercase
return 1 if $str ~~ /^<:Lu><:Ll>+$/;
return 0;
}
for < Perl TPF PyThon raku Raku RAKU RaKu raKu > -> $str {
printf "% -8s -> %d\n", $str, is-correct-case $str;
}
This script displays the following output:
$ raku ./capital-detection.raku
Perl -> 1
TPF -> 1
PyThon -> 0
raku -> 1
Raku -> 1
RAKU -> 1
RaKu -> 0
raKu -> 0
Capital Detection in Perl
This is a port to Perl of the above Raku program. In Perl, we use the [a-z]
and [A-Z]
character classes for lowercase and uppercase characters.
use strict;
use warnings;
use feature qw/say/;
sub is_correct_case {
my $str = shift;
# All lowercase or all uppercase:
return 1 if $str =~ /^[a-z]+$|^[A-Z]+$/;
# One uppercase followed by only lowercase
return 1 if $str =~ /^[A-Z][a-z]+$/;
return 0;
}
for my $str (<Perl TPF PyThon raku Raku RAKU RaKu raKu>) {
printf "% -8s -> %d\n", $str, is_correct_case $str;
}
This script displays the following output:
$ perl ./capital-detection.pl
Perl -> 1
TPF -> 1
PyThon -> 0
raku -> 1
Raku -> 1
RAKU -> 1
RaKu -> 0
raKu -> 0
Task 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
Ouput: 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)
One question coming to my mind is what to do with zeros. By itself, a 0 cannot be a letter, so we could simply exclude any integer containing a 0. On the other hand, it can be used as part of numbers 10 (letter J) and 20 (letter T). I’ve decided to disregard 0 as a stand-alone digit, but still to use it as part of a two-digit combination when possible.
Decoded List in Raku
We use the decode
recursive subroutine to build all the possible 1- or 2-digit combinations from the input number. We store the possible strings in the @result
array and sort it at the end for final output. The %map
trans-coding matrix is build using the Z
zip infix operator.
my %map = (1..26 Z 'A'..'Z').flat;
my @result;
# say %map; # {1 => A, 10 => J, 11 => K, 12 => L,...
sub decode (@list, $out) {
if @list.elems == 0 {
push @result, $out;
return;
}
if @list[0] != 0 {
decode @list[1..@list.end], $out ~ %map{@list[0]};
return if @list.elems == 1;
if @list[0] == 1 or (@list[0] == 2 and @list[1] <= 6) {
decode @list[2..@list.end], $out ~ %map{@list[0] ~ @list[1]};
}
}
}
for 11, 1115, 5115, 127, 1207 -> $num {
my @digits = $num.comb;
@result = ();
decode @digits, "";
say "$num \t -> ", join ", ", sort @result;
}
This script displays the following output:
$ raku ./decoded-list.raku
11 -> AA, K
1115 -> AAAE, AAO, AKE, KAE, KO
5115 -> EAAE, EAO, EKE
127 -> ABG, LG
1207 -> ATG
Decoded List in Perl
We use the decode
recursive subroutine to build all the possible 1- or 2-digit combinations from the input number. We store the possible strings in the @result
array and sort it at the end for final output. The %map
trans-coding matrix is build by mapping the 'A'..'Z'
to a counter incremented by 1 at each step.
use strict;
use warnings;
use feature qw/say/;
my @result;
my $i = 1;
my %map = map { $i++ => $_ } 'A'..'Z';
sub decode {
my @list = @{$_[0]};
my $out = $_[1];
push @result, $out and return if scalar @list == 0;
if ($list[0] != 0) {
decode ([@list[1..$#list]], $out . $map{$list[0]});
return if scalar @list == 1;
if ($list[0] == 1 or ($list[0] == 2 and $list[1] <= 6)) {
decode ([@list[2..$#list]], $out . $map{$list[0] . $list[1]});
}
}
}
for my $num (11, 1115, 5115, 127, 1207) {
my @digits = split //, $num;
@result = ();
decode [@digits], "";
say "$num \t -> ", join ", ", @result;
}
This script displays the following output:
$ perl ./decoded-list.pl
11 -> AA, K
1115 -> AAAE, AAO, AKE, KAE, KO
5115 -> EAAE, EAO, EKE
127 -> ABG, LG
1207 -> ATG
Wrapping up
The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on November 20, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.
Leave a comment