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 258

PWC 258 Last week (#257) I finished challenge 2 and my blog post for challenge 257 late last week, so had only submitted challenge 1. Here is my blog post for PWC 257 , including the full code for my challenge 2 solution. This week, I have done both challenges in perl 4.019 on DOSBOX. Both scripts also work fine on the latest Perl 5.38. I also did the challenges in Raku, where they are one-liners.  Challenge 1 (Count Even Digits Number) We are given a list of integers, and asked to count the number of elements whose base-10 representation has an even number of digits. In Raku , this is a one-liner. Here it is: raku -e 'say +@*ARGS.grep({$_.chars %% 2})' $@ It could be a one-liner in Perl 4 too, but since I run it on DOSBOX, my script would not be a bash shell script. Here is the short subroutine that does the job.  sub count_even_digits {  scalar( grep( ((length($_) % 2) == 0), @_) ); } The full code is here . Challenge 2 (Sum of values) We are given an integer k  an...
Read more

PWC 253

PWC 253 I do both challenges this week using old software on DOSBOX: perl 4.019, and for comparison, also python 1.4 beta. My solutions also work on the current versions of Perl 5 (5.38) and Python 2 (2.7.18) respectively. Challenge 1 (Split Strings) Links to code: perl4.019 python1.4b We are given a list of strings, and a single character say sep . We are asked to return the list, with the strings split into component substrings using sep as a separator. We should not include any empty strings in the output. In perl 4, I first stick a backslash in front of the separator character, so that it is escaped if entered in a regex. This is because the perl split function takes a regex as its first argument indicating the separator. If we have a character like '$' or ',', we want to escape it so that it is read literally when parsing the regex. Here is the key subroutine:   sub split_strings {  local ($separator, @words)=@_;  local (@retval)=(); #array to be returned  # ...
Read more

PWC 249

PWC 249 Challenge 1 (Equal pairs) We are given a list of integers with an even number of elements. We are asked to check if the list can be completely divided into sub-lists of size 2 with each sub-list containing the same integer repeated, like say (2,2). If so, we are asked to return the list of such sub-lists. This is straightforward in Perl 5. I use modern conveniences this time, though it could be done using only primitive Perl 4 syntax. Here is my subroutine. It returns a list of array references. local *equal_pairs = sub {     #-- return () if input is of odd length     ((scalar(@_) % 2) > 0) && (return ());          #-- count number of occurrences of each element using a hash     local %_ = ();     map {$_{$_}++} @_;          #-- if any element occurs an odd number of times, return ()     (grep {($_{$_} % 2) > 0} keys %_) &&...
Read more