[Haskell-cafe] Monad Stack - State + Rand?

Christopher Howard ch.howard at zoho.com
Sat Jun 18 05:30:16 UTC 2016


Thanks, that was it!

On 06/17/2016 09:27 PM, Erik Rantapaa wrote:
> You are likely missing a `lift` when you call the random functions.
> 
> Here is an example:
> 
> 
> import Control.Monad.State
> import Control.Monad.Random
> 
> walk :: RandomGen g => StateT (Float, Float) (Rand g) (Float, Float)
> walk = do (x, y) <- get
>           put (x + 1, y + 1)
>           get >>= return
> 
> foo :: RandomGen g => StateT (Float,Float) (Rand g) ()
> foo = do
>   a <- lift $ getRandomR (1,6)
>   b <- lift $ getRandomR (4,10)
>   (x,y) <- get
>   put (x+a, y+b)
> 
> test1 = do
>   g <- getStdGen
>   print $ runRand (runStateT foo (0.0, 3.14)) g
> 
> Because the State monad is encapsulating (transforming) the random
> monad, you have to `lift` operations in the random monad so that they
> become operations in the transformed monad.
> 
> On Friday, June 17, 2016 at 11:22:57 PM UTC-5, Christopher Howard wrote:
> 
>     Hi. I'm working through "Haskell Design Patterns" and got inspired to
>     try to create my first monad stack. What I really wanted though (not
>     shown in the book) was to combine State and Rand. I daresay I got
>     something to compile:
> 
>     walk :: RandomGen g => StateT (Float, Float) (Rand g) (Float, Float)
>     walk = do (x, y) <- get
>               put (x + 1, y + 1)
>               get >>= return
> 
>     However, the moment I try to insert a getRandomR or something in it, I
>     get an error
> 
>     Could not deduce (MonadRandom (StateT (Float, Float) (Rand g)))
>           arising from a use of `getRandomR' <...snip...>
>     add an instance declaration for
>           (MonadRandom (StateT (Float, Float) (Rand g)))
> 
>     I see there are instances
> 
>     MonadRandom m => MonadRandom (StateT s m)
>     RandomGen g => MonadRandom (Rand g)
> 
>     in Control.Monad.Random.Class, so I am not quite sure what is expected
>     of me.
> 
>     -- 
>     http://justonemoremathproblem.com <http://justonemoremathproblem.com>
>     To protect my privacy, please use PGP encryption. It's free and easy
>     to use! My public key ID is 0x340EA95A (pgp.mit.edu
>     <http://pgp.mit.edu>).
> 
>     _______________________________________________
>     Haskell-Cafe mailing list
>     Haskel... at haskell.org <javascript:>
>     http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>     <http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe>
> 

-- 
http://justonemoremathproblem.com
To protect my privacy, please use PGP encryption. It's free and easy
to use! My public key ID is 0x340EA95A (pgp.mit.edu).



More information about the Haskell-Cafe mailing list