- Added solutions by Laurent Rosenfeld.

5 files changed, 100 insertions, 0 deletions

diff --git a/challenge-038/laurent-rosenfeld/blog.txt b/challenge-038/laurent-rosenfeld/blog.txt
new file mode 100644
index 0000000000..4ab9876c4f
--- /dev/null
+++ b/challenge-038/laurent-rosenfeld/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/laurent_r/2019/12/perl-weekly-challenge-38-date-finder-and-word-game.html
diff --git a/challenge-038/laurent-rosenfeld/perl5/ch-1.pl b/challenge-038/laurent-rosenfeld/perl5/ch-1.pl
new file mode 100644
index 0000000000..e16d944468
--- /dev/null
+++ b/challenge-038/laurent-rosenfeld/perl5/ch-1.pl
@@ -0,0 +1,18 @@
+#!/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.";
diff --git a/challenge-038/laurent-rosenfeld/perl6/ch-1.p6 b/challenge-038/laurent-rosenfeld/perl6/ch-1.p6
new file mode 100644
index 0000000000..8f452f6ea5
--- /dev/null
+++ b/challenge-038/laurent-rosenfeld/perl6/ch-1.p6
@@ -0,0 +1,15 @@
+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.";
+}
diff --git a/challenge-038/laurent-rosenfeld/perl6/ch-1a.p6 b/challenge-038/laurent-rosenfeld/perl6/ch-1a.p6
new file mode 100644
index 0000000000..db82aa455c
--- /dev/null
+++ b/challenge-038/laurent-rosenfeld/perl6/ch-1a.p6
@@ -0,0 +1,20 @@
+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>.";
+}
diff --git a/challenge-038/laurent-rosenfeld/perl6/ch-2.p6 b/challenge-038/laurent-rosenfeld/perl6/ch-2.p6
new file mode 100644
index 0000000000..57e51437bb
--- /dev/null
+++ b/challenge-038/laurent-rosenfeld/perl6/ch-2.p6
@@ -0,0 +1,46 @@
+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)";
+    }
+}