I made the effort to make this work...
I hope someone uses it :)
#!/usr/bin/perl
print "Content-type:text/html\n\n";
print "172819 randomly generated words and what they are worth in Scra
+bble", "\n";
print qq~<BR>~;
print qq~<BR>~;
print qq~<BR>~;
## @dictionary named biglog.txt get here... http://code.google.com/p/d
+otnetperls-controls/downloads/detail?name=enable1.txt
##open(DATA,"<biglog.txt");
open (MYFILE, 'biglog.txt'); # Internal image numbers for verificati
+on 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 m
+any
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 sol
+ve
$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_patte
+rn, $_) } @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 wor
+d)
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 m
+atching
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_let
+ter});
return 0 if (defined $negative_letters{$word_letter});
}
return 1;
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.