RabbitFarm

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

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 rules.

Solution

use v5.36;
use strict;
use warnings;

use boolean;

sub capital_detection{
    {my($s) = @_; return true if length($s) == $s =~ tr/A-Z//d;}
    {my($s) = @_; return true if length($s) == $s =~ tr/a-z//d;}
    {
        my($s) = @_; 
        $s =~ m/(^.{1})(.*)$/;
        my $first_letter = $1;
        my $rest_letters = $2;
        return true if $first_letter =~ tr/A-Z//d == 1 &&
                       length($rest_letters) == $rest_letters =~ tr/a-z//d;
    }
    return false;
}

MAIN:{
    say capital_detection(q/Perl/);
    say capital_detection(q/TPF/);
    say capital_detection(q/PyThon/);
    say capital_detection(q/raku/);
}

Sample Run

$ perl perl/ch-1.pl
1
1
0
1

Notes

The rules to be satisfied are:

1) Only first letter is capital and all others are small.

2) Every letter is small.

3) Every letter is capital.

I did a bit of experimenting with tr this week. Somewhat relatedly I also reminded myself of scope issues in Perl.

The tr function has a nice feature where it returns the number of characters changed, or as was the case here, deleted. Here we delete all upper or lower case letters and if the number of letters deleted is equal to original length we know that the original contained all upper/lower case letters as required by the rules. One catch is that tr when used this way alters the original string. One way around that would be to use temporary variables. Another option is to contain each of these rules checks in their own block!

Part 2

You are given an encoded string consisting of a sequence $s of numeric characters: 0..9. Write a script to find the all valid different decodings in sorted order.

Solution

use v5.36;
use strict;
use warnings;

use AI::Prolog;
use Hash::MultiKey;

my $prolog_code;
sub init_prolog{
    $prolog_code = do{
        local $/;
        <DATA>;
    };
}

sub decoded_list{
    my($s) = @_;
    my $prolog = $prolog_code;
    my @alphabet = qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z/;
    my @encoded;
    my @decoded;
    my $length = length($s);
    $prolog =~ s/_LENGTH_/$length/g;
    $prolog = AI::Prolog->new($prolog); 
    $prolog->query("sum(Digits).");
    my %h;
    tie %h, "Hash::MultiKey";
    while(my $result = $prolog->results){
        $h{$result->[1]} = undef;
    }
    for my $pattern (keys %h){
        my $index = 0;
        my $encoded = [];
        for my $i (@{$pattern}){
            push @{$encoded}, substr($s, $index, $i);
            $index += $i;
        }
        push @encoded, $encoded if 0 == grep { $_ > 26 } @{$encoded};
    }
    @decoded = sort { $a cmp $b } map { join("", map { $alphabet[$_ - 1] } @{$_}) } @encoded;
}

MAIN:{
    init_prolog;
    say join(", ", decoded_list(11));
    say join(", ", decoded_list(1115));
    say join(", ", decoded_list(127));
}

__DATA__
member(X,[X|_]).
member(X,[_|T]) :- member(X,T).

digits([1, 2]).

sum(Digits):-
    sum([], Digits, 0).

sum(Digits, Digits, _LENGTH_). 

sum(Partial, Digits, Sum):-   
    Sum < _LENGTH_, 
    digits(L),
    member(X,L),
    S is Sum + X,
    sum([X | Partial], Digits, S). 

Sample Run

$ perl perl/ch-2.pl
AA, K
AAAE, AAO, AKE, KAE, KO
ABG, LG

Notes

There is an element of this task which reminded me of a much older problem presented back in TWC 075. In brief, the question was how many ways could coins be used in combination to form a target sum. My solution used a mix of Prolog and Perl since Prolog is especially well suited for elegant solutions to these sorts of combinatorial problems.

I recognized that this week we have a similar problem in how we may separate the given encoded string into different possible chunks for decoding. Here we know that no chunk may have value greater than 26 and so we can only choose one or two digits at a time. How many ways we can make these one or two digit chunks is the exact same problem, somewhat in hiding, as in TWC 075!

I re-use almost the exact same Prolog code as used previously. This is used to identify the different combinations of digits for all possible chunks. Once that is done we need only map the chunks to letters and sort.

References

Scoping in Perl

Challenge 190