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

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.