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-15 14:54

module Main where

import Data.List (sortBy)
import Data.List.Split (wordsBy)
import Data.Char (isSpace)
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Read as T
import qualified Data.Text.IO as T

type PList = [(Char, Double)]
type LUT = M.Map String PList

sortPList :: PList -> PList
sortPList = sortBy (\x y -> snd y `compare` snd x)

filterPList :: String -> PList -> PList
filterPList s l = filter (\(x, y) -> not $ x `elem` s) l

splitFreqs :: Int -> [[a]] -> ([a], [[a]])
splitFreqs _ [] = ([], [])
splitFreqs l (x:xs)
    | length x == l+1 = (p, x:pp)
    | length x == l = if null p then (x, pp) else next
    | otherwise = next
    where next@(p, pp) = splitFreqs l xs

mkPMap :: [T.Text] -> (String, [Double])
mkPMap (x:xs) = (T.unpack x, case dbls of
                                 Just d -> d
                                 _ -> [])
    where dbls = mapM toDbl xs
          toDbl :: T.Text -> Maybe Double
          toDbl t = case T.double t of
                        Right (d, t') -> if T.null t' then Just d else Nothing
                        _ -> Nothing

mkFreqLookup :: T.Text -> (PList, LUT, Int)
mkFreqLookup bs = (p', pp'', maximum $ map (length . fst) pp')
    where nonnull = filter (not . T.null) $ T.lines bs
          ll = filter (\x -> T.head x /= '#') nonnull
          key' = filter (not . isSpace) $ T.unpack (head ll)
          key = map (\x -> if x == 'S' then ' ' else x) key'
          (p, pp) = splitFreqs (length key) (map T.words $ tail ll)
          p' = sortPList $ zip key (snd $ mkPMap (T.empty : p))
          pp' = map (\(x, y) -> (x, zip key y)) $ map mkPMap pp
          pp'' = M.fromList pp'

words' :: String -> [String]
words' s = if last s == '.' then w else init w
    where w = wordsBy (== '.') s

findWordProbs :: Int -> LUT -> String -> PList
findWordProbs 0 _ _ = []
findWordProbs m lut s = case f of
                            Just i -> i
                            _ -> findWordProbs (l-1) lut s
    where l = min (length s) m
          f = M.lookup (reverse $ take l $ reverse s) lut

main = do
    fc <- T.readFile "freqlist"
    w <- getLine
    used <- getLine

    let (guess, lut, match) = mkFreqLookup fc
        w' = words' w
        plists = concatMap (findWordProbs match lut) w'
        probs = sortPList $ filterPList used plists
        next = if null probs
                   then fst $ head $ filterPList used guess
                   else fst $ head probs

    putStrLn [next]


freqlist: http://pastebin.com/wFzSJxen

Quick and dirty. Uses frequency analysis to determine the next best guess

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