# Written by Ryan Nauman
# 09/05/2007
# scramble.pl
#
# Tool used for Scrabble to determine if you have a Bingo.
# Does 3 things
# 1) Displays what Bingoes you can create from your rack.
# 2) Displays what Bingoes you can create by adding a single
# additional letter
# 3) Displays all smaller possible words you can create.*
#
# *Coming soon...
#
# Example usage:
# perl scramble.pl aniters
#
# Can accept more than one rack at command prompt
# perl scramble.pl aniters ambosaa
#
# Requirements:
# TWL06.txt (or any other dictionary, so long you modify the first line of code)
# Can be found at http://67.19.18.90/twl.zip
#
open(INFILE, '<', 'c:\Perl-5.5\scripts\TWL06.txt') or die "Can't open TWL06.txt: $!";
my @WORDS = ; # 'slurp' the input file into an array
chomp @WORDS; # Remove the trailing '\n' characters from the entries
for my $arg (@ARGV) # Runs loop for each element in the special array called @ARGV which is a list of parameters passed in via the command line
{
my $sorted = alphabetize($arg); # Sorted word read from command line parameter
# Regular anagrams #
my @anagrams = anagram($sorted);
print "Anagrams for rack \'$arg\':\n";
for my $anagram (@anagrams)
{
print " -$anagram\n";
}
# Wildcard anagrams #
my $count = 0;
@alphabet = split ( //, "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
for my $letter (@alphabet)
{
my $wildanagram = alphabetize($sorted . $letter);
my @wildanagrams = anagram($wildanagram);
if ($#wildanagrams > 0)
{
if ($count == 0)
{
print "\nWildcard anagrams for rack \'$arg\':\n";
}
print "+$letter\n";
for my $wildanagram (@wildanagrams)
{
print " -$wildanagram\n";
}
$count++;
}
}
if ($count == 0)
{
print "\nNo wildcard anagrams found!";
}
# Smaller anagrams (no wildcards) #
# Coming soon...
}
# ------------------- Functions ------------------- #
# alphabetize
# params -> $word
# returns -> sorted $word
sub alphabetize
{
my $word = uc(shift); # Grabs the word passed into our function
return join('', (sort split (//, $word))); # Complex statement that first splits our word
# into a sorted array of characters by using an empty
# regexp. Then joins this array back into a string.
}
# anagram
# params -> $word
# returns -> all possible anagrams of $word in the array @matches
sub anagram
{
my $word = shift;
my @matches;
for my $match (@WORDS)
{
if ((length($match) == length($word)) && (alphabetize($match) eq alphabetize($word)))
{
push @matches, $match;
}
}
return @matches;
}