eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
                  && eval 'exec perl -w -S $0 $argv:q'
                  if 0;

# The above invocation finds perl in the path, wherever it may be

# find words in dictionary containing only letters given
# usage: $0 given_letters word_list_file_name[s]

use strict;
use warnings;

our $min_word_length = 3;
our $given = shift;
our $given_length = length( $given );

our @factorial;
$factorial[0] = 1;

# read in dictionary, removing invalid words, and words with letters n
+ot in the given list
warn "Reading in dictionary\n";
our @word_list;
while (<>)
{
    chomp;
    next unless /^[a-z]{$min_word_length,$given_length}$/;
    my $temp;
    ($temp = $_) =~ s/[$given]//g;
    next if length($temp);
    push @word_list, $_;
}
warn "\t", scalar @word_list, " words in dictionary (after filtering)\
+n";

warn "Creating dictionary anagrams\n";
our %word_list_sorted_anagrams;
for my $word (@word_list)
{
    my $key = join('', sort split '', $word);
    # some anagrams will not be unique
    push @{$word_list_sorted_anagrams{$key}}, $word; 
}
# match this against a regex later
my $word_list_sorted_anagrams_key_string = join ',', keys %word_list_s
+orted_anagrams;
warn "\t", scalar keys %word_list_sorted_anagrams, " anagram keys\n";

warn "Creating given regexes\n";
# convert given to regex strings of the form "a{0,3}b{0,2}..."
my @given = split '', $given;
my %given_counts;
for my $g (@given)
{
    $given_counts{$g}++;
}
my @given_regexes;
for my $g (keys %given_counts)
{
    push @given_regexes, sprintf "%s{0,%d}", $g,$given_counts{$g},$giv
+en_counts{$g};
}

# permute the regex strings
warn "Permuting given regexes\n";
my %regex_permutations;
my $n = 0;
for my $n (0..factorial(scalar @given_regexes)-1)
{
    $regex_permutations{permutation_n($n,@given_regexes)} = 1;
    $n++;
}
warn "\t", scalar keys %regex_permutations, " regex permutations\n";

# find all matching anagram keys
warn "Matching anagram keys\n";
# number of permutations can be large, use a loop instead of a monster
+ regex
my @key_match_results;
my $counter; # for progress indicator, this loop can take a while!
for my $regex_permutation (keys %regex_permutations)
{
    my @results = grep {defined($_) and length($_)} $word_list_sorted_
+anagrams_key_string =~ m/\b$regex_permutation\b/g;
    push @key_match_results, grep {defined($_) and length($_)} @result
+s;
    $counter++;
#    print STDERR "." unless $counter % 100; # progress indicator for 
+the impatient
}
warn "\n\t", scalar @key_match_results, " matching anagram keys\n";

# lookup words from keys
warn "Looking up matching words\n";
my @words_matched;
for my $k (@key_match_results)
{
    push @words_matched, @{$word_list_sorted_anagrams{$k}};
}

print "@words_matched\n";
warn "\t", scalar @words_matched, " words matched\n";

exit;

###########################################3
# Find and return the $n'th permutation
# of the remaining arguments in some canonical order
# (modified from QOTW solution)
sub permutation_n 
{
  my $n = shift;
  my $result = '';
  while (@_) 
  {
    ($n, my $r) = (int($n/@_), $n % @_);
    $result .= splice @_, $r, 1;
  }
  return $result;
}

###########################
# we might do this a lot, so cache the results
sub factorial
{
    my $n = shift;

    # if we already know it, return it
    return $factorial[$n] if defined $factorial[$n];
    
    # else compute it from the largest known result
    my $result = $factorial[$#factorial];
    for my $k ( $#factorial+1..$n )
    {
        $result *= $k;
    }
    return $result;
}
[download]