[Haskell-cafe] Re: [Haskell] Animal guessing game - critique my code

28 Oct 2006

      I haven't made anything more elegant, but have a few improvements that I
found made it more fun to play (and yes, I'm rather zoned out after
spending most of the day solving electromagnetism problems).  It's nice
(and quite easy) to save the tree, so that the game is more exciting every
time you play.  With a bit of work and integration with darcs, you could
probably interface with a public server, so the guesser can be
collaboratively improved by people who have too much time on their hands
or are too tired to do anything productive.

Here's the improved code:

\begin{code}
module Main where

import Data.Char ( isUpper )

data GuessTree = Answer String
               | GuessTreeQuestion {guessTreeQuestion :: String,
                                    guessTreeNo,
                                    guessTreeYes ::GuessTree}
                 deriving (Show, Read)

askQuestion :: String -> IO Bool
askQuestion str = do
  putStrLn str
  response <- getLine
  return $ isYes response
  where isYes ('y':xs) = True
        isYes _ = False

a :: String -> String
a s@(c:_) | isUpper c = s
          | c `elem` "aeiou" = "an " ++ s
          | otherwise = "a " ++ s
a "" = "nonexistent"

runTree :: GuessTree -> IO GuessTree
runTree (Answer name) = do
  response <- askQuestion $ "Is it " ++ a name ++ "?"
  if response
    then do putStrLn "Ha!"
            return $ Answer name
    else do putStrLn "What is it?"
            animal <- getLine
            putStrLn $ "Enter a question to help distinguish between " ++
                      a name ++ " and " ++ a animal
            question <- getLine
            a <- askQuestion $ "Is the answer yes for " ++ animal ++ "?"
            (if a then id else flip) (\n y ->
                                      return $ GuessTreeQuestion {guessTreeQuestion = question,
                                                                  guessTreeNo = n,
                                                                  guessTreeYes = y}) (Answer animal)
                        (Answer name)
runTree GuessTreeQuestion {guessTreeQuestion = ques,
                           guessTreeYes = yesTree,
                           guessTreeNo = noTree} = do
  response <- askQuestion $ ques
  if response
    then do a <- runTree noTree
            return $ GuessTreeQuestion {guessTreeQuestion = ques,
                                        guessTreeNo = a,
                                        guessTreeYes = yesTree}
    else do a <- runTree yesTree
            return $ GuessTreeQuestion
                       {guessTreeQuestion = ques,
                        guessTreeNo = noTree,
                        guessTreeYes = a}

run :: GuessTree -> IO GuessTree
run tree = do
  putStrLn "Think of an animal and press enter."
  getLine
  a <- runTree tree
  writeFile "animaldata" $ show a
  r <- askQuestion "Play again?"
  if r then run a else return a

read_animal :: IO GuessTree
read_animal = (read `fmap` readFile "animaldata") `catch`
              \_ -> return $ Answer "bear"

main = read_animal >>= run
\end{code}

As you can see, I also modified it so that it'll be a bit smarter about not
saying things like "a David Roundy" or "a elephant".
-- 
David Roundy
Dept. of Physics
Oregon State University