#!/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~<BR>~;
print qq~<BR>~;
print qq~<BR>~;
## @dictionary named biglog.txt get here... http://code.google.com/p/dotnetperls-controls/downloads/detail?name=enable1.txt
##open(DATA,"<biglog.txt");

open (MYFILE, 'biglog.txt');   # Internal image numbers for verification to erase from acqchanger.pl
my $allwords = do { local $/; <MYFILE> };  #### the / may need to be \ when using binmode and add ":raw" into <MYFILE>
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~<BR>~;
#my @dictionary = sort <DATA>;
 
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~<BR>~;
# 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~<BR>~;
# 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~<BR>~;

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~<BR>~;
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~<BR>~;
# 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~<BR>~;
##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~<BR>~;


my $points = 0;
my @l = split ("", $word_pattern);
foreach (@l) {
##print $_, "\n";
print uc("$_"), "=", $letter_points{$_}, " ", "\n";
$points = $points + $letter_points{$_};
}

print qq~<BR>~;
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~<BR>~;

##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;
}