perl_wizard2 has asked for the wisdom of the Perl Monks concerning the following question:

You know those puzzles where you answer 5 questions, then take certain letters out of the answers to re-arrange thos letters into a new word?

Once you know the letters that are needed for the last word, is there a good perl program to show you all the combinations of dictionary words that are possible?

I did the code below, but I've got to wonder, is there a better way? 

cat linux.words | perl -e 'while(<>) {if(/^[rgtnaie][rgtnaie][rgtnaie]
+[rgtnaie][rgtnaie][rgtnaie][rgtnaie][rgtnaie][rgtnaie]$/) { %letters 
+= (); chomp; $word = $_; while($letter = chop) {$letters{$letter}++;}
+ if(($letters{'e'} == 2) && ($letters{'t'} == 2) && ($letters{'i'} ==
+ 1) && ($letters{'n'} == 1) && ($letters{'g'} == 1) && ($letters{'r'}
+ == 1) && ($letters{'a'} == 1)) {print "FOUND: $word\n"; }}}'

[download]

The code above would find all words that have 2 e's, 2 t's, and one each of i, n, g, r and a. The one I found was 'integrate'.

TIA,

Jason

Edit Masem 2001-08-06 - Title appended with "for finding anagrams"

Replies are listed 'Best First'.
Re: Is there a better way?
by tachyon (Chancellor) on Aug 04, 2001 at 00:39 UTC

    Here is a shorter way using the power of grep. All we do is sort our available letters and compare them to the sorted letters of our dictionary words. 

    @dict = qw (foo oof fff bar baz);
$letters = 'ofo';
$sorted  = join '', sort split//, $letters;

@words = grep{ $sorted eq join '', sort split// }@dict;

print "@words";

    [download]

    Update

    As pointed out by dragonchild my first post which used this test in the grep /^[$letters]{$length}$/ instead of the $sorted test would pick up all sorts of incorrect stuff. I realised this just after I posted but it was too late.... ++ for being far more on the ball than me.

    Update 2

    For efficiency you could add another test to the grep like this: 

    @dict = qw (foo oof fff bar baz);
$letters = 'ofo';
$sorted  = join '', sort split//, $letters;
$length  = length $letters;

@words = grep{ $length == length  and 
               $sorted eq join '', sort split// }@dict;

print "@words";

    [download]

    The purpose of the $length test is to immediately fail if the length of our dict word is wrong thus avoiding the overhead of a sort as the match is bound to fail. Fixed classic = instead of == newbie Perl error thanks to Falkkin

    cheers

    tachyon

    s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

[reply]
[d/l]
[select]
      That doesn't quite do it. You pick up 'ffo' as well. What is needed is a way of saying "Give me all the words with 2 o's and 1 f."

      ------
      /me wants to be the brightest bulb in the chandelier!

[reply]

        Realised that just after I posted and added a fix, hoping no one would notice - damn caught out ! :-)

        cheers

        tachyon

        s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

[reply]
Re: Is there a better way?
by dragonchild (Archbishop) on Aug 04, 2001 at 00:45 UTC
    Well, you can improve your regex to /^[rgtnaie]{9}$/. If you wanted to, you could also do something like: 

    my $charclass = "aeginrt";
my $num = 9;
if (/^[$charclass]{$num}$/) {
# rest of code here

    [download]
    That way, you can easily change what it is you're working with. Of course, that doesn't help you with determining if it has the right amount of the right letters. So, you could do something like: 

    my %num_letters = ( a => 1,
                    e => 2,
                    g => 1,
                    i => 1,
                    n => 1,
                    r => 1,
                    t => 2,
                  );

my $charclass = join "", keys %num_letters;
my $num_chars = 0;
$num_chars += $num_letters{$_} foreach keys %num_letters;

open DICT, "<linux.words";
WORD:
while (my $word = <DICT>) {
    my %letters = %num_letters;
    chomp $word;
    next WORD unless $word =~ /^[$char_class]{$num_chars}$/;

    while (my $letter = chop($word)) {
        $letters{$letter}--;
    }
    foreach my $letter (keys %letters) {
        next WORD if ($letters{$letter} != 0);
    }
    print "Found $word\n";
}
close DICT;

    [download]

    ------
    /me wants to be the brightest bulb in the chandelier!

[reply]
[d/l]
[select]
Re: Is there a better way?
by chipmunk (Parson) on Aug 04, 2001 at 00:57 UTC
    dragonchild's already provided a good Perl solution, so I'll just point out that you can find lots of resources online for solving anagrams. For example, Yahoo has an anagrams category.
[reply]
Re: Is there a better way?
by runrig (Abbot) on Aug 04, 2001 at 03:25 UTC
    Borrowing tachyon's example, and leaving out the rle function definition for brevity, many examples of which can be borrowed and modified from here (This solution is probably better if you were going to look for many letter lists as opposed to just one):
    @dict = qw (foo oof fff bar baz);
$letters = 'ofo';

my %dict;
push @{$dict{rle(sort split '',$_)}}, $_ for @dict;
$words = $dict{rle(sort split '',$letters)} || [];
print "$_\n" for @$words;

    [download]
    Update: Realized you don't actually need the rle function:
    my %dict;
push @{$dict{join('', sort split '',$_)}}, $_ for @dict;
$words = $dict{join('', sort split '',$letters)} || [];
print "$_\n" for @$words;

    [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom