laurent_r

These are some answers to the Week 38 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Challenge # 1: Date Finder

Create a script to accept a 7 digits number, where the first number can only be 1 or 2. The second and third digits can be anything 0-9. The fourth and fifth digits corresponds to the month i.e. 01,02,03…,11,12. And the last 2 digits represents the days in the month i.e. 01,02,03….29,30,31. Your script should validate if the given number is valid as per the rule and then convert into human readable format date.

Rules:

1) If 1st digit is 1, then prepend 20 otherwise 19 to the 2nd and 3rd digits to make it 4-digits year.

2) The 4th and 5th digits together should be a valid month.

3) The 6th and 7th digits together should be a valid day for the above month.

For example, the given number is 2230120, it should print 1923-01-20.

Task 1: Date Finder in Perl 5

This time, rather than concentrating on a test suite, I decided to focus on trying to provide useful warnings and error messages when the input value is not valid, which led me to test the input data piece by piece:

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use Time::Local;

my $in = shift // '2230120';
die "Input should be seven digits\n" unless $in =~ /^\d{7}$/;

my ($y1, $y2, $m, $d) = $in =~ /^(\d)(\d\d)(\d\d)(\d\d)/;
die "First digit should be 1 or 2\n" if $y1 !~ /[12]/;
my $year = $y1 == 1 ? "20$y2" : "19$y2";
die "Digits 4 and 5 should be a valid month number\n" unless $m =~ /(0\d)|(1[012])/;
die "Digits 6 and 7 should be a valid day in month\n" unless $d =~ /([012]\d)|(3[01])/;
my $test = eval { timelocal 0, 0, 0, $d, $m-1, $year - 1900 };
warn $@ if $@;
die "$in is equivalent to $year-$m-$d, which is an invalid date\n" unless defined $test;
say "$in is equivalent to $year-$m-$d.";

Note that, in the final section, I’m using the Time::Local module to validate a date. I have shown previously (see for example my blog post on the week day task of PWC # 37) how to figure out the number of days in any month of any year, taking into account leap years, without the help of any module.

These are a few examples of tests with various input data:

$ perl date_finder.pl 223022
Input should be seven digits

$ perl date_finder.pl
2230120 is equivalent to 1923-01-20.

$ perl date_finder.pl 2230120
2230120 is equivalent to 1923-01-20.

$ perl date_finder.pl 2230431
Day '31' out of range 1..30 at date_finder.pl line 15.
2230431 is equivalent to 1923-04-31, which is an invalid date

$ perl date_finder.pl 2230229
Day '29' out of range 1..28 at date_finder.pl line 15.
2230229 is equivalent to 1923-02-29, which is an invalid date

$ perl date_finder.pl 1960229
1960229 is equivalent to 2096-02-29.

When something goes wrong with the date, we have two messages (a warning and an error). Of course, we don’t need both, one would be sufficient, but this illustrates two different ways of reporting an invalid date.

Task 1: Date Finder in Raku (formerly known as Perl 6)

Let’s start with a simple port of the P5 program to Raku:

use v6;

sub MAIN ($in where * ~~ /^\d ** 7$/ = '2230120') {
    my ($y1, $y2, $m, $d) = ($in ~~ /^(\d)(\d\d)(\d\d)(\d\d)/)[0..3];
    die "First digit should be 1 or 2\n" if $y1 !~~ /<[12]>/;
    my $year = $y1 == 1 ?? "20$y2" !! "19$y2";
    die "Digits 4 and 5 should be a valid month number\n" unless $m ~~ /(0\d) | (1<[012]>)/;
    die "Digits 6 and 7 should be a valid day in month\n" unless $d ~~ /(<[012]>\d) | (3<[01]>)/;

    try { 
        my $test = Date.new($year, $m, $d);
    }
    die "$in is equivalent to $year-$m-$d, which is an invalid date\n" if $!;
    say "$in is equivalent to $year-$m-$d.";
}

Besides the minor syntax changes between the two languages, the only significant change is that the program attempts to create a Date object within a try block. This program produces essentially the same output as the P5 program.

Another way to do it would be to use a grammar, for example:

use v6;

grammar My-custom-date {
    token TOP { <y1> <y2> <m> <d> }
    token y1  { <[12]> }
    token y2  { \d ** 2}
    token m   { 0\d | 1<[012]> }
    token d   { <[012]> \d | 3<[01]> } 
}

sub MAIN ($in where * ~~ /^\d ** 7$/ = '2230120') {
    my $matched  = so My-custom-date.parse($in);
    say "Invalid input value $in" and exit unless $matched;
    my $year = $<y1> == 1 ?? "20$<y2>" !! "19$<y2>";
    try { 
        my $test = Date.new($year, $<m>, $<d>);
    }
    say "ERROR: $in is equivalent to $year-$<m>-$<d>, which is an invalid date\n" and exit if $!;
    say "$in is equivalent to $year-$<m>-$<d>.";
}

But, in this case, the advantage of using a grammar is not obvious, except for the fact the parsing is possibly slightly clearer. It might even be argued that using a grammar for such a simple case is sort of a technological overkill.

These are some sample runs:

$ perl6 date_finder.p6
2230120 is equivalent to 1923-01-20.

$ perl6 date_finder.p6 2230228
2230228 is equivalent to 1923-02-28.

$ perl6 date_finder.p6 2230229
Use of Nil in string context
ERROR: 2230229 is equivalent to 1923--, which is an invalid date

  in block  at date_finder.p6 line 17
Use of Nil in string context
  in block  at date_finder.p6 line 17

Task2: Word Game

Lets assume we have tiles as listed below, with an alphabet (A..Z) printed on them. Each tile has a value, e.g. A (1 point), B (4 points) etc. You are allowed to draw 7 tiles from the lot randomly. Then try to form a word using the 7 tiles with maximum points altogether. You don’t have to use all the 7 tiles to make a word. You should try to use as many tiles as possible to get the maximum points.

For example, A (x8) means there are 8 tiles with letter A.

1 point

    A (x8), G (x3), I (x5), S (x7), U (x5), X (x2), Z (x5)

2 points

    E (x9), J (x3), L (x3), R (x3), V (x3), Y (x5)

3 points

    F (x3), D (x3), P (x5), W (x5)

4 points

    B (x5), N (x4)

5 points

    T (x5), O (x3), H (x3), M (x4), C (x4)

10 points

    K (x2), Q (x2)

So, the game is essentially similar to Scrabble, except that there is no game board.

I don’t see any way to solve correctly this task without a brute-force approach, i.e. trying all possibilities to find the best score.

Just as for some previous challenges, I will use a words.txt file containing 113,809 lower-case English words usually accepted for crossword puzzles and other word games. The words.txt file can be found on my Github repository. The original list was contributed to the public domain by Internet activist Grady Ward in the context of the Moby Project. This word list is also mirrored at Project Gutenberg.

For the purpose of testing the programs below, the words.txt file is located in my current directory. Obviously, when we will be reading the list, we will need to keep only the words having the same length as the two input words. The word.txt input file only contains words with only lowercase alphabetical ASCII characters.

Word Game in Raku

Given that I had a very busy week and weekend for various personal reasons, it is now late on Sunday, and I’m not sure I’ll be able do solve this Scrabble-like in both Perl 5 and Raku in time for the deadline. So I decided to start with Raku, which has some functionalities that are useful for this task and not existing in Perl 5.

The solution is essentially as follows: read the file of authorized words, normalize the words by putting their letters in alphabetical order and store in a %word-list hash the normalized versions as a key, and the original word as a value.

Store the available letter tiles in a Bag. Then pick seven tiles (or any other number) from the bag, use the combinations method to produce all time combinations from the drawn letters, sort each combination alphabetically and look up for the result in the hash. If the result is found, compute its score and retain the word with the highest score so far. At the end, print the word with the highest score.

use v6;

constant %tile-values =  
    A => 1, B => 4, C => 5, D => 3, E => 2, 
    F => 3, G => 1, H => 5, I => 1, J => 2, 
    K => 10, L => 2, M => 5, N => 4, O => 5, 
    P => 3, Q => 10, R => 2, S => 1, T => 5, 
    U => 1, V => 2, W => 3, X => 1, Y => 2, Z => 1;

constant %tile-count =
    A => 8, B => 5, C => 4, D => 3, E => 9, 
    F => 3, G => 3, H => 3, I => 5, J => 3, 
    K => 2, L => 3, M => 4, N => 4, O => 3, 
    P => 5, Q => 2, R => 3, S => 7, T => 5, 
    U => 5, V => 3, W => 5, X => 2, Y => 5, Z => 5;

my $tile-bag = (map {$_ xx %tile-count{$_}}, keys %tile-count).Bag;

sub MAIN (Int $count = 7) {
    my %word-list;
    for "words.txt".IO.lines -> $line {
        next if $line.chars > $count;
        my $ordered = $line.uc.comb.sort.join("");
        my $line-value = [+] $ordered.comb.map({%tile-values{$_}});
        %word-list{$ordered}<word> = $line;
        # Note we will keep only one word for anagrams, but 
        # that's OK since anagrams have the same value
        %word-list{$ordered}<value> = $line-value;
    }
    for 1..10 {
        my @picked-tiles = $tile-bag.pick($count);
        my $max-combination = "";
        my $max-value = 0;
        for @picked-tiles.combinations -> $candidate {
            my $ordered = $candidate.sort.join("");
            next unless %word-list{$ordered}:exists;
            if %word-list{$ordered}<value> > $max-value {
                $max-value = %word-list{$ordered}<value>;
                $max-combination = $ordered;
            }
        }
        say "The best candidate for list ", @picked-tiles.join(""), " is:"; 
        say "    No word found!" and next unless $max-value;
        say "    %word-list{$max-combination}<word> (score: $max-value)";
    }
}

Note that the program is not very fast (2 to 3 seconds for 7 tiles), but that’s mainly due to time required to read the 113k-word list and store the words into a hash. Once the hash is populated, finding the best solution is quite fast. This is the reason for which I decided to run the solution-finding part ten times once the hash is populated. If I were going to make a real-life solution for the challenge, I would store the hash in a file, as I have shown previously, notably on the word ladder challenge in May of this year.

This is an example run:

$ time perl6  scrabble.p6 7
The best candidate for list MESWAAG is:
    wames (score: 12)
The best candidate for list XPSPBAG is:
    paps (score: 8)
The best candidate for list KISCPAC is:
    spick (score: 20)
The best candidate for list BMRPSPU is:
    bumps (score: 14)
The best candidate for list LZRYVBY is:
    byrl (score: 10)
The best candidate for list KHEBLZP is:
    kelp (score: 17)
The best candidate for list FHIOUHI is:
    foh (score: 13)
The best candidate for list VXAWSJH is:
    wash (score: 10)
The best candidate for list LIXMPGZ is:
    limp (score: 11)
The best candidate for list AJSFBOF is:
    boffs (score: 16)

real    0m2,751s
user    0m0,000s
sys     0m0,031s

I know that some words found above may seem funny or uncommon, but they belong to the words.txt file that is one of the official source of words for word games.

I’m sorry, I just don’t have enough time right now to finish the Perl 5 version of this task for the deadline (although I’ve almost completed it).

Wrapping up

The next week Perl Weekly Challenge is due to 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 Sunday, December 22. And, please, also spread the word about the Perl Weekly Challenge if you can.