Assuming you have a dictionary file, this will work. Give it args like "bed time", and you'll get back "debit me" as well as "bet I'm Ed".
#!/usr/bin/perl
use constant DEBUG => 1;
use warnings;
use strict;
my @val = ('\0', map "[\\0-\\$_]", 1 .. 255);
(my $chars = lc join "", @ARGV) =~ tr/a-z//cd;
my $words = get_words("/usr/dict/words", $chars);
add_words($words, qw(
a I
I'm you're he's she's we're they're
I'll you'll he'll she'll we'll they'll
I've you've we've they've
it's that's what's
isn't can't won't don't doesn't
));
# this populate %anagrams
my %anagrams;
anagrams(frequency($chars), \%anagrams);
sub get_words {
my ($f, $c) = @_;
my $l = length $c;
my @w;
open F, "< $f" or die "can't read $f: $!";
while (<F>) {
chomp;
next if $l < length or /[^$c]/oi;
push @{ $w[length]{(frequency(lc))[0]} }, $_;
}
close F;
return \@w;
}
sub add_words {
my $w = shift;
push @{ $w->[length $_->[1]]{(frequency(lc $_->[1]))[0]} }, $_->[0]
for map [ $_, do { (my $x = $_) =~ tr/a-zA-Z//cd; $x } ], @_;
}
sub anagrams {
my ($str, $len, $out, $tmp, $prune) = @_;
my $rx = freq_to_rx($str);
$prune ||= @$words - 1;
if ($len == 0) {
for (expand(@$tmp)) {
warn " > $_\n" if
$out->{join " ", sort split ' '}++ == 0 and DEBUG;
}
return;
}
for (reverse(1 .. $prune)) {
my $l = $words->[$_];
for my $w (grep /$rx/, keys %$l) {
my $p = ($_, $len - $_)[$_ > $len/2];
push @$tmp, $l->{$w};
anagrams(remove($str, $w, $len), $out, $tmp, $p);
pop @$tmp;
}
}
}
sub frequency {
my $s = "\0" x 26;
my $len = length $_[0];
++vec($s, ord($_) - ord('a'), 8) for split //, shift;
return ($s, $len);
}
sub remove {
my ($s, $r, $l) = @_;
my $o = 0;
vec($s, $o++, 8) -= ord, $l -= ord for split //, $r;
return ($s, $l);
}
sub freq_to_rx {
my $rx = join "", @val[map ord, split //, shift];
qr/^$rx$/;
}
sub expand {
return @{ +shift } if @_ == 1;
return map { my $f = $_; map "$f $_", expand(@_) } @{ +shift };
}
_____________________________________________________
Jeff[japhy]Pinyan:
Perl,
regex,
and perl
hacker, who'd like a job (NYC-area)
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;