[Haskell-cafe] Newbie: State monad example questions

Dmitri O.Kondratiev dokondr at gmail.com
Wed May 21 08:42:21 EDT 2008


Thanks everybody for your help!
Oliver,  you provided an excellent write-up  on  State  monad without
going  into 'scary' :) details, great work indeed!
Alas,  in this case I need the details, and in particular the most scary
ones!

So let's start with fundamental and most intriguing  (to me) things:

getAny :: (Random a) => State StdGen a
getAny = do g <- get -- magically get the current StdGen

First line above declares a data type:

State StdGen a

which is constructed with the function:

State {runState :: (StdGen -> (a, StdGen))}

Q1: Where in the example (
http://www.haskell.org/all_about_monads/examples/example15.hs) data of this
type *actually gets constructed* ?

Looking at example15.hs code we see the following sequence:

1) makeRandomValue g -- where g is a StdGen instance, ok

2) makeRandomValue g ~> expands into ~>

~>  (runState (do { ...; b <- getAny;...})) g


This last expression puzzles me. I can understand, for example, this:

State StdGen a :: aState
StdGen:: g1

(v, g2) = (runStae aState) g1 -- this returns a state function which is then
passed a generator g1, and as result returns pair (value, new generaor)

But '(runState (do ...)) g' implies that expression (do ...)  must be
somehow of type 'State StdGen a' ?
Yet, when we call 'makeRandomValue g' we just pass to this function
g::StgGen

So, my next question:
Q2: How (do {...;b <- getAny;...}) becomes an *instance* of type 'State
StdGen a' ?


On Tue, May 20, 2008 at 7:01 PM, Olivier Boudry <olivier.boudry at gmail.com>
wrote:

> 2008/5/19 Dmitri O.Kondratiev <dokondr at gmail.com>:
>
>> I am trying to understand State monad example15 at:
>> http://www.haskell.org/all_about_monads/html/statemonad.html
>>
>>
> Hi Dmitri,
>
> I'm not sure you need to understand everything about Monad and do-notation
> to use the State Monad. So I will try to explain its use without talking
> about those scary topics. ;-)
>
> In Haskell you use the state monad when you want to hide state passing
> between function calls. As Haskell is pure you cannot change state. You can
> just create a new state and return it along with the value. In haskell you
> would do this by returning the value and new state in a tuple. State passing
> functions usually have the type `s -> (a, s)` where a is the type of the
> return value and s is the type of the State.
>
> This is exactly what the `random` function does. It gets a state and
> returns a tuple made of a value and a new state (StdGen: is a new seed for
> the random generator) to be used on the next `random` function call .
>
> Without the state monad you have to explicitely pass the new seed between
> calls to `random` as using the same seed for all function calls would always
> give you the same "not so random" number.
>
> Explicit state passing would look like this.
>
> get3RandomInts :: StdGen -> (Int, Int, Int)
> get3RandomInts g1 =
>     let (r1, g2) = random g1
>         (r2, g3) = random g2
>         (r3, _)  = random g3
>     in (r1, r2, r3)
>
> It's tedious, unreadable and error prone as it's easy to mess up the
> numbering (based on my experience).
>
> The State Monad allow you to hide the state passing. You don't have to give
> the state as an argument and your function won't return a changed state
> along with the data. Code running in the State Monad will look like this:
>
> getAny :: (Random a) => State StdGen a
> getAny = do g <- get -- magically get the current StdGen
>             let (x, g') = random g
>             put g' -- magically save the new StdGen for later
>             return x
>
> get3RandomIntsWithState :: State StdGen (Int, Int, Int)
> get3RandomIntsWithState = do
>     r1 <- getAny -- you don't care about stdgen passing
>     r2 <- getAny
>     r3 <- getAny
>     return (r1, r2, r3)
>
> To use your get3RandomIntsWithState function you need to run it using one
> of runState (returns the (value, state)) or evalState (returns the value).
>
> main :: IO ()
> main = do
>     g <- getStdGen
>     let t = evalState get3RandomsWithState g
>     print t
>
> The interesting bits are in the getAny function. The State Monad provides
> you with 2 new function, get and set. If you look at this function as
> blackboxes; `get` will retrieve the current State and `put` will save a new
> State. You don't need to worry about how the State is passed from one getAny
> function call to another as long as they're run in the same `evalState`
> call.
>
> Now getAny can be simplified. If you look at the random function and at the
> State newtype declaration you will see that a State is a `s -> (a, s)`
> function "hidden" in the State constructor.
>
>     newtype State s a = State {runState :: s -> (a, s)}
>
> random is also of the type `s -> (a, s)` even if variables are labelled `g`
> and `a`
>
>     random :: (RandomGen g, Random a) => g -> (a, g)
>
> So wrapping the random function into the State constructor will just give
> you a getAny function for free.
>
> getAny :: (Random a) => State StdGen a
> getAny = State random
>
> I put a copy of the code in http://hpaste.org/7768
>
> In short to use the State monad, you just need to care about a couple of
> details.
>
> The type of your functions running in the State Monad must end in `State s
> a` where `s` is the type of the state and `a` the type of the return value.
>
> You have to run it using either runState, execState or evalState. runState
> will return both the value and the state, execState will return the state
> and evalState will return just the value.
>
> You must use put and get to retrieve and store the State but don't need to
> care about the details of how the state is passed. As long as your function
> calls are all part of the same action.
>
> I hope it helps. I'm also quite new at Haskell and the terminology used is
> probably not very accurate.
>
> Best regards,
>
> Olivier.
>



-- 
Dmitri O. Kondratiev
dokondr at gmail.com
http://www.geocities.com/dkondr
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20080521/d00e39fe/attachment.htm


More information about the Haskell-Cafe mailing list