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 not 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_sorted_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},$given_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($_)} @results;
	$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;
}

##</code><code>##

> time word_twister.pl posterboy web2* >! posterboy.txt
Reading in dictionary
        729 words in dictionary (after filtering)
Creating dictionary anagrams
        512 anagram keys
Creating given regexes
Permuting given regexes
        40320 regex permutations
Matching anagram keys
        460888 matching anagram keys
Looking up matching words
        763232 words matched
137.060u 0.290s 2:20.51 97.7%   0+0k 0+0io 2871pf+0w