Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

Some of you may play this game on the iPhone or iPad. It's really just Hangman with some twists.

After playing this game for a while, and seeing people offer up "kolhozes" and other obscure words, which in all likelihood are coming from an online word generator, I decided to fight back. Is this cheating? Probably, but since I wrote all the code myself I don't feel bad :)

I'm almost certain this exists somewhere else, perhaps even an online version, but here's what I came up with. The script uses the standard Scrabble points and letter distributions, which are slightly different than what Zynga uses, but I didn't have access to that information.

The 1st argument is the word pattern to solve, and the 2nd optional argument is any letters which you've already guessed that were not in the word.

$ ./hanging-with-friends.pl _o_s wdr Best letters to guess next: B T P G N M Y H E L C F J A K I U V Top 25 words are: FOYS HOYS KOBS KOPS JOES JOTS YOKS JOGS JOBS JOYS EONS IONS LOTS NOES NOUS TOES TONS TOTS GOAS GOES LOGS NOGS TOGS BOAS BOTS
#!/usr/bin/perl use strict ; use warnings ; our $wildcard = '_' ; our $words_limit = 25 ; # display the lowest scoring words, up to this + many our %best_letters = map { $_ => 0 } ('a' .. 'z') ; our @dictionary = sort <DATA> ; chomp @dictionary ; # set up dictionar +y # Scrabble distribution our %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 ) ; # Scrabble points our %letter_points = qw( 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 ) ; # handle arguments our $word_pattern ; $word_pattern = $ARGV[0] or die "No word pattern given. Use $wildcard +for unknown letters.\n" ; $word_pattern = lc($word_pattern) ; chomp $word_pattern ; die "Invalid word pattern\n" unless ($word_pattern =~ /^[_a-z]+$/) ; our %negative_letters = map { $_ => 1 } split(//, $ARGV[1]) if (define +d $ARGV[1]) ; # search for matching words our @possible_words = sort { score_word($a) cmp score_word($b) } grep { length($_) == length($word_pattern) && pattern_word($word_pat +tern, $_) } @dictionary ; # determine letter counts (max increment 1 for a letter in a given wor +d) foreach (@possible_words) { ++$best_letters{$_} foreach (keys %{{ map { $_ => 1 } split(//, $_) +}}) ; } # display best letters to guess in order of decreasing likelihood of m +atching print "Best letters to guess next:\n" ; print uc("$_ ") foreach (grep { $best_letters{$_} > 0 && index($word_pattern, $_) < +0 } sort { $best_letters{$b} <=> $best_letters{$a} } keys %best +_letters) ; print "\n" ; # display possible words with in order of increasing word score (words + with more common letters first) print "Top $words_limit words are:\n", uc(join("\n", splice(@possible_ +words, 0, $words_limit))), "\n" ; sub score_word { my ($word) = @_ ; my $points = 0 ; my @letters = split //, $word ; $points += $letter_points{$_} foreach @letters ; 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 ; } # place your wordlist here. Zynga uses (in addition to some unpublishe +d words of it's own, like "bling" and "jello"): http://code.google.com/p/dotnetperls-controls/downloads/detail?name=en +able1.txt __DATA__ ...

In reply to Hangman - Hanging with Friends by onelesd

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others surveying the Monastery: (5)
    As of 2014-12-27 10:14 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (176 votes), past polls