Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
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 chanting in the Monastery: (12)
As of 2015-07-06 22:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (83 votes), past polls