#!perl -wl use strict; $_ = shift @ARGV || "CLEANSE"; our (%kw, %words); my ($match, @matches); my $future = {"" => ""}; sub sortword { return join("", sort pop=~/./g) } sub dissect { my %h; map $h{$_}++, split(//,pop); return \%h } sub scrub { # make sure a word isn't longer than our # kw or has chars kw doesn't my $w = shift @_; return 0 if length($w) > $kw{"len"}; my $d = dissect($w); map { return 0 if !defined($kw{"d"}->{$_}) || $kw{"d"}->{$_} < $d->{$_} } keys %$d; return 1; } sub process { # run one iteration through %words my ($cand, @match, %future) = @_; for my $w (keys %words) { for my $c (keys %$cand) { my $len = length($cand->{$c}) + $words{$w}; next if $len > $kw{"len"}; my $nk = "$c:$w"; $future{$nk} = sortword($cand->{$c} . $w); if ($len == $kw{"len"}) { push @match, $nk if $future{$nk} eq $kw{"kw"}; delete $future{$nk}; } } } return (\@match, \%future); } %kw = ( "word" => $_ ,"len" => length($_) ,"kw" => sortword($_) ,"d" => dissect($_) ); map { chomp; $words{$_} = length() if scrub($_); } <DATA>; while (keys %$future) { ($match, $future) = process($future); push @matches, @$match; } print "anagrams for " . $kw{"word"} . ":"; map print, @matches; __DATA__ SEE SCALENE CLAN EEL BOB PIZZA SCAN MONKS PERL
perl -e'$_="nwdd\x7F^n\x7Flm{{llql0}qs\x14";s/./chr(ord$&^30)/ge;print'
In reply to Re: OT: How to find anagrams?
by pizza_milkshake
in thread OT: How to find anagrams?
by Cody Pendant
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |