Solutions to Challenge 5 for Doug Schrag

2 files changed, 59 insertions, 0 deletions

diff --git a/challenge-005/doug-schrag/perl6/ch-1.p6 b/challenge-005/doug-schrag/perl6/ch-1.p6
new file mode 100644
index 0000000000..49d5720639
--- /dev/null
+++ b/challenge-005/doug-schrag/perl6/ch-1.p6
@@ -0,0 +1,16 @@
+use v6;
+
+sub MAIN(Str $word, :$word-file) {
+    my $file = .IO with $word-file;
+    my Set $words = Set.new(.lines.sort) with $file;
+    my &is-word = $words.defined
+        ?? -> $w { $w (elem) $words }
+        !! -> $w { True };
+    for $word.comb.permutations.unique(:with(&[eqv])) {
+        with .join {
+            .say if .&is-word
+        }
+    }
+}
+
+
diff --git a/challenge-005/doug-schrag/perl6/ch-2.p6 b/challenge-005/doug-schrag/perl6/ch-2.p6
new file mode 100644
index 0000000000..4482e93431
--- /dev/null
+++ b/challenge-005/doug-schrag/perl6/ch-2.p6
@@ -0,0 +1,43 @@
+use v6;
+
+sub MAIN(:$word-file is copy, :$lengthy) {
+    my $file = .IO with $word-file;
+    my Set $words = Set.new(.lines.sort) with $file;
+    return unless $words;
+
+    my &is-word = $words.defined
+        ?? -> $w { $w (elem) $words }
+        !! -> $w { True };
+    my %counts;
+    for $words.keys -> $word {
+        my $norm = normalize-anagram($word);
+        %counts{ $norm }++;
+    }
+
+    my $max = %counts.pairs.max({ .value }).value;
+    my @patterns = %counts.pairs.grep(*.value == $max)>>.key;
+    for @patterns {
+        .say;
+        "  $_".say for .&anagrams;
+    }
+
+    if ($lengthy) {
+        say %counts.grep({
+            .value > 1
+            && .key.chars > @patterns.max(*.chars).chars
+        });
+    }
+
+    sub anagrams ($word) {
+        gather
+        for $word.comb.permutations.unique(:with(&[eqv])) {
+            with .join {
+                .take if .&is-word
+            }
+        }
+    }
+    sub normalize-anagram(Str $word) {
+        return $word.comb.sort.join;
+    }
+}
+