Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re: Hangman Assistant

by Lawliet (Curate)
on Jul 12, 2009 at 05:54 UTC ( #779314=note: print w/ replies, xml ) Need Help??


in reply to Hangman Assistant

Updated code:

#!/usr/bin/perl # Todo: # Narrow possibilties by eliminating words with repeat letters when I +have # guessed one of the repeats letters but the letter I guessed is eithe +r not a # repeat in the target word or is in a different position. # Example: # "rustlers" is a possible word, I guess 'r' and am presented with # "r _ _ _ r _ _ _", meaning the word has two r's, just in the wrong s +pot, # and therefore rustlers should be eliminated. use warnings; use strict; use 5.010; # Simple instructions: # perl $0 "w _ r d" "previousfailedguesses" say $ARGV[0]; my @word = split(/ /, $ARGV[0]); my $guessed = $ARGV[1] ? join('|', split(//, $ARGV[1])) : "0"; say $guessed; my %wordlist; # Hash of word-length arrays open(WORD, '<', '/usr/share/dict/words') or die $!; # Edited to /words + as per request while (<WORD>) { chomp; next if /[^a-z]/; # Lazy way out~ my @chars = split(//, $_); push @{$wordlist{$#chars}}, $_; } close WORD; my @narrowed = @{$wordlist{$#word}}; # Narrowed possible answers by si +ze OUTER: for (my $i = 0; $i <= $#narrowed; $i++) { my @chars = split(//, $narrowed[$i]); # Narrowed by previous guesses if ($narrowed[$i] =~ /$guessed/) { splice(@narrowed, $i, 1); $i--; # Decrement counter now that word has been removed next OUTER; } # Narrowed by matching characters for (my $pos = 0; $pos <= $#word; $pos++) { next if $word[$pos] eq '_'; if ($word[$pos] ne $chars[$pos]) { splice(@narrowed, $i, 1); $i--; next OUTER; } } } # %alphabet holds the number of times a letter occurs within all words # %seen holds the number times a letter occurs in one word my %alphabet; $alphabet{$_} = 0 foreach ('a'..'z'); foreach my $word (@narrowed) { my %seen; $seen{$_} = 0 foreach ('a'..'z'); my @chars = split(//, $word); foreach my $char (@chars) { $alphabet{$char}++ if $seen{$char} == 0; # Limit 1 increment f +or each letter once per word $seen{$char}++; } undef %seen; } say $#narrowed + 1; if ($#narrowed <= 10) { say $_ foreach @narrowed; # Word list say sort { $alphabet{$b} <=> $alphabet{$a} } keys %alphabet; # Mos +t common letter, including ones already guessed } else { # Find how close each letter is to half of the total word possibil +ities to ensure maximum gain every guess after being sorted foreach my $occur (keys %alphabet) { $alphabet{$occur} = abs($#narrowed/2 - abs($alphabet{$occur} - + $#narrowed + 1)); } say sort { $alphabet{$a} <=> $alphabet{$b} } keys %alphabet; }

Updated example:

$ perl hangman.pl "_ _ _ _ _ _ _ _" "" _ _ _ _ _ _ _ _ 0 10588 rantislodecgupmhbyfkwvxzqj
$ perl hangman.pl "_ _ _ _ _ _ _ _" "r" _ _ _ _ _ _ _ _ r 5252 atlnsieodcgumhpbyfkwvxzqjr
$ perl hangman.pl "_ _ _ _ _ _ _ _" "ra" _ _ _ _ _ _ _ _ r|a 2761 tolnsdgueichpmbfykwvxzqjra
$ perl hangman.pl "_ _ _ _ _ t _ _" "ra" _ _ _ _ _ t _ _ r|a 165 isncdolupmghbfykvxejqwtraz
$ perl hangman.pl "_ _ _ _ _ t i _" "ra" _ _ _ _ _ t i _ r|a 17 slhpodungmxytieqbwrajkfvcz
$ perl hangman.pl "_ _ _ _ _ t i _" "ras" _ _ _ _ _ t i _ r|a|s 9 bulletin dietetic eclectic ecliptic elliptic eutectic hypnotic phonetic quixotic ticelpunohxdyqbwrajkgfvmsz
$ perl hangman.pl "_ c _ _ c t i c" "ras" _ c _ _ c t i c r|a|s 1 eclectic tielcwraxdjyukhgfnvmspqbzo

Same amount of guesses as before, but a better way to get there (I think).

I don't mind occasionally having to reinvent a wheel; I don't even mind using someone's reinvented wheel occasionally. But it helps a lot if it is symmetric, contains no fewer than ten sides, and has the axle centered. I do tire of trapezoidal wheels with offset axles. --Joseph Newcomer


Comment on Re: Hangman Assistant
Select or Download Code

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (19)
As of 2015-07-31 20:19 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 (281 votes), past polls