[Haskell-cafe] Newbie: State monad example questions

Dmitri O.Kondratiev dokondr at gmail.com
Fri May 23 09:30:05 EDT 2008


Do any general-purpose monad 'do' (>>=) and (>>) operator desugaring  tools
exist?
Such that I could first go from 'do' to bind notation and then expand (>>=)
definition, as Oliver compactly did.
I also tried to expand (>>=) by hand in 'getAny' code, though somewhat
differently (see below my pseudo Haskell code) using this definition of
(>>=):

{--
(>>=) :: State StdGen Int -> (Int -> State StdGen Int) ->  State StdGen Int
(State so1) >=> fn = State(\g1 -> let(v1, g2) = so1 g1
                                     so2 = fn v1
                                  in (runState so2) g2)
--}
--
-- First 'getAny' with 'do' notation:
--
getAny :: (Random a) => State StdGen a
getAny = do g <- get
            (x,g') <- return $ random g
            put g'
            return x

--
-- 'getAny' after expanding 'do' into (>>=) :
--
getAnyNoSugar :: (Random a) => State StdGen a
getAnyNoSugar = (State $ \s -> (s, s)) >>= \g ->
                (State $ \s -> (random g, s)) >>= \(x,g') ->
                (State $ \_ -> ((), g')) >>
                (State $ \s -> (x, s))

--
-- And here is my 'by hand' expansion in pseudo Haskell (may be wrong?):
--
{--

o1 = (State $ \s -> (s, s))
o2 = (State $ \s -> (random g, s))
o3 = (State $ \_ -> ((), g'))
o4 = (State $ \s -> (x, s))

getAnyNoSugar = o1 >>= f1
f1 = \g -> o2  >>= f2
f2 = \(x,g') -> o3  >>= f3
f3 = \_ -> o4

runState (o1 >>= f1) gen1 ~>
State (\g1 ->
let
v1 = gen1
g2 = gen1
so2 = f1 gen1
in (runState (f1 gen1))) gen1

f1 gen1 ~>
(State $ \s -> (random gen1, s)) >>= f2 ~>
State (\g1 ->
let
v1 = random gen1
g2 = gen1
so2 = f2 (random gen1)
in (runState (f2 (random gen1)))) gen1

f2 (random gen1) ~>

random gen1 = (rv, rg) ~>

f2 (rv, rg) ~>
State (\g1 ->
let
x = rv
g' = rg
(State $ \_ -> ((), rg)) >>= f3
v1 = ()
g2 = rg
so2 = f3 ()
in (runState (f3 ()) rg))

f3 () ~> o4 ~> (State $ \s -> (rv, s))

runState (o1 >>= f1) gen1 ~>
~> runState State (\g1 ->  runState (State (\g1 ->  (f2 (random gen1)))))
gen1
~> runState State (\g1 ->  runState (State (\g1 ->  runState (State (\g1 ->
(f3 ()) rg))))) gen1
~> runState State (\g1 ->  runState (State (\g1 ->  runState (State (\g1 ->
runState (State $ \s -> (rv, s)) rg))))) gen1

-- State (\g1 ->  runState (State $ \s -> (rv, s)) rg = State(\g1 -> (rv,
rg))

~> runState State (\g1 ->  runState (State (\g1 ->  runState (State (\g1 ->
(rv, rg)))))) gen1

~> (rv, rg)

--}
On Wed, May 21, 2008 at 10:31 PM, Olivier Boudry <olivier.boudry at gmail.com>
wrote:

> On Wed, May 21, 2008 at 11:10 AM, Dmitri O.Kondratiev <dokondr at gmail.com>
> wrote:
>
>> But how will 'g1' actually get delivered from 'makeRandomValueST g1' to
>> invocation of 'getAny' I don't yet understand!
>>
>>
> It may be easier to understand the state passing if you remove the do
> notation and replace get, put and return with their definition in the
> instance declarations (Monad and MonadState).
>
> getAny :: (Random a) => State StdGen a
> getAny = do g      <- get
>             (x,g') <- return $ random g
>             put g'
>             return x
>
> get = State $ \s -> (s, s) -- copy the state as a return value and pass
> state
> put s = State $ \_ -> ((), s) -- return unit, ignore the passed state and
> replace it with the state given as parameter.
> return a = State $ \s -> (a, s) -- return given value and pass state.
>
> getAnyNoSugar :: (Random a) => State StdGen a
> getAnyNoSugar = (State $ \s -> (s, s)) >>= \g ->
>                 (State $ \s -> (random g, s)) >>= \(x,g') ->
>                 (State $ \_ -> ((), g')) >>
>                 (State $ \s -> (x, s))
>
> The function is still useable this way and the state transformations should
> be a bit more visible. The first element of the tuple is the value that will
> be used to call the next function (of type Monad m => a -> m b). The second
> element of the tuple is the state and the (>>=) operator will handle passing
> it between actions.
>
> Desugaring the (>>=) and (>>) operators would give you something like this
> (I replaced `s` with `y` in the `put` and `return` desugaring and simplified
> it):
>
> State $ \s = let
>   (g, s') = (\y -> (y,y)) s
>   ((x,g'), s'') = (\y -> (random g, y)) s'
>   (_, s''') = (\_ -> ((), g')) s''
>   in (x, s''')
>
> Which is explict state passing between function calls. Extract the State
> using `runState`, run it with an initial state and it should give you the
> expected result.
>
> 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/20080523/844828a6/attachment.htm


More information about the Haskell-Cafe mailing list