#!/usr/bin/perl -w
#scrabbler.pl - A program to find suitable words while playing Scrabbl
+e
#By Collin Winter d_cove@hotmail.com
#
#Options:
#    -f : Means that this is the first turn.
#         This will skip the request for base letters (see below),
#         since there will be none.

use strict;

#Replace /usr/share/dict/linux.words with the path to the words file o
+n your system.
open WORDLIST, "/usr/share/dict/linux.words" or die "Unable to open wo
+rd list: $!\n";
my @wordlist=<WORDLIST>;
close WORDLIST;

#Find out what letters the player has, and make a hash of their freque
+ncy
print "Your letters: ";
chomp(my $master_letters=<STDIN>);

#Removes any non-alphacharacters that may have been used to separate t
+he letters;
$master_letters=~s/[^A-Za-z]//g;

my $base_letters;
my %letter_freq;
#If this is the first turn of the game, then there be no base letters 
+to use, so we need to obtain one
if($ARGV[0] eq '-f'){
    $base_letters=substr($master_letters,0,1);
    $master_letters=substr($master_letters,1,length($master_letters)-1
+);
}

for (split(//,$master_letters)){
    $letter_freq{$_}++;
}

#"Base letters" are tiles that are already out on the board and availa
+ble for to build words on.
#One base letter will be added at a time to $letters, and valid words 
+looked up for that combination.
if(!$ARGV[0] || $ARGV[0] ne '-f'){
    print "Base letters: ";
    chomp($base_letters=<STDIN>);
    $base_letters=~s/[^A-Za-z]//g;
}

#"Initial omission level" is the number of characters from $letters th
+at maybe left out of a word.
#A value of 0 will return only words that contain all of the character
+s in $letters.
#Setting it to 1 will return all words that contain every letter and a
+ll words with all letters except one, etc
print "Initial omission level: ";
chomp(my $master_om_level=<STDIN>);

my @possible_words;
my @valid_words;

foreach my $base (split(//,$base_letters)){
    my $om_level=$master_om_level;

    #Add the current base letter to the string and to the letter frequ
+ency hash
    my $letters=$master_letters.$base;

    $letter_freq{$base}++;
    my $do_it_again=1;

    #Repeat the word-evaluation until a word is found.
    while($do_it_again==1){
        
        #This is done like it is so that $max_length and $min_length c
+an be modified later.
        my $max_length=length($letters)+1;
        my $min_length=length($letters)-$om_level+1;
        
        #Thanks to mt2k for suggesting this kind of for loop.
        for my $i ($min_length .. $max_length){
            push(@possible_words,grep(length($_)==$i,@wordlist));
        }
        
        foreach my $word (@possible_words){
            my %this_freq=%letter_freq;
            my $this_word=$word;
            my $key_count=0;
            my $remaining_oms=$om_level;
        
            #Repeat until either:
            # a) there are no more letters to check for,
            # b) all keys in %letter_freq have been used, or
            # c) the word has too many omissions to be used.
            while((length($this_word)>1) && ($key_count<=(scalar keys 
+%letter_freq)-1) && ($remaining_oms>=0)){
                my $key=(keys %letter_freq)[$key_count];
        
                #If the current letter isn't in the word, then
                #There is one less omission remaining for this word.
                if($this_word!~/$key/i){
                    $remaining_oms--;
                }
        
                if(($this_freq{$key} > 0) && ($this_word=~/$key/i)){
            
                    if($this_word!~/$key/i){
                        $this_freq{$key}--;
                    }
            
                    while($this_freq{$key}>0){    
                        $this_freq{$key}--;
                        $this_word=~s/$key//i;
                    }
                }
                $key_count++;
            }
            
            if(length($this_word)==1){
                push(@valid_words,$word);
            }
        }
        
        #If no words are found at your current omission level, the sea
+rch
        #will be automatically enlarged until at least one word is ret
+urned.
        print $#valid_words+1," results with $om_level allowed omissio
+ns for base \'$base\'";
        
        if(!$valid_words[0]){
            @possible_words=();
            print "; Expanding search...\n";
            $om_level++;
            $max_length=$min_length--;
        }
        if($valid_words[0]){
            print ":\n",@valid_words;
            @valid_words=();
            $do_it_again=0;
        }
    }

    #Remove the current base from the letter frequency hash
    $letter_freq{$base}--;
}
exit;
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.