- Added solutions by Arne Sommer.

11 files changed, 325 insertions, 0 deletions

diff --git a/challenge-038/arne-sommer/blog.txt b/challenge-038/arne-sommer/blog.txt
new file mode 100644
index 0000000000..18fd6d20b4
--- /dev/null
+++ b/challenge-038/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://raku-musings.com/date-word.html
diff --git a/challenge-038/arne-sommer/perl6/ch-1.p6 b/challenge-038/arne-sommer/perl6/ch-1.p6
new file mode 100755
index 0000000000..c0859c9391
--- /dev/null
+++ b/challenge-038/arne-sommer/perl6/ch-1.p6
@@ -0,0 +1,24 @@
+#! /usr/bin/env raku
+
+# subset month of Str where $_ eq any ("01" .. "12");
+# subset day   of Str where $_ eq any ("01" .. "31");
+
+unit sub MAIN (Str $date);
+
+if $date ~~ /^
+            $<century> = (<[12]>)
+            $<year>    = (<[0..9]><[0..9]>)
+	    $<month>   = (<[01]><[0..9]>)
+	    $<day>     = (<[0123]><[0..9]>)
+         $/
+{
+  my $datestring = "{ $<century> == 1 ?? '20' !! '19' }{ $<year> }-{ $<month> }-{ $<day> }";
+
+  if try Date.new($datestring)
+  {
+    say $datestring;
+    exit;
+  }
+}
+
+say "Not a valid date.";
diff --git a/challenge-038/arne-sommer/perl6/ch-2.p6 b/challenge-038/arne-sommer/perl6/ch-2.p6
new file mode 100755
index 0000000000..a411f4d7d2
--- /dev/null
+++ b/challenge-038/arne-sommer/perl6/ch-2.p6
@@ -0,0 +1,50 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (:$length = 7,
+               :$verbose,
+               :$dictionary where $dictionary.IO.r = "dict-UK.txt");
+
+my %value =
+(
+  A =>  1, G =>  1, I => 1, S => 1, U => 1, X => 1, Z => 1,
+  E =>  2, J =>  2, L => 2, R => 2, V => 2, Y => 2,
+  F =>  3, D =>  3, P => 3, W => 3,
+  B =>  4, N =>  4,
+  T =>  5, O =>  5, H => 5, M => 5, C => 5,
+  K => 10, Q => 10
+);
+
+my %count =
+(
+  A => 8, G => 3, I => 5, S => 7, U => 5, X => 2, Z => 5,
+  E => 9, J => 3, L => 3, R => 3, V => 3, Y => 5, F => 3,
+  D => 3, P => 5, W => 5, B => 5, N => 4, T => 5, O => 3,
+  H => 3, M => 4, C => 4, K => 2, Q => 2
+);
+
+sub get-dictionary ($file where $file.IO.r)
+{
+  return $file.IO.lines.grep(* !~~ /\W/)>>.uc.Set;
+}
+
+my %dict = get-dictionary($dictionary);
+
+my @letters = %value.keys.map({ $_ xx %count{$_} }).sort.flat;
+
+say "- Letters: " ~ @letters.join if $verbose;
+
+my @legal-words = @letters.combinations(1 .. $length)>>.join.unique.grep({ %dict{$_} });
+
+say "- Legal words: @legal-words[]" if $verbose;
+
+my %candidates;
+
+for @legal-words -> $word
+{
+  %candidates{$word} = $word.comb.map({ %value{$_} }).sum;
+}
+
+my $max-val = %candidates.values.max;
+
+say "Most valuable word(s) at $max-val points:";
+say %candidates.keys.grep({ %candidates{$_} == $max-val }).sort.join(", "), ".";
diff --git a/challenge-038/arne-sommer/perl6/datefinder-grammar b/challenge-038/arne-sommer/perl6/datefinder-grammar
new file mode 100755
index 0000000000..356ad040ea
--- /dev/null
+++ b/challenge-038/arne-sommer/perl6/datefinder-grammar
@@ -0,0 +1,31 @@
+#! /usr/bin/env raku
+
+## use Grammar::Tracer;
+
+unit sub MAIN (Str $date);
+
+grammar PerlWeeklyDate
+{
+  token TOP       { <century> <year> <month> <day> }
+  token century   { [ 1 | 2 ] }
+  token year      { <digit> <digit> }
+  token month     { 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 }
+  token day       { [ 0 <pos-digit> | 1 <digit> | 2 <digit> | 30 | 31 ] }
+  token digit     { [ 0 | <pos-digit> ] } 
+  token pos-digit { [ 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 ] } 
+}
+
+my $result = PerlWeeklyDate.parse($date);
+
+if $result
+{
+  my $datestring = "{ $result<century> == 1 ?? '20' !! '19' }{ $result<year> }-{ $result<month> }-{ $result<day> }";
+
+  if try Date.new($datestring)
+  {
+    say $datestring;
+    exit;
+  }
+}
+
+say "Not a valid date.";
diff --git a/challenge-038/arne-sommer/perl6/datefinder-regex b/challenge-038/arne-sommer/perl6/datefinder-regex
new file mode 100755
index 0000000000..c0859c9391
--- /dev/null
+++ b/challenge-038/arne-sommer/perl6/datefinder-regex
@@ -0,0 +1,24 @@
+#! /usr/bin/env raku
+
+# subset month of Str where $_ eq any ("01" .. "12");
+# subset day   of Str where $_ eq any ("01" .. "31");
+
+unit sub MAIN (Str $date);
+
+if $date ~~ /^
+            $<century> = (<[12]>)
+            $<year>    = (<[0..9]><[0..9]>)
+	    $<month>   = (<[01]><[0..9]>)
+	    $<day>     = (<[0123]><[0..9]>)
+         $/
+{
+  my $datestring = "{ $<century> == 1 ?? '20' !! '19' }{ $<year> }-{ $<month> }-{ $<day> }";
+
+  if try Date.new($datestring)
+  {
+    say $datestring;
+    exit;
+  }
+}
+
+say "Not a valid date.";
diff --git a/challenge-038/arne-sommer/perl6/datefinder-subset b/challenge-038/arne-sommer/perl6/datefinder-subset
new file mode 100755
index 0000000000..e89dc45c28
--- /dev/null
+++ b/challenge-038/arne-sommer/perl6/datefinder-subset
@@ -0,0 +1,24 @@
+#! /usr/bin/env raku
+
+my $string;
+
+subset PerlWeeklyDate of Str where
+  $_.chars == 7 &&
+  $_.substr(0,1) eq '1'|'2' &&
+  ( $string = string2date($_) ) &&
+  try Date.new($string).defined;
+
+multi sub MAIN (PerlWeeklyDate $date)
+{
+  say $string;
+}
+
+multi sub MAIN (Str $invalid)
+{
+  say "Not a valid date.";
+}
+
+sub string2date (Str $string)
+{
+  return "{ $string.substr(0,1) eq '1' ?? '20' !! '19' }{ $string.substr(1,2) }-{ $string.substr(3,2) }-{ $string.substr(5,2) }";
+}
diff --git a/challenge-038/arne-sommer/perl6/datefinder-substr b/challenge-038/arne-sommer/perl6/datefinder-substr
new file mode 100755
index 0000000000..0d21057bf2
--- /dev/null
+++ b/challenge-038/arne-sommer/perl6/datefinder-substr
@@ -0,0 +1,14 @@
+#! /usr/bin/env raku
+
+multi sub MAIN (Str $date where
+  $date.chars == 7 &&
+  $date.substr(0,1) eq '1'|'2' &&
+  try Date.new("{ $date.substr(0,1) eq '1' ?? '20' !! '19' }{ $date.substr(1,2) }-{ $date.substr(3,2) }-{ $date.substr(5,2) }").defined)
+{
+  say "{ $date.substr(0,1) == 1 ?? '20' !! '19' }{ $date.substr(1,2) }-{ $date.substr(3,2) }-{ $date.substr(5,2) }";
+}
+
+multi sub MAIN (Str $invalid)
+{
+  say "Not a valid date.";
+}
diff --git a/challenge-038/arne-sommer/perl6/datefinder-test b/challenge-038/arne-sommer/perl6/datefinder-test
new file mode 100755
index 0000000000..fc8cd02473
--- /dev/null
+++ b/challenge-038/arne-sommer/perl6/datefinder-test
@@ -0,0 +1,39 @@
+#! /usr/bin/env raku
+
+sub wrap ($program, $arg)
+{
+  my $proc = run $program, $arg, :out;
+  return $proc.out.slurp(:close).chomp;
+}
+
+my @programs =
+<
+  ./datefinder-substr
+  ./datefinder-subset
+  ./datefinder-grammar
+  ./datefinder-regex
+>;
+
+my %to-test =
+(
+  '0230120'  => "Not a valid date.",
+  '1230120'  => "2023-01-20", 
+  '1230120s' => "Not a valid date.",
+  '2230120'  => "1923-01-20",
+  '2240229'  => "1924-02-29", 
+  '2230229'  => "Not a valid date.",
+  '111111'   => "Not a valid date.",
+  '111111s'  => "Not a valid date.",
+);
+  
+use Test;
+
+for @programs -> $program
+{
+  for %to-test.keys -> $arg
+  {
+    is(wrap($program, $arg),  %to-test{$arg}, "$program $arg %to-test{$arg}");
+  }
+}
+
+done-testing;
diff --git a/challenge-038/arne-sommer/perl6/mkdictionary b/challenge-038/arne-sommer/perl6/mkdictionary
new file mode 100755
index 0000000000..bee76c263c
--- /dev/null
+++ b/challenge-038/arne-sommer/perl6/mkdictionary
@@ -0,0 +1,14 @@
+#! /usr/bin/env raku
+
+my %source =
+  <UK> => "/usr/share/dict/british-english",
+  <US> => "/usr/share/dict/american-english",
+  <DE> => "/usr/share/dict/ngerman";
+
+unit sub MAIN (Str $language where %source{$language}.defined);
+
+my @lines = %source{$language}.IO.lines.grep(* !~~ /\W/);
+
+spurt "dict-$language.txt", $language eq "DE"
+ ?? @lines.join("\n") ~ "\n"
+ !! "A\nI\n" ~ @lines.grep( {.chars > 1 } ).join("\n") ~ "\n";
diff --git a/challenge-038/arne-sommer/perl6/wordgame b/challenge-038/arne-sommer/perl6/wordgame
new file mode 100755
index 0000000000..7f1a92ed47
--- /dev/null
+++ b/challenge-038/arne-sommer/perl6/wordgame
@@ -0,0 +1,54 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (:$length = 7,
+               :$verbose,
+               :$dictionary where $dictionary.IO.r = "dict-UK.txt");
+
+my %value =
+(
+  A =>  1, G =>  1, I => 1, S => 1, U => 1, X => 1, Z => 1,
+  E =>  2, J =>  2, L => 2, R => 2, V => 2, Y => 2,
+  F =>  3, D =>  3, P => 3, W => 3,
+  B =>  4, N =>  4,
+  T =>  5, O =>  5, H => 5, M => 5, C => 5,
+  K => 10, Q => 10
+);
+
+my %count =
+(
+  A => 8, G => 3, I => 5, S => 7, U => 5, X => 2, Z => 5,
+  E => 9, J => 3, L => 3, R => 3, V => 3, Y => 5, F => 3,
+  D => 3, P => 5, W => 5, B => 5, N => 4, T => 5, O => 3,
+  H => 3, M => 4, C => 4, K => 2, Q => 2
+);
+
+sub get-dictionary ($file where $file.IO.r)
+{
+  return $file.IO.lines.grep(* !~~ /\W/)>>.uc.Set;
+}
+
+my %dict = get-dictionary($dictionary);
+
+my @letters = %value.keys.map({ $_ xx %count{$_} }).sort.flat;
+
+say "- Letters: " ~ @letters.join if $verbose;
+
+my @selection = @letters.pick($length);
+
+say "- Selected: { @selection.join } with length $length" if $verbose;
+
+my @legal-words = @selection.combinations>>.join.unique.grep({ %dict{$_} });
+
+say "- Legal words: @legal-words[]" if $verbose;
+
+my %candidates;
+
+for @legal-words -> $word
+{
+  %candidates{$word} = $word.comb.map({ %value{$_} }).sum;
+}
+
+my $max-val = %candidates.values.max;
+
+say "Most valuable word(s) at $max-val points:";
+say %candidates.keys.grep({ %candidates{$_} == $max-val }).sort.join(", "), ".";
diff --git a/challenge-038/arne-sommer/perl6/wordgame-absolute b/challenge-038/arne-sommer/perl6/wordgame-absolute
new file mode 100755
index 0000000000..a411f4d7d2
--- /dev/null
+++ b/challenge-038/arne-sommer/perl6/wordgame-absolute
@@ -0,0 +1,50 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (:$length = 7,
+               :$verbose,
+               :$dictionary where $dictionary.IO.r = "dict-UK.txt");
+
+my %value =
+(
+  A =>  1, G =>  1, I => 1, S => 1, U => 1, X => 1, Z => 1,
+  E =>  2, J =>  2, L => 2, R => 2, V => 2, Y => 2,
+  F =>  3, D =>  3, P => 3, W => 3,
+  B =>  4, N =>  4,
+  T =>  5, O =>  5, H => 5, M => 5, C => 5,
+  K => 10, Q => 10
+);
+
+my %count =
+(
+  A => 8, G => 3, I => 5, S => 7, U => 5, X => 2, Z => 5,
+  E => 9, J => 3, L => 3, R => 3, V => 3, Y => 5, F => 3,
+  D => 3, P => 5, W => 5, B => 5, N => 4, T => 5, O => 3,
+  H => 3, M => 4, C => 4, K => 2, Q => 2
+);
+
+sub get-dictionary ($file where $file.IO.r)
+{
+  return $file.IO.lines.grep(* !~~ /\W/)>>.uc.Set;
+}
+
+my %dict = get-dictionary($dictionary);
+
+my @letters = %value.keys.map({ $_ xx %count{$_} }).sort.flat;
+
+say "- Letters: " ~ @letters.join if $verbose;
+
+my @legal-words = @letters.combinations(1 .. $length)>>.join.unique.grep({ %dict{$_} });
+
+say "- Legal words: @legal-words[]" if $verbose;
+
+my %candidates;
+
+for @legal-words -> $word
+{
+  %candidates{$word} = $word.comb.map({ %value{$_} }).sum;
+}
+
+my $max-val = %candidates.values.max;
+
+say "Most valuable word(s) at $max-val points:";
+say %candidates.keys.grep({ %candidates{$_} == $max-val }).sort.join(", "), ".";