PWC 190

PWC 190

This week was busy at work. I thought I would only be able to do Challenge 1, but I managed to eke out a minimal solution in Perl 5 and Raku to Challenge 2 too (I passed on Julia for Challenge 2 this time).

Challenge 1 (Capital Detection)

We are given a string consisting of alphabets only (/^[A-Za-Z]+$/), and asked to test if one of the following conditions is met:

  1. The initial letter is uppercase, and all the rest are lowercase (as in "Perl").
  2. All the letters are uppercase (as in "COBOL").
  3. All the letters are lowercase (as in "bash").

This is one of those Perl programming exercises where the python philosophy almost applies: there's one very good way to do it, and that's the way to go. That is via a regex.

This would be an easy one-liner, but I have used a subroutine instead.

Here is the key snippet in Perl 5.

($s =~ /^[A-Z]?[a-z]+$|^[A-Z]+$|^[a-z]+$/) ? 1 : 0;
Here is the same thing in Raku (a direct translation)

 sub capital-detection( Str $s) {
    ($s ~~
    /^ <[A .. Z]> ? <[ a .. z]> + $ ||
    ^ <[A .. Z]> + $ ||
    ^ <[a .. z]> +/)
    ?? 1
    !! 0;
}

Here is the same thing in Julia. Julia's version of "Perl-compatible" regular expressions is almost perfectly Perl-compatible (with Perl 5). My solution is just the Perl 5 regex stuck inside Julia's occursin function, which tests if a match exists and returns true if so.

function capital_detection( s::String ) ::Bool
    myregex=r"^[A-Z]?[a-z]+$|^[A-Z]+$|^[a-z]+$"
    return occursin( myregex, s)
end

Challenge 2 (Decoded list)

This is a more difficult challenge. We are given a string $s say consisting of digits only (/^[0-9]+$/), that is surmised to be an encoded string of uppercase alphabets created by replacing a letter with its position in the alphabet (1 to 26). This creates some ambiguity in decoding, as for example the string '26' could be the letter 'Z' (letter 26) or could be 'BF' (letter 2 and letter 6). We are tasked to find all the possible decodings of a particular string.

Due to time constraints, I have prepared a minimal solution that just satisfies the test examples. I limit to strings of up to four digits (the longest test example is 1115). I also excluded the digit 0 in my input, as it's not clear how to interpret it as a singleton, and it's not in any of the test examples.

For my Perl 5 script, I restrict to Perl 4 syntax as I have done before in these challenges. I use global (file-scope) hashes to store the encodings from 1-26 to 'A'-'Z', and in reverse from 'A'-'Z' to 1-26. 

In my subroutine to do the decoding, I create two arrays, @ones to store the decoding for the input read one-digit at a time, and @twos to store the decoding for the input read two-digits at a time (substr($s,0,2), substr($s,1,2),...).

To obtain candidate decoding for the entire string, we combine letters from the @ones and @twos arrays. For example, one candidate for a four-letter string could be the string created by joining $ones[0],$twos[1],$ones[3].

I create and store a list of all such candidates for 2, 3 and 4 letter inputs, via a hash. Here for example is the hash entry for 3-letters:

$iterator{3}=q<('@ones[0..2]',
        '($ones[0],$twos[1])',
        '($twos[0],$ones[2])')>;

This is a stringified list of stringified lists. I use string evals inside a loop to evaluate them.

for $ctr (eval $iterator{length($s)}) {
        local @s = eval $ctr;
        ( &chk(@s) ) && ( push @retval, join //, @s);
}

The nested sub-subroutine &chk checks if a particular candidate reverse-evaluates back to the original input.

To handle input longer than 4 digits, I wrote a subroutine &slide_decode_list. This decodes four-letter slices of the input $s, in the order substr($s,0,4), substr($s,3,4),... That is, the edges of the slices overlap. Here is the subroutine:

local *slide_decoded_list = sub {
    #-- ...

    local ($s)=@_;
    local ($ctr,@retval);
    for ($ctr=0; $ctr < length($s); $ctr+=3 ) {
        local @s=&decoded_list(substr($s,$ctr,4));
        push @retval, "(@s)";
    }
    return @retval;
};

This is actually better than spitting out all the possible combinations. Here is a thought experiment to explain why. 

Suppose someone had encoded the entire collected works of Shakespeare (ignoring case and punctuation) and handed them to us for decoding. 

Spitting out all the possible combinations and then trawling through them to find the correct one would not be too different from trawling through the proverbial output of a million monkeys typing random stuff for a million years.

Output where we are given all the candidates for small sequential chunks of the text is much easier for a human to parse. The correct answers would almost leap out at a human reader, and  a good AI program would not do much worse. (But see an example in the appendix).

In Raku, I originally planned a recursive approach, but due to my time constraints, I did something very similar to Perl 5. I did use multiple dispatch. So my raku equivalent of &slide_decoded_list is called simply &decoded-list, the same name as the subroutine it calls. Pseudo-recursion, if you will.

In Raku, I exploit the .trans method on strings, which transliterates strings. For example, "26".trans([10..26]=>['J'..'Z') returns "Z".

Here is my Raku subroutine for 3-letter input:

multi sub decode-list( Str $s where
    $s ~~ /^<[1..9]>+$/ && $s.chars==3) {

    my @retval;
                
    @retval.append($s.trans([1 .. 9] => ['A' .. 'I']));
    
    ($s.substr(1) <= 26) && @retval.append($s.substr(0,1).trans([1..9]=>['A'..'I']) ~
    $s.substr(1).trans([1..26] => ['A' .. 'Z']));
    
    ($s.substr(0,2) <= 26) && @retval.append($s.substr(0,2).trans([1..26]=>['A'..'Z']) ~
    $s.substr(2).trans([1..9] => ['A' .. 'I']));
            
    return @retval.sort;
}

Sadly I could not try this challenge in Julia due to lack of time. It does not look like anyone else has a Julia solution either, as of this writing.

To be able to deal with real encoded text, my scripts need to be able to handle zeroes in the input string. I'll leave this unimplemented. One way to handle zero is to assume that it tracks spaces or punctuation marks between letters, which could be represented in a decoding via a symbol like "_". Another way is to assume that zero can only occur after 1 or 2 (probably what our good host expects), representing J or T respectively. In that case, our input validation could reject any input that includes zeroes not satisfying these conditions. But I'll leave zero-handling undone.
 

Let me just add a caveat that all my "Perl 4" scripts in these challenges have actually been tested on Perl 5 only, the latest version to boot.  I do not have a Perl 4 interpreter, and can't confirm that these scripts would actually run on one.

Appendix --- slide_decode_list sample output

I encoded a well-known quote from Shakespeare and then decoded it using &slide_decode_list after modifying my program to allow zero to be interpreted as a space between words and decoded as "_". The zero-handling is not perfect, but works well enough for this example.

Here is the encoded string:

'2015025015180141520020150250208120091902085017215192091514'

Here is the &slide_decode_list output:

(B_AE B_O TAE TO) (E_BE E_Y) (E_AE E_O) (EAH_ ER_) (_ADA _NA) (AEB_ AET OB_ OT) (__B_ __B_ __T __T) (_AE_ _O_) (_BE_ _Y_) (_B_H _TH) (HAB_ HAT HL_) (__IA __IA) (AI_B S_B) (B_HE THE) (E_AG E_Q) (GBAE GBO GUE) (EAIB ESB) (B_IA TIA) (AEAD AEN OAD ON) (D)

It doesn't quite leap out at one, but should be decipherable.

Comments

Post a Comment

Popular posts from this blog

PWC 215

PWC 215 I have attempted the Perl Weekly Challenge after a hiatus of several weeks, as I was too busy at work. Still busy, so I have just attempted the current challenge in Perl 5. Like I like to do, I have restricted myself to perl 4 syntax as specified in the first edition of Programming perl. Update and disclaimer : These programs will not work on Perl 4 as I discovered later when I found and installed a Perl 4.019 executable. For one thing, the ability to assign a subroutine to a locally scoped typeglob was not available in Perl 4. Challenge 1 (Odd one out) In this challenge, we are given a list of alphabetic strings, and asked to return the list without the strings in which the characters are not sorted (I assume that this means sorted in lexical ascending order). We are also asked to print the number of strings that were removed (i.e., that were not sorted).  I use a subroutine &odd_one_out(@words) with a nested helper sub-sub-routine to check if a string is sorted. Here i
Read more

PWC 227

PWC 227 Challenge 1 (Friday 13th) This challenge requires us to count the number of times Friday 13th occurs in a particular year. I use Date::Manip. This module probably has easier ways to do this using a Date Range, but my approach is easy enough. My &friday_13th subroutine takes the year as input, throws an exception if it is outside the specified range (1753 to 9999), and then cycles through the 13th of each month, counting the Fridays. use Date::Manip; my $dateobj=Date::Manip::Date->new(); sub friday_13th {     my ($year)=@_;     my $retval=0;     ( ($year > 9999) || ($year < 1753) ) &&         die "Year should be between 1753 and 9999";     map {         ( ($dateobj->new_date("$year-$_-13")->printf('%w') ) == 5 ) &&             $retval++;     }     1 .. 12;          $retval; }   Challenge 2 (Roman Maths) This challenge requires us to implement a calculator that parses infix math operations using roman numerals.  There
Read more

PWC 234

PWC 234 I tried to restrict to Perl 4 syntax for both challenges this week, as documented in Rex Swain's Perl 4 reference or the 1st edition of Programming perl. I do use nested subroutines, which I am not sure would actually work in Perl 4, though they comply with the syntax. My programs are tested on Perl 5.38. (The -l in the shebang line works only in Perl 5. The Perl 4 equivalent was -L012 in Unix, which is no longer available.) As I have mentioned before, my aims in using the old syntax are just mild nostalgia plus to add a bit of additional challenge to the task. I know that this is not the most efficient or idiomatic way to do things today. But I should observe that it is really cool that I am able to write code using 30-year old syntax, and run it unmodified on the latest Perl 5.38. You cannot do this with Python 3 for example. This very deep backward compatibility is one of those unsung underappreciated beauties of Perl 5. In my opinion, it is a very cool thing in
Read more