Re: scrambling all letters in a word until all combinations are found

Count the number of each letter you have (minus blanks). Count the number of blanks. Now count the number of each letter in the word you want to check for a match. For each letter that is NOT in the original letter set, decrement the number of blanks by 1. If the number of blanks goes below 0, the word can not be formed by your letter set.

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]

I sort of slapped this together on the spot, so don't expect it to be pretty. It should work, however.

Comment on Re: scrambling all letters in a word until all combinations are found Download Code

Replies are listed 'Best First'.
Re^2: scrambling all letters in a word until all combinations are found by Anonymous Monk on Jan 23, 2006 at 22:26 UTC
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?	[reply] [d/l] [select]
Re^2: scrambling all letters in a word until all combinations are found by Anonymous Monk on Jan 26, 2006 at 05:46 UTC
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.	[reply]