Dear monks,

In the latest issue of The Perl Review, Kevin Jackson-Mead presented a Perl implementation of the curious word game Jotto. You may read more about this in The Perl Review, but here is a simplified explanation:


Jotto is a two-player game where each player attempts to guess the other’s secret five-letter word. A player scores a guess based on the number of letters it has in common with the secret word. This is a sample game:

trios 1
false 3
slang 2
swell 2
passe 3
abase 2
pleat 4
paler 5
pearl correct

The sample game has the property that each guess could possibly be the secret word based on the previous guesses and scores. For example, ‘swell’ scores 1 with trios, 3 with ‘false’, and 2 with ‘slang’. Based on the information from the first three guesses, ‘swell’ could have been the secret word.


I decided this game is cool and started hacking away (as they say, "He who reinvents the wheel, understands how the wheel works"). Here is my version that plays the game, it is commented, short and efficient (or so I hope) relatively to the original version. It allows both modes of play - computer guessing and human guessing:

Note: Thanks to everyone in this node, and especially bart for helping me implement an efficient and correct score function.
#!/usr/local/bin/perl -w use strict; srand(time); my $words_equal = 999; # Compute the "score" of two words - how many characters # they have in common. # # Returns $words_equal if the given words are equal, otherwise # returns the number of common characters # sub score { my ($word1, $word2) = @_; my %bag; my $score = 0; return $words_equal if ($word1 eq $word2); foreach (split '', $word1) { $bag{$_}++; } foreach (split '', $word2) { if ($bag{$_}) { $bag{$_}--; $score++; } } return $score; } # Returns a random element from a given array # sub random_arr_elem { my @arr = @{$_[0]}; return $arr[rand() * ($#arr + 1)]; } # Given the name of a dictionary file, picks a random word from it # sub pick_random_word_from_file { my $filename = $_[0]; open(FH, $filename) or die "Can't open $filename: $!\n"; my @words = <FH>; my $the_word = random_arr_elem(\@words); chomp $the_word; return $the_word; } # "Refines" an array of words # Given an array of words, a guess, and the score of that guess, # removes all array elements that don't get the same score with # the guess # sub refine_words_array { my @arr = @{$_[0]}; my $guess = $_[1]; my $score = $_[2]; my @res_arr; foreach (@arr) { push(@res_arr, $_) if ($score == score($guess, $_)); } return \@res_arr; } # Play a human guess game - the human tries to guess a word # # Asks for a dictionary file. Picks a random word from this # file, and lets the human guess # sub human_guess_game { print "Specify dictionary file: "; my $dict_file = <>; chomp $dict_file; my $word = pick_random_word_from_file($dict_file); print "\n** $word **\n"; while (1) { print "\nEnter a guess: "; my $guess = <>; chomp $guess; if (score($word, $guess) == $words_equal) { print "\nCongrats, you guessed it !\n\n"; last; } else { print score($word, $guess); } } } # Play a computer guess game - the computer tries to guess a work # # Asks for a dictionary file and starts guessing words. The user # must supply the score for each guess # sub computer_guess_game { print "If I guess correctly, please enter $words_equal as the scor +e\n"; print "Specify dictionary file: "; my $dict_file = <>; chomp $dict_file; # Get a list of words from the dictionary file # open(FH, $dict_file) or die "Can't open $dict_file: $!\n"; my @words = <FH>; chomp(@words); my $guess = random_arr_elem(\@words); while (1) { print "My guess is: $guess\n"; print "Score: "; my $score = <>; chomp $score; if ($score == $words_equal) { print "\nYay, I won !!\n"; last; } my $ref = refine_words_array(\@words, $guess, $score); @words = @$ref; if (scalar(@words) == 0) { print "\nNo suitable word in the given dictionary !!\n"; last; } print "Legal words left: " . scalar(@words) . "\n"; $guess = random_arr_elem(\@words); } }

Update: The code, if run as it is, does nothing. You can call human_guess_game or computer_guess_game if you wish to play in one of the ways. Thanks to artist for the note.

In his article Kevin talked about the algorithm he uses to guess words (in computer-guess) mode. This seems to be the same algorithm I'm using, you may call it the "naive algorithm" - after each score given by a human for a guess, refine_words_array removes all unsuitable words.
It converges to a solution pretty quickly this way, and is optimal in some senses - on each iteration it takes a random guess from a list of ALL LEGAL words (in the sense that no word in this list is illegal), that are also the ONLY LEGAL WORDS (in the sense that there are no other legal words).
Better algorithms may be devised, but they will be heuristic - using our knowledge of the game to try and make better guesses. For example, trying to apply the "most constraining" heuristic - one that is likely to eliminate most words in the next refinement.
Thinking about better algorithms for this game is probably my next step. It does sound interesting !

Kind regards

In reply to The Jotto word game by spurperl

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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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, details, 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, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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.