[Haskell-cafe] Making type-incompatible strategies interchangeable

aditya siram aditya.siram at gmail.com
Sat Dec 18 19:06:47 CET 2010


Warning! Incredibly hacky Haskell coming up!

Here's some code that seems to do the near same thing as your Python.
Below it is some sample output. A couple of differences are that the
secret number should be between 1 and 10, and whenever the computer
tries guess it just picks a random number until it get it right.
Additionally the code maintains a record of wrong guesses in a list as
opposed to an incrementing count.

-deech

{-# LANGUAGE ScopedTypeVariables, EmptyDataDecls, PackageImports #-}
import Control.Monad.Random
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Writer

human_asker :: IO Int
human_asker = do
  putStrLn "What's the secret number?"
  getLine >>= return . read

randomNum :: Int -> Int -> IO Int
randomNum low high = getStdRandom $ randomR (low, high)

computer_asker :: IO Int
computer_asker = randomNum 1 10

computer_guesser :: StateT Int (WriterT [Int] IO) ()
computer_guesser = do
  guess::Int <- liftIO $ randomNum 1 10
  secret <- get
  process guess secret
    where
      process g s
           | g < s = do {tell [g]; liftIO $ putStrLn "Too low";
computer_guesser}
           | g > s = do {tell [g]; liftIO $ putStrLn "Too high";
computer_guesser}
           | g == s = do {liftIO $ putStrLn "Got it!"}

human_guesser :: StateT Int (WriterT [Int] IO) ()
human_guesser = do
  guess::Int <- liftIO $ do {putStrLn "What's your guess?";
                             getLine >>= return . read;}
  secret <- get
  process guess secret
  where
    process g s
           | g < s = do {tell [g]; liftIO $ putStrLn "Too low"; human_guesser}
           | g > s = do {tell [g]; liftIO $ putStrLn "Too high"; human_guesser}
           | g == s = do {liftIO $ putStrLn "Got it!"}

play asker guesser = asker >>= runWriterT . execStateT guesser

-- # Output From Sample Runs
> play human_asker computer_guesser
What's the secret number?
10
Too low
Too low
Too low
Too low
Too low
Too low
Too low
Too low
Too low
Too low
Too low
Too low
Too low
Too low
Too low
Too low
Got it!
(10,[3,8,7,7,1,5,8,6,4,7,1,8,5,7,2,3])

*Main> play computer_asker computer_guesser
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Too high
Got it!
(1,[4,10,2,10,8,10,6,6,3,7,2,6,3,4,9,4,8,6,7])



On Sat, Dec 18, 2010 at 7:31 AM, Heinrich Apfelmus
<apfelmus at quantentunnel.de> wrote:
> Jacek Generowicz wrote:
>>
>> # Imagine an activity which may be performed either by a computer, or
>> # by a human (alternatively, either locally, or remotely across a
>> # network). From Haskell's type system's perspective, these two will
>> # look completely different (most obviously, the human (or the
>> # network) is wrapped in IO). How can they be made interchangeable ?
>>
>> # To demonstrate what I mean, I offer the following concrete toy
>> # example, in Python.
>>
>> # It's a harness for playing the trivial higher-lower number guessing
>> # game, with interchangeable strategies for either player. In this
>> # example I provide two strategies (Computer / ask Human via IO) for
>> # each role (asker and guesser).
>>
>> # How can this sort of interchangeability of computations which are
>> # conceptually identical, but incompatible from the types perspective,
>> # be expressed in Haskell?
>
> Have a look at my  operational  package, in particular the  TicTacToe.hs
>  example on the examples page.
>
>   http://hackage.haskell.org/package/operational
>
> (Unfortunately, the  haskell.org  domain is seized at the moment, so this
> link won't work for a while. Also, please yell if you can't find the
> examples page once the link works again.)
>
>
> Regards,
> Heinrich Apfelmus
>
> --
> http://apfelmus.nfshost.com
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>



More information about the Haskell-Cafe mailing list