#!/usr/bin/perl
print "Content-type:text/html\n\n";
print "172819 randomly generated words and what they are worth in Scrabble", "\n";
print qq~
~;
print qq~
~;
print qq~
~;
## @dictionary named biglog.txt get here... http://code.google.com/p/dotnetperls-controls/downloads/detail?name=enable1.txt
##open(DATA," }; #### the / may need to be \ when using binmode and add ":raw" into
close (MYFILE);
@dictionary = split(" ", $allwords);
my $wildcard = '_';
my $words_limit = 25; # display the lowest scoring words, up to this many
my %best_letters = map { $_ => 0 } ('a' .. 'z');
print "English alphabet best letters= ", %best_letters, "\n";
print qq~
~;
#my @dictionary = sort ;
chomp @dictionary; # set up dictionary
##print @dictionary, "\n";
# Scrabble distribution
my %letter_distribution = qw(
a 9 b 2 c 2 d 4
e 12 f 2 g 3 h 2
i 9 j 1 k 1 l 4
m 2 n 6 o 8 p 2
q 1 r 6 s 4 t 6
u 4 v 2 w 2 x 1
y 2 z 1
);
print "Scrabble letter tiles in a set...", %letter_distribution, "\n";
print qq~
~;
# Scrabble points
##hash of Key => value pairs "a" => "1", "b" => "3",
my %letter_points = ( "a" => "1", "b" => "3", "c" => "3", "d" => "2", "e" => "1", "f" => "4", "g" => "2", "h" => "4", "i" => "1", "j" => "8", "k" => "5", "l" => "1", "m" => "3", "n" => "1", "o" => "1", "p" => "3", "q" => "10", "r" => "1", "s" => "1", "t" => "1", "u" => "1", "v" => "4", "w" => "4", "x" => "8", "y" => "4", "z" => "10" );
my @letter_points = %letter_points;
##my %letter_points = ( "a", 1, "b", 3, "c", 3, "d", 2, "e", 1, "f", 4, "g", 2, "h", 4, "i", 1, "j", 8, "k", 5, "l", 1, "m", 3, "n", 1, "o", 1, "p", 3, "q", 10, "r", 1, "s", 1, "t", 1, "u", 1, "v", 4, "w", 4, "x", 8, "y", 4, "z", 10 );
print " %letter_points=", " From ", $letter_points{a}, " to ", $letter_points{q}, " depending on Scrabble rules.", "\n"; ## print value of Key g should be 2
print qq~
~;
# handle arguments
my $wordchoice = int(rand(172819)); ## 0-172819
my $word_pattern;
$word_pattern = $dictionary[$wordchoice]; ## was $ARGV[0] word to solve
$word_pattern = lc($word_pattern);
chomp $word_pattern; ## Use $wildcard for unknown letters
if ($word_pattern eq "") {
$word_pattern = $wildcard;
}
die "Invalid word pattern\n" unless ($word_pattern =~ /^[_a-z]+$/);
print " ,Dictionary word choice=", $wordchoice, "=", $word_pattern, "\n";
print qq~
~;
my @best_letters = ("B","T","P","G","N","M","Y","H","E","L","C","F","J","A","K","I","U","V");
my %best_letters = @letter_points;
print " ,BEST letters as a rule=", @best_letters, "\n";
print qq~
~;
my $let = int(rand(17)); ## 0-17
my $negative_letters; ## letters guessed that were not in word
$negative_letters = $best_letters[$let];
print " ", $let, " Computer choose a letter=", $negative_letters, "\n";
print qq~
~;
# search for matching words
##my $a = "";
##my $b = "";
##my @possible_words = sort { score_word($a) <=> score_word($b) }
grep { length($_) == length($word_pattern) && pattern_word($word_pattern, $_) } @dictionary;
##print " possible words=", @possible_words, " ", $points, " ", $_, "\n";
##print qq~
~;
##print " a and b ", $a, " ", $b, "\n";
# determine letter counts (max increment 1 for a letter in a given word)
foreach (@best_letters) {
$best_letters{$_} foreach (keys %{{ map { $_ => 1 } split(", ", $_) }});
##print " best letters=", $_, "\n";
}
# display best letters to guess in order of decreasing likelihood of matching
print " WORST letters to guess next:", "\n";
print uc("$_")
foreach (grep { $best_letters{$_} > 0 && index($word_pattern, $_) < 0 }
sort { $best_letters{$b} cmp $best_letters{$a} } keys %best_letters);
##print "\n";
print qq~
~;
my $points = 0;
my @l = split ("", $word_pattern);
foreach (@l) {
##print $_, "\n";
print uc("$_"), "=", $letter_points{$_}, " ", "\n";
$points = $points + $letter_points{$_};
}
print qq~
~;
print "Word=", uc("$word_pattern"), " and in points=", $points, "\n";
# display possible words in order of increasing word score (words with more common letters first)
##print "Top $words_limit words are:", "\n";
##print uc(join("\n", splice(@dictionary, 0, $words_limit))), "\n";
print qq~
~;
##sub score_word {
##my $word = $word_pattern;
##my $points = 0;
##my @letter_points = split (", ", $word);
##$points += $letter_points{$_} foreach @letter_points;
##return $points;
##}
sub pattern_word {
my ($pattern, $word) = @_;
my %deny_letters = map { $_ => 1 } split("", $pattern);
my @p = split ("", $pattern);
my @w = split ("", $word);
return 0 if (scalar(@p) != scalar(@w));
foreach (@p) {
my $word_letter = shift @w;
return 0 if ($_ ne $word_letter && $_ ne $wildcard);
return 0 if ($_ ne $word_letter && defined $deny_letters{$word_letter});
return 0 if (defined $negative_letters{$word_letter});
}
return 1;
}