CUFP
japhy
<div class="pmsig"><div class="pmsig-1936">
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".
<code>
#!/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 };
}
</code>
<p>
<font color="#ff0000">_____________________________________________________</font><br>
Jeff<tt>[<font color="#0000ff"><A HREF="/index.pl?node=japhy&lastnode_id=1072">japhy</A></font>]</tt>Pinyan:
<a href="http://www.pobox.com/~japhy/modules/">Perl</a>,
<a href="http://www.pobox.com/~japhy/docs/book.html">regex</a>,
and <a href="http://lists.perl.org/showlist.cgi?name=perl5-porters"><i>perl</i></a>
<a href="http://foldoc.doc.ic.ac.uk/foldoc/foldoc.cgi?query=hacker">hacker</a>, who'd like a <b>[http://www.pobox.com/~japhy/resume.txt|job]</b> (NYC-area)
<br>
<tt>s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;</tt>
</div></div>