Anagram generator
Using the unixdict.txt word file by default.
unit sub MAIN ($in is copy = '', :$dict = 'unixdict.txt');
say 'Enter a word or phrase to be anagramed. (Loading dictionary)' unless $in.chars;
# Load the words into a word / Bag hash
my %words = $dict.IO.slurp.lc.words.race.map: { .comb(/\w/).join => .comb(/\w/).Bag };
# Declare some globals
my ($phrase, $count, $bag);
loop {
($phrase, $count, $bag) = get-phrase;
find-anagram Hash.new: %words.grep: { .value ⊆ $bag };
}
sub get-phrase {
my $prompt = $in.chars ?? $in !! prompt "\nword or phrase? (press Enter to quit) ";
$in = '';
exit unless $prompt;
$prompt,
+$prompt.comb(/\w/),
$prompt.lc.comb(/\w/).Bag;
}
sub find-anagram (%subset, $phrase is copy = '', $last = Inf) {
my $remain = $bag ∖ $phrase.comb(/\w/).Bag; # Find the remaining letters
my %filtered = %subset.grep: { .value ⊆ $remain }; # Find words using the remaining letters
my $sofar = +$phrase.comb(/\w/); # Get the count of the letters used so far
for %filtered.sort: { -.key.chars, ~.key } { # Sort by length then alphabetically then iterate
my $maybe = +.key.comb(/\w/); # Get the letter count of the maybe addition
next if $maybe > $last; # Next if it is longer than last - only consider descending length words
next if $maybe == 1 and $last == 1; # Only allow one one character word
next if $count - $sofar - $maybe > $maybe; # Try to balance word lengths
if $sofar + $maybe == $count { # It's an anagram
say $phrase ~ ' ' ~ .key and next; # Display it and move on
} else { # Not yet a full anagram, recurse
find-anagram %filtered, $phrase ~ ' ' ~ .key, $maybe;
}
}
}
Punctuation, capitalization and (in some cases) word order manually massaged.
Enter a word or phrase to be anagramed. (Loading dictionary)
word or phrase? (press Enter to quit) Rosettacode
doctor tease
word or phrase? (press Enter to quit) thundergnat
dragnet hunt
Gent? Nah, turd.
word or phrase? (press Enter to quit) Clint Eastwood
downcast eliot
I contest waldo
nose to wildcat
Last updated