[Haskell-cafe] Monad Stack - State + Rand?
Erik Rantapaa
erantapaa at gmail.com
Sat Jun 18 05:27:25 UTC 2016
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
> To protect my privacy, please use PGP encryption. It's free and easy
> to use! My public key ID is 0x340EA95A (pgp.mit.edu).
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskel... at haskell.org <javascript:>
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20160617/ecf1b818/attachment.html>
More information about the Haskell-Cafe
mailing list