Cheating Hangman

December 27, 2011

We reuse many of the functions from the prior exercise: esc, cls, goto, erase-eol, display-gibbet, display-man, display-word, display-alphabet, display-answer, display-message, read-words, get-key, and get-letter. And much of the game logic is the same; here’s the top-level hangman function:

(define (hangman)
  (rand (time-second (current-time)))
  (let ((words (read-words "/usr/share/dict/words")))
    (let play ((answers (keep-len (randint 4 13) words)))
      (let loop ((man 0) (word (make-list (length (car answers)) #\_))
                 (answers answers)
                 (alphabet (string->list "abcdefghijklmnopqrstuvwxyz")))
        (display-man man) (display-word word) (display-alphabet alphabet)
        (cond ((not (member #\_ word))
                (when (display-message #t (car answers))
                  (play (keep-len (randint 4 13) words))))
              ((= 6 man)
                (when (display-message #f (fortune answers))
                   (play (keep-len (randint 4 13) words))))
              (else (let ((c (get-letter alphabet)))
                        (lambda () (cheat word answers c))
                        (lambda (ok? word answers)
                          (loop (if ok? man (+ man 1))
                                word answers
                                (remove c alphabet)))))))))))

In the previous exercise, play chose an answer word with (fortune words). In this exercise, answers is a list of possible words and is chosen with (keep-len (randint 4 13) words). The rest of the change is at the end, where the function-call (cheat word words c) takes the current status of the player’s guessed word, the remaining list of possible words, and the player’s current input character and returns three values: ok?, which is #t if the player’s guess is accepted into the current word and #f otherwise, the new status of the word, and the remaining list of possible answers. Here is cheat:

(define (cheat word words c)
  (let ((xs (car (sort (lambda (x y) (> (length x) (length y)))
              (group (sort (lambda (x y) (lt? (car x) (car y)))
                (map (lambda (w) (cons (places c w) (list w)))
    (values (pair? (car xs))
            (let loop ((word word) (ks (car xs)) (k 0) (zs (list)))
              (cond ((null? word) (reverse zs))
                    ((and (pair? ks) (= k (car ks)))
                      (loop (cdr word) (cdr ks) (+ k 1) (cons c zs)))
                    (else (loop (cdr word) ks (+ k 1)
                                (cons (car word) zs)))))
            (cdr xs))))

The values clause accumulates the response; the cheating occurs in the binding of xs. The map calls a function places that turns each word in the current answer-list into a two-element list of lists that has a list of the places where the player’s input letter occurs followed by the list of letters in the word; for instance, with the word “hello” and input character “l”, places returns the list ((2 3) (#\h #\e #\l \#l #\o)). Then sort brings together words with like place-lists, group groups them, the groups are sorted by descending length, and car picks the longest, which gives the cheating referee the most possibilities for cheating at the next letter. Here are the three helping functions places, lt?, and group:

(define (places c word) ; places where c appears in word
  (let loop ((word word) (p 0) (ps (list)))
    (cond ((null? word) (reverse ps))
          ((char=? (car word) c)
            (loop (cdr word) (+ p 1) (cons p ps)))
          (else (loop (cdr word) (+ p 1) ps)))))

(define (lt? xs ys) ; compare two lists
  (cond ((and (null? xs) (null? ys)) #f)
        ((null? xs) #t) ((null? ys) #f)
        ((= (car xs) (car ys))
          (lt? (cdr xs) (cdr ys)))
        (else (< (car xs) (car ys)))))

(define (group xs)
  (let loop ((xs (cdr xs)) (k (caar xs))
             (v (list (cadar xs))) (zs (list)))
    (cond ((null? xs) (reverse (cons (cons k v) zs)))
          ((equal? (caar xs) k)
            (loop (cdr xs) k (cons (cadar xs) v) zs))
          (else (loop (cdr xs) (caar xs) (list (cadar xs))
                  (cons (cons k v) zs))))))

All that’s left is keep-len, which is used in the initialization of the list of answers:

(define (keep-len n words)
  (filter (lambda (w) (= (length w) n)) words))

The complete code is assembled at, including filter, all?, read-line, rand, randint, and fortune from the Standard Prelude.


Pages: 1 2

4 Responses to “Cheating Hangman”

  1. I decided to make a quick prototype in python this time, just to illustrate the new algorithm. The user interface is very rudimentary with the gibbet replaced by a numerical indicator. Following the hint in the exercise I have also implemented the same method of choosing the largest set of possible answers. I just wonder if the size of the set is the best measure; maybe something like remaining letter diversity would be better.

    import re
    import random
    from collections import defaultdict
    pat_small = re.compile(r"[a-z]+$")
    f = open("wordlists/english.0")
    words = f.readlines()
    words = [ w.rstrip() for w in words if pat_small.match(w) ]
    print("Using dictionary with %d lowercase words" % len(words))
    len2words = defaultdict(list)
    for w in words:
    while True:
        length = random.choice(list(len2words.keys()))
        possible_answer = len2words[length]
        letters = [ chr(c) for c in range(ord('a'), ord('z') + 1) ]
        mask = [ '_' ] * length
        level = 0
        while level < LEVELS:
            print(" ".join(mask))
            if '_' not in mask:
            ch = input("Level %d/%d. Letter: " % (level, LEVELS))
            if ch not in letters:
                print("Not a letter or letter already used")
            d = defaultdict(int)
            dl = defaultdict(list)
            for w in possible_answer:
                t = tuple([ int(w_ch == ch) for w_ch in w])
                d[t] += 1
            best = max(zip(d.values(), d.keys()))
            best_mask = best[1]
            possible_answer = dl[best_mask]
            if 1 not in best_mask:
                print("No %s in the word" % ch)
                level += 1
            for i, m in enumerate(mask):
                if best_mask[i]:
                    mask[i] = ch
        if level == LEVELS:
            print("Word was: %s" % possible_answer[0])            
  2. […] have created a Python solution to the cheating hangman problem and posted it there in the comments. I have a follow-up question though. Let us assume both […]

  3. “… the groups are sorted by descending length, and car picks the longest, which gives the cheating referee the most possibilities for cheating at the next letter.”

    I disagree with this statement. If the remaining words are [ abd, acd, abe, ace, bbb, ccc, ddd, eee, fff ] and the player picks letter “a”, the referee actually has more possiblilities to cheat with the shorter [ abd, acd, abe, ace ] list, as I described elsewhere.

    I was trying to compute which side has the winning strategy for a given word length. For the English alphabet the search space is too large to process effectively, however. Perhaps someone has a better idea than the straightforward consideration of every letter and every word type in each step?

  4. My example above is wrong: instead [ ‘abd’, ‘acd’, ‘abe’, ‘ace’, ‘dde’, ‘ded’, ‘edd’, ‘ede’, ‘eed’ ] works as intended.

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: