[Haskell-cafe] Different forms for RandomT?
Daniel Gorín
dgorin at dc.uba.ar
Mon Aug 3 15:09:10 UTC 2015
> Normally, a monad transformer to provide a random number generator
> would be of the form StateT g, where g is a RandomGen. But I've seen
> some libraries (like QuickCheck) define their RandomT as:
>
> newtype RandomT g m a = RandomT { runRandomT :: g -> m a }
>
> with their monadic bind operation defined as
>
> (RandomT m) >>= f = RandomT $ \g -> let (ga, gb) = split g in m ga >>=
> (\a -> runRandomT (f a) gb)
>
> and return and fail as in ReaderT.
>
> Can someone describe the advantages and disadvantages of doing RandomT
> this way? I mean, if your generator has a subpar split operation (and
> most do), this will obviously exacerbate any problems > with it. Does
> it give any comparable advantages?
>
A disadvantage is that it is too easy to end up with a monad that
doesn’t respect the monad laws. For example, in the following, we expect
ver_1 and ver_2 to be the same computation and yet their outputs
differs...
> import System.Random
>
> newtype RandomT g m a = RandomT { runRandomT :: g -> m a }
>
> instance (Monad m, RandomGen g) => Monad (RandomT g m) where
> return = RandomT . const . return
> (RandomT m) >>= f = RandomT $ \g ->
> let (ga, gb) = split g
> in m ga >>= (\a -> runRandomT (f a) gb)
>
> sample :: (RandomGen g, Monad m) => RandomT g m Int
> sample = RandomT $ \g -> return (fst $ next g)
>
> main :: IO ()
> main = do
> let probe m = runRandomT m (mkStdGen 42)
> res_1 <- probe ver_1
> res_2 <- probe ver_2
> print (res_1,res_2)
> where
> ver_1 = sample
> ver_2 = return () >> sample
It is because of this that QuickCheck warns that "Gen is only morally a
monad: two generators that are supposed to be equal will give the same
probability distribution, but they might be different as functions from
random number seeds to values.” [1]. You rarely notice this when using
quickcheck... except perhaps if you are trying to debug or refactor a
complex generator, and then good luck with that!
[1]
https://hackage.haskell.org/package/QuickCheck-2.8.1/docs/Test-QuickCheck-Gen-Unsafe.html
More information about the Haskell-Cafe
mailing list