- Added solutions by Ruben Westerberg.

4 files changed, 132 insertions, 0 deletions

diff --git a/challenge-038/ruben-westerberg/perl5/ch-1.pl b/challenge-038/ruben-westerberg/perl5/ch-1.pl
new file mode 100755
index 0000000000..7723ce2c0a
--- /dev/null
+++ b/challenge-038/ruben-westerberg/perl5/ch-1.pl
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+my $d= qr(@{[join "|", map { sprintf "%02d", $_} 1..31]});
+my $m= qr(@{[join "|", map { sprintf "%02d", $_} 1..12]});
+
+for (@ARGV) {
+	if (/(1|2)([0-9]{2})($m)($d)/) {
+		print "Input $_ OK\n";
+		print(join("-",($1==1?"20$2":"19$2",$3,$4)),"\n");
+		next;
+	}
+	print "Input $_ invalid\n";
+}
diff --git a/challenge-038/ruben-westerberg/perl5/ch-2.pl b/challenge-038/ruben-westerberg/perl5/ch-2.pl
new file mode 100755
index 0000000000..16ddaa32dd
--- /dev/null
+++ b/challenge-038/ruben-westerberg/perl5/ch-2.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use List::Util;
+
+my @l=split "", "AGISUXZEJLRVYFDPWBNTOHMCKQ";
+my @c=(8,3,5,7,5,2,5,9,3,3,3,3,5,3,3,5,5,5,4,5,3,3,4,4,2,2);
+my @v=((1)x7, (2)x6,(3)x4,(4)x2,(5)x5,(10)x2);
+
+my %tileBag;	#Bag of all tiles
+my %values;	#Map of letter to value/score
+my %drawBag;	#Bag of7 tiles drawn
+
+
+#Build the bags and maps
+for (0..$#l) {
+	$tileBag{$l[$_]}=$c[$_];
+	$values{$l[$_]}=$v[$_];
+}
+
+#Draw the 7 tiles. Update bag with removed tile
+for (1..7) {
+	my $total= List::Util::sum(values %tileBag);
+	my $i=int rand($total);
+	my $t=0;
+	my $selected;
+	for ("A".."Z") {
+		$t+=$tileBag{$_};
+		if ($t>$i) {
+			$tileBag{$_}--;
+			$drawBag{$_}++;
+			last;
+		}
+	}
+}
+
+#Find all words which can be made from the drawn bag
+my %contenders=map {($_, List::Util::sum( @values{split ""}))} possibleWords();
+
+#Print sores of all possible words in asscending order
+my @sorted=sort { $contenders{$a} <=> $contenders{$b} } keys %contenders;
+print "Contenders (word: score):\n";
+print "$_: $contenders{$_}\n" for @sorted;
+print "\nTiles Drawn: ",join(", ", map({($_) x $drawBag{$_}} keys %drawBag)),"\n";
+
+
+#Helper sub to test known words against drawn tiles
+sub possibleWords {
+        open my $f, "<","../words_alpha.txt";
+        my @words= grep { chomp; length($_) <= 7} map {uc} <$f>;
+        grep { 	my %bag; 
+		for (split "") { 
+			$bag{$_}++
+		};
+		my $valid=1;
+		for (keys %bag) {
+			if (defined $drawBag{$_}) {
+				$valid&=($bag{$_}<=$drawBag{$_});
+				next;
+			}
+			$valid&=0;
+		}
+		$valid
+	} @words;
+}
diff --git a/challenge-038/ruben-westerberg/perl6/ch-1.p6 b/challenge-038/ruben-westerberg/perl6/ch-1.p6
new file mode 100755
index 0000000000..b601c651e4
--- /dev/null
+++ b/challenge-038/ruben-westerberg/perl6/ch-1.p6
@@ -0,0 +1,13 @@
+#!/usr/bin/env perl6
+my $m=(1..12)>>.fmt("%02d").join("|");
+my $d=(1..31)>>.fmt("%02d").join("|");
+
+for @*ARGS {
+	if /(1|2)(<[0..9]>**2)(<$m>)(<$d>)/ { 
+		put "Input $_ OK";
+		put ($0==1??"20$1"!!"19$1",$2,$3).join("-");
+		next;
+	}
+	print "Input $_ invalid";
+}
+
diff --git a/challenge-038/ruben-westerberg/perl6/ch-2.p6 b/challenge-038/ruben-westerberg/perl6/ch-2.p6
new file mode 100755
index 0000000000..e7927c5d67
--- /dev/null
+++ b/challenge-038/ruben-westerberg/perl6/ch-2.p6
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl6
+
+#Input data
+my @l=comb "", "AGISUXZEJLRVYFDPWBNTOHMCKQ";
+my @c=(8,3,5,7,5,2,5,9,3,3,3,3,5,3,3,5,5,5,4,5,3,3,4,4,2,2);
+my @v=((1) xx 7, (2) xx 6,(3) xx 4,(4) xx 2,(5) xx 5,(10) xx 2).flat;
+
+#Build bag and map structures
+my BagHash $tileBag.=new-from-pairs((@l Z @c).flat.pairup); #Bag of all tiles
+my %values=(@l Z @v).flat;	#Letter value map
+my BagHash $drawBag;		#Bag of drawn tiles
+
+#Draw the 7 tiles. Update bag with removed tile
+for 1..7 {
+	my $i=$tileBag.total.rand.Int;
+	my $t=0;
+	my $selected;
+	for "A".."Z" {
+		$t+=$tileBag{$_};
+		if $t > $i {
+			$tileBag{$_}--;
+			$drawBag{$_}++;
+			last;
+		}
+	}
+}
+
+#Find all words which can be made from the drawn bag
+"../words_alpha.txt".IO.lines.map({.uc}).grep({$_.chars <= 7}) ==>
+grep({ .comb.BagHash (<=) $drawBag; }) ==> 
+map({|($_, %values{.comb}.sum)})==>
+my %contenders;
+
+#Print sores of all possible words in asscending order
+my @sorted=%contenders.keys.sort({%contenders{$^a} <=> %contenders{$^b}});
+
+put "Contenders (word: score):";
+put "$_: %contenders{$_}" for @sorted;
+put "\nDrawn tiles: $drawBag";