Permalink
Browse files

Algorithm is working, albeit very slowly.

  • Loading branch information...
1 parent 2af8cff commit 5f9859a7eac3177dfd8f1ac9668a09a035558a8d @amcnamara committed Feb 23, 2012
Showing with 30 additions and 19 deletions.
  1. +25 −17 src/Hangman/core.clj
  2. +5 −2 src/Hangman/strategy.clj
View
42 src/Hangman/core.clj
@@ -10,28 +10,36 @@
(if-let [secret-word-list (try (string/split (slurp (first args)) #"\s+") (catch Exception _ (if (first args) args)))]
(map #(let [game (HangmanGame. % max-guesses)]
(loop [guessed-chars [] guessed-words [] mask (.getGuessedSoFar game)]
+ (println game)
(when (= HangmanGame$Status/KEEP_GUESSING (.gameStatus game))
- (let [[answer & _ :as words] (remove (set guessed-words) (strategy/get-words mask guessed-chars))
- branches (map
- (fn [test]
- [test (get-masks test mask guesses)])
- (remove (set guessed-chars) (map char (range 65 91))))
- total (count words)
- dmax (max (map (fn [[_ masks]] (count masks)) branches))
- [pick _] (reduce
- (fn [[prev prev-n] [test masks]]
- (let [score ()]
- (if (or (nil? prev) (> score prev-n))
- [test score])))
- [nil nil]
- branches)]
+ (let [branches (map
+ (fn [test]
+ [test (strategy/get-masks mask test guessed-chars)])
+ (remove (set guessed-chars) (map char (range 65 91))))
+ words (remove (set guessed-words) (strategy/get-words mask guessed-chars))
+ total (count words)
+ dmax (apply max (map (fn [[_ masks]] (count masks)) branches))
+ [answer] words
+ [pick _] (reduce
+ (fn [[min-pick min-score] [test masks]]
+ (let [dtest (count masks)
+ score (+ (/ (apply +
+ (map (fn [submask] (* (/ total dtest) (count (strategy/get-words submask `(~@guessed-chars ~test))))) masks))
+ dtest)
+ (* weight (+ (- dmax dtest) 1)))]
+ (if (or (nil? min-score) (< score min-score))
+ [test score]
+ [min-pick min-score])))
+ [nil nil]
+ branches)]
(if (or (nil? pick) (>= 2 (count words)))
(do
+ (println "Guessing word:" answer)
(.. game (guessWord answer))
- (recur guesses (conj guessed-words answer) mask))
+ (recur guessed-chars (conj guessed-words answer) mask))
(do
+ (println "Guessing character:" pick)
(.. game (guessLetter pick))
- (recur (conj guesses pick) guessed-words (.getGuessedSoFar game))))))))
- (println game))
+ (recur (conj guessed-chars pick) guessed-words (.getGuessedSoFar game))))))))
secret-word-list)
(println "Usage: lein run <words...|word-filename>, where the word file is whitespace delimited and there exists a dictionary file under ./resources/dict.txt")))
View
7 src/Hangman/strategy.clj
@@ -2,7 +2,7 @@
(:require [clojure.string :as string]))
;; A collection of all of the valid words in the supplied dictionary
-(def dictionary (distinct (map string/upper-case (string/split (slurp (str (System/getProperty "user.dir") "resources/dict.txt")) #"\n"))))
+(def dictionary (distinct (map string/upper-case (string/split (slurp (str (System/getProperty "user.dir") "/resources/dict.txt")) #"\n"))))
(def ^:dynamic branch-words [])
@@ -35,7 +35,10 @@
(get-words mask []))
([mask guesses]
(filter-mask-words mask guesses (get (group-by count dictionary) (count mask)))))
-
+
+(defn get-masks [mask pick guesses]
+ (distinct (map #(get-mask pick mask %) (get-words mask guesses))))
+
(defn- guess-branch [guesses rem-chars mask]
(let [[pick _] (reduce (fn [[prev prev-n] test]
(let [test-n (count (re-seq (re-pattern (str test)) (apply str (filter-mask-words mask guesses branch-words))))]

0 comments on commit 5f9859a

Please sign in to comment.