Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

★【Challenge!】【Easy】 Hangman Solver

Name: !WIZardrY9E!UhEWzHM7+1tYUG2 2012-05-14 13:16

⚫ The Game of Hangman

A player guesses letters that are part of a word!
If he has not guessed the complete word before making six (6) mistakes, he has lost!

      _______
     |/      |
     |      (_)
     |      \|/   It is a game over!
     |       |
     |      / \
     |
  ___|___


⚫ Your Challenge

In a language of your choice, write a program that takes as its input (in some way) the target word (with blanks) and the letters that have been guessed already. It should then output the next letter to be guessed.
For example:

$ echo -n "p...s\npds" | ./guesser
e

You may assume the word to be guessed is an English word and contains only lowercase ASCII letters.
Provide code and instructions if usage is not obvious. Consider using a tripcode to ease conversation about your entry.

Entries will be judged on GOODITUDE (defined as its win/loss ratio over twenty random games), on SPEED, and on CLEVERNESS.

Your deadline is 23:59:59 on Sunday, May 20th. Results will be posted the following day.

 |∧_∧
 |´・ω・) < Good luck!♫
 ||と ノ

Name: Anonymous 2012-05-19 21:55

Against random words the best strategy is to maximize your expected chance of winning, but because the game tree grows exponentially you can't brute force every possibility and have to use a heuristic. ``Most used character'' is a very good heuristic, and ``most entropy in result for this turn'' is also pretty good but harder to compute. How many of the top heuristic choices to examine is a trade-off, but because of diminishing returns I like 2. Perhaps a dynamic choice would be best.

On another note, don't forget to filter out words that have characters that have already been guessed and found not be in the word.

#lang racket/base

;; Usage: racket -t hangman.rkt [word misses]
;; Input is taken from stdin if not given on command line

(define word-list "corncob_lowercase.txt")
(define lives 6)
(define search-width 2)

(require racket/file racket/set srfi/1 srfi/13 racket/flonum)

(define argv (current-command-line-arguments))
(when (zero? (vector-length argv)) (set! argv (vector (read-line) (read-line))))

(define (number-of-words-containing c words)
  (count (lambda (word) (string-index word c)) words))
(define (string->seteqv s) (for/seteqv ((c (in-string s))) c))

(define word (vector-ref argv 0))
(define misses (vector-ref argv 1))
(define acceptable?
  (let ((r (regexp (format "^~a$" (if (string-null? misses) word (regexp-replace* "\\." word (format "[^~a]" misses)))))))
    (lambda (word) (regexp-match? r word))))
(define cur-words (filter acceptable? (file->lines word-list)))
(define full-alphabet (string->seteqv "abcdefghijklmnopqrstuvwxyz"))
(define cur-alphabet (set-subtract full-alphabet (string->seteqv word) (string->seteqv misses)))

(define (best alphabet words lives)
  (define (wins c)
    (define next-alphabet (set-remove alphabet c))
    (define rx (regexp (regexp-quote (string c))))
    (define h (make-hash))
    (for-each (lambda (word) (hash-update! h (regexp-match-positions* rx word) (lambda (v) (cons word v)) '())) words)
    (define (group-wins k v)
      (define next-lives (if (null? k) (- lives 1) lives))
      (let-values (((_ w) (best next-alphabet v next-lives))) w))
    (define (total-wins) (apply + (hash-map h group-wins)))
    (cond
      ((and (= (hash-count h) 1) (null? (car (hash-keys h))))
       0)
      (else
       (total-wins))))
  (define n (length words))
  (define in-all
    (do ((a alphabet (set-intersect a (string->seteqv (car ws))))
         (ws words (cdr ws)))
      ((or (set-empty? a) (null? ws)) a)))
  (cond
    ((zero? lives)
     (values #f 0))
    ((= n 0)
     (error "That's not possible."))
    ((= n 1)
     (define letters-left (set-intersect alphabet (string->seteqv (car words))))
     (if (set-empty? letters-left)
         (values #f 1)
         (values (car (set->list letters-left)) 1)))
    ((not (set-empty? in-all))
     (define c (car (set->list in-all)))
     (define c-wins (wins c))
     (values c c-wins))
    (else
     (define choices (set->list alphabet))
     (define sorted-choices (sort choices > #:key (lambda (c) (number-of-words-containing c words))))
     (define choices-to-examine (take sorted-choices search-width))
     (let loop ((l choices-to-examine) (best-c #f) (best-wins 0))
       (cond
         ((null? l)
          (values best-c best-wins))
         (else
          (define c (car l))
          (define c-wins (wins c))
          (cond
            ((= c-wins n)
             (values c c-wins))
            ((> c-wins best-wins)
             (loop (cdr l) c c-wins))
            (else
             (loop (cdr l) best-c best-wins)))))))))

(let-values (((c w) (best cur-alphabet cur-words (- lives (string-length misses)))))
  ; (printf "Best choice is \"~a\", winning ~a out of ~a times (~a%)\n" c w (length cur-words) (fl* (fl/ (exact->inexact w) (exact->inexact (length cur-words))) 100.))
  (printf "~a\n" c))

Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List