#!/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;
|