Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Re^2: Hangman - Hanging with Friends

by Anonymous Monk
on May 13, 2012 at 07:33 UTC ( #970248=note: print w/ replies, xml ) Need Help??


in reply to Re: Hangman - Hanging with Friends
in thread Hangman - Hanging with Friends

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


Comment on Re^2: Hangman - Hanging with Friends
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://970248]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (7)
As of 2014-10-02 04:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    What is your favourite meta-syntactic variable name?














    Results (48 votes), past polls