Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
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 rifling through the Monastery: (6)
As of 2014-08-30 00:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (289 votes), past polls