Perl Weekly Challenge 190.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 190.
Task 1: Capital Detection
Submitted by: Mohammad S Anwar
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
I guess the solution may be built from a simple comparison to the lower-cased, title-cased and upper-cased version of the same string,
perl -MList::Util=any -E '
for my $s(@ARGV){say "$s -> ", (any {$s eq $_} lc $s, uc $s, ucfirst lc $s)?1:0}
' Perl TPF PyThon raku
Results:
Perl -> 1
TPF -> 1
PyThon -> 0
raku -> 1
The full version is mostly a direct translation:
1 # Perl weekly challenge 190
2 # Task 1: Capital Detection
3 #
4 # See https://wlmb.github.io/2022/11/07/PWC190/#task-1-capital-detection
5 use v5.36;
6 use List::Util qw(any);
7 die <<"EOF" unless @ARGV;
8 Usage: $0 W1 [W2...]
9 to test appropriate case for the words W1, W2,...
10 EOF
11 for my $word(@ARGV){
12 say "$word -> ",
13 (any {$word eq $_} lc $word, uc $word, ucfirst lc $word)
14 ? "appropriate": "inappropriate"}
Example:
./ch-1.pl Perl TPF PyThon raku
Task 2: Decoded List
Submitted by: Mohammad S Anwar
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)
I crammed a solution into a five liner. Maybe too obscure to explain. I’ll better explain it in the full version below.
perl -E '@L=("", "A".."Z");sub i($n){my ($c,$l, @d)=(0, length $n, split "", $n); sub {C:
while($c<2**$l){my @g=@d; my @b=split "", sprintf "%0.${l}b", $c++; my @o; while(@b && @g){
my $d=pop @b; next C if @g<2 && $d==1; splice(@g,-2,2,$g[-2].$g[-1]),next if $d==1;
unshift @o, $m=pop @g if $d==0; next C if $m==0 or $m>=@L;}return @L[@o];}();}}for(@ARGV){
$i=i($_); print "$_ -> "; print @a," " while(@a=$i->()); say "";}' 11 1115 127
Results:
11 -> AA K
1115 -> AAAE AAO AKE KAE KO
127 -> ABG LG
For each coded string of digits I build an iterator to generate all
possible codes. The iterator uses a $counter to count up from 0 up
to some limit (2 raised to the number of digits of the
code is large enough). I interepret each bit in the binary
representation of the counter as an instruction to either (0) output the
corresponding digit or (1) join it to the next digit to make a larger
number. As there are only 27 letters, numbered up from 1, I can skip values of the counter
with consecutive 1’s, or values that yield numbers greater than 27 or
equal to 0.
1 # Perl weekly challenge 190
2 # Task 2: Decoded List
3 #
4 # See https://wlmb.github.io/2022/11/07/PWC190/#task-2-decoded-list
5 use v5.36;
6 use experimental qw(try);
7 die <<"EOF" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to decode the numbers N1, N2...
10 EOF
11 my @letters=("", "A".."Z"); # Base 1 array of ascii letters
12 sub iterator($n){ #Create an iterator for all decodings of the number $n
13 my $counter=0;
14 my $length=length $n; # number of digits
15 my @digits0=split "", $n;
16 sub {
17 COUNTER: while($counter<2**$length){
18 my @digits=@digits0; # copy digits
19 my @bits=split "",
20 my $bits=sprintf "%0.${length}b", $counter++; # convert to binary, advance counter
21 next COUNTER if $bits=~/11/; # Don't stick more than 2 consecutive digits
22 my @output;
23 while(@bits && @digits){
24 my $bit=pop @bits;
25 next COUNTER if @digits<2 && $bit==1; # Not enough digits to join
26 splice(@digits,-2,2,$digits[-2].$digits[-1]),next if $bit==1; # Join last two digits
27 unshift @output, my $m=pop @digits if $bit==0; # or pop last number
28 next COUNTER if $m==0 or $m>=@letters; # Number too large or too small, discard
29 }
30 return @letters[@output]; # Found a decoding. Convert numbers to letters and return them
31 }
32 (); # Didn't find another decoding, return a null list
33 }
34 }
35 for(@ARGV){
36 try {
37 die "Only digits allowed: $_" unless /^\d*$/;
38 die "Empty input" unless /./;
39 my $it=iterator($_);
40 print "$_ -> ";
41 my @decoded;
42 print @decoded," " while(@decoded=$it->()); # Print all possible decodings
43 say "";
44 }
45 catch($m){
46 say "Error: $m";
47 }
48 }
Example:
./ch-2.pl 11 1115 127
Results:
11 -> AA K
1115 -> AAAE AAO AKE KAE KO
127 -> ABG LG
Written on November 7, 2022