It sounds like you want a list of all the permutations of the letters in a certain word. CPAN has plenty of modules to do just that, such as List::Permutor, Algorithm::Permute, and so on.

Once you gt the permutations, you check those against a list of valid words. How you get that is up to you, but it's bascially a hash (or database) lookup.

Words often contain repeated letters so you'd be better off using Algorithm::Loops since it's permutation routines handle duplicate items unlike Algorithm::Permute or List::Permutor (I see no List::Permute on CPAN), as far as I could see.

- tye        

I'm not sure what you mean by duplicate items. List::Permutor uses each element of the list and doesn't discard duplicates, which is probably what the original poster wants. If that's not the case and he wants only unique letters, a quick filter discards duplicates before he gets started.

--
brian d foy <brian@stonehenge.com>
Subscribe to The Perl Review

If you're looking for a canned solution, try Math::Combinatorics (no personal experience).

However, this is a pretty fun problem to code. My brain finds it easiest to think of combinations recursively. For a list of letters, if the desired word length (n) is 1, just return the list. Otherwise iterate through each letter, and find all of the words of length that start with that letter (the current letter appended by all words found in the remaining letters, of length n - 1). Then find the list of words of length n that don't include the current letter. That's it. :) Pseudo code follows (let me know if you'd like a real Perl version; I have one kicking around in my sandbox, as well as a nonrecursive one).

function wordz ($n, @list ) {
  if ( n == 1 ) {
    return @list
  }
  for $current_letter ( @list ) {
    push @words, map { $current_letter . $_ }
      wordz( $n - 1, @letters_sans_current_letter;
    push @words, wordz( $n, @letters_sans_current_letter);
  }
  return @words;
}

Hi.

If you have the code available, I'd love to see the Perl code.

So what this is doing is..

@list contains the scrambled letters, ie: @list = (aesfght);

Then for each letter, we push it into @words following the next iterated letter. From here, I get kind of lost.

Thanks!

# takes an integer word length and a list of letters,
# returns a list of words of the integer length
#
{ my %cache;
  sub wordz {
    my ( $n, @letters ) = @_;
    my $cache_key = join( '', @letters, $n );

    return if $n > @letters;
    return @letters if $n == 1;

    return @{ $cache{ $cache_key } } if exists $cache{ $cache_key };

    my @wordz;
    for ( my $i = 0; $i <= $#letters; $i++ ) {

      push @wordz, map { $letters[ $i ] . $_ }
        wordz( $n - 1, @letters[ 0 .. $i - 1 ],
                       @letters[ $i + 1 .. $#letters ] );

      my @o = wordz( $n, @letters[ $i + 1 .. $#letters ] );

      push @wordz, @o;
    }
    $cache{ $cache_key } = \@wordz;

    return @wordz;
  }
}
[download]

It is also fun to do this problem non-recursively. If you are interested in that, I also have code (though there are different possible approaches).

-Colin.

WHITEPAGES.COM | INC

A very simple linear matching algorithm. Something like the following:

use strict;
use warnings;

my $letters = 'balphe_';
my (%lhash, @solutions, $blanks, $bcopy, $l);

$blanks++ while $letters =~ s/[^a-z]//;
$lhash{$_}++ for split //, $letters;

while (<DATA>) {
    $bcopy = $blanks;
    my %whash; chomp; $whash{$_}++ for split //;

    for $l (keys %whash) {
        no warnings;
        last if $lhash{$l} < $whash{$l} &&
            ($bcopy -= $whash{$l} - $lhash{$l}) < 0;
    }
    push @solutions, $_ if $bcopy > -1;
}

print join "\n",
    sort {length($b) <=> length($a) || $a cmp $b}
    @solutions;

__DATA__
alpha
beta
gamma
delta
epsilon
[download]

Hi.

Thank you for your help. With your code there, it appears it does exactly what I needed. But when I changed it to read in my partial dictionary file, it started to throw out words that it couldn't have matched.

#!/usr/bin/perl

use strict;
use warnings;
use CGI qw/:standard/;
print header, start_html();

my $letters = 'balphe_';
my (%lhash, @solutions, $blanks, $bcopy, $l);

$blanks++ while $letters =~ s/[^a-z]//;
$lhash{$_}++ for split //, $letters;

open (DICT, "dict/dict1.txt") or die "error :!";

while (<DICT>) {
    $bcopy = $blanks;
    my %whash; chomp; $whash{$_}++ for split //;

    for $l (keys %whash) {
        no warnings;
        last if $lhash{$l} < $whash{$l} &&
            ($bcopy -= $whash{$l} - $lhash{$l}) < 0;
    }
    push @solutions, $_ if $bcopy > -1;
}

print join "\n",
    sort {length($b) <=> length($a) || $a cmp $b}
    @solutions;

exit;
__DATA__
alpha
beta
gamma
delta
epsilon
[download]

resulted in:

alephs behalf blahes bleach chapel Alpha Calpe abele abler ables albae
+ aleph amble ample apple babel bagel baled baler bales basel bathe be
+ach belah belay belch belga bella blade blahs blame blare blase blaze
+ bleak blear bleat bleep bohea cable caleb chape cheap chela chelp Ab
+el Ahab Alba Cape Cheb abbe abed abeg abet able ably ache ahem aiel a
+ile alae alap albs alec alee ales alex aloe alps aped aper apes apex 
+apse axel axle babe bade bael bagh baht bail bake bald bale bali balk
+ ball balm bane bare base bash bate bawl bead beak beam bean beat bea
+u beep bela bell belt bema beth bhan bile blab blah
[download]

It matched "behalf" which, with the letters, couldn't have matched. Any suggestions?

Hi.

I've worked with this code over the past few days now and I ran into a problem which can probably be solved if I could figure one thing out.

Could you explain what the following line is doing?

It looks like you're exitting the loop if one letter is less than the same letter in the other hash?

Thank you for your help.

Jon Bentley, in his book Programming Pearls (Addison-Wesley, Reading, Massachusetts: 1986) had a section devoted to almost exactly this problem. Translating his programs (in a mix of awk and C) into Perl should be easy. Try the Programming Pearls web site].

I'll leave it as an exercise.