Copyright | (c) Brent Yorgey 2016 |
---|---|
License | BSD3 (see LICENSE) |
Maintainer | byorgey@gmail.com |
Stability | experimental |
Portability | non-portable (multi-param classes, functional dependencies, undecidable instances) |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
Strict random monads, passing a random number generator through a computation. See below for examples.
In this version, sequencing of computations is strict (but computations are not strict in the state unless you force it with seq or the like). For a lazy version with the same interface, see Control.Monad.Trans.Random.Lazy.
Synopsis
- type Rand g = RandT g Identity
- liftRand :: (g -> (a, g)) -> Rand g a
- runRand :: Rand g a -> g -> (a, g)
- evalRand :: Rand g a -> g -> a
- execRand :: Rand g a -> g -> g
- mapRand :: ((a, g) -> (b, g)) -> Rand g a -> Rand g b
- withRand :: (g -> g) -> Rand g a -> Rand g a
- evalRandIO :: Rand StdGen a -> IO a
- data RandT g m a
- liftRandT :: (g -> m (a, g)) -> RandT g m a
- runRandT :: RandT g m a -> g -> m (a, g)
- evalRandT :: Monad m => RandT g m a -> g -> m a
- execRandT :: Monad m => RandT g m a -> g -> m g
- mapRandT :: (m (a, g) -> n (b, g)) -> RandT g m a -> RandT g n b
- withRandT :: (g -> g) -> RandT g m a -> RandT g m a
- evalRandTIO :: MonadIO m => RandT StdGen m a -> m a
- liftCallCC :: CallCC m (a, g) (b, g) -> CallCC (RandT g m) a b
- liftCallCC' :: CallCC m (a, g) (b, g) -> CallCC (RandT g m) a b
- liftCatch :: Catch e m (a, g) -> Catch e (RandT g m) a
- liftListen :: Monad m => Listen w m (a, g) -> Listen w (RandT g m) a
- liftPass :: Monad m => Pass w m (a, g) -> Pass w (RandT g m) a
- data RandGen g = RandGen
- withRandGen :: g -> (RandGen g -> RandT g m a) -> m (a, g)
- withRandGen_ :: Monad m => g -> (RandGen g -> RandT g m a) -> m a
The Rand monad transformer
:: (g -> (a, g)) | pure random transformer |
-> Rand g a | equivalent generator-passing computation |
Construct a random monad computation from a function.
(The inverse of runRand
.)
:: Rand g a | generator-passing computation to execute |
-> g | initial generator |
-> (a, g) | return value and final generator |
Unwrap a random monad computation as a function.
(The inverse of liftRand
.)
:: Rand g a | generator-passing computation to execute |
-> g | initial generator |
-> a | return value of the random computation |
:: Rand g a | generator-passing computation to execute |
-> g | initial generator |
-> g | final generator |
evalRandIO :: Rand StdGen a -> IO a Source #
Evaluate a random computation in the IO
monad, splitting the global
standard generator to get a new one for the computation.
The RandT monad transformer
A random transformer monad parameterized by:
g
- The generator.m
- The inner monad.
The return
function leaves the generator unchanged, while >>=
uses the
final generator of the first computation as the initial generator of the
second.
Instances
:: (g -> m (a, g)) | impure random transformer |
-> RandT g m a | equivalent generator-passing computation |
Construct a random monad computation from an impure function.
(The inverse of runRandT
.)
:: RandT g m a | generator-passing computation to execute |
-> g | initial generator |
-> m (a, g) | return value and final generator |
Unwrap a random monad computation as an impure function.
(The inverse of liftRandT
.)
evalRandTIO :: MonadIO m => RandT StdGen m a -> m a Source #
Evaluate a random computation that is embedded in the IO
monad,
splitting the global standard generator to get a new one for the
computation.
Lifting other operations
liftCallCC :: CallCC m (a, g) (b, g) -> CallCC (RandT g m) a b Source #
Uniform lifting of a callCC
operation to the new monad.
This version rolls back to the original state on entering the
continuation.
liftCallCC' :: CallCC m (a, g) (b, g) -> CallCC (RandT g m) a b Source #
In-situ lifting of a callCC
operation to the new monad.
This version uses the current state on entering the continuation.
It does not satisfy the uniformity property (see Control.Monad.Signatures).
liftCatch :: Catch e m (a, g) -> Catch e (RandT g m) a Source #
Lift a catchE
operation to the new monad.
liftListen :: Monad m => Listen w m (a, g) -> Listen w (RandT g m) a Source #
Lift a listen
operation to the new monad.
liftPass :: Monad m => Pass w m (a, g) -> Pass w (RandT g m) a Source #
Lift a pass
operation to the new monad.
StatefulGen interface
A proxy that carries information about the type of generator to use with RandT
monad and its StatefulGen
instance.
Since: 0.5.3
Instances
A RandT
runner that allows using it with StatefulGen
restricted actions. Returns
the outcome of random computation and the new pseudo-random-number generator
>>>
withRandGen (mkStdGen 2021) uniformM :: IO (Int, StdGen)
(6070831465987696718,StdGen {unStdGen = SMGen 4687568268719557181 4805600293067301895})
Since: 0.5.3
:: Monad m | |
=> g | initial generator |
-> (RandGen g -> RandT g m a) | |
-> m a | return value and final generator |
Same as withRandGen
, but discards the resulting generator.
>>>
withRandGen_ (mkStdGen 2021) uniformM :: IO Int
6070831465987696718
Since: 0.5.3
Examples
Random monads
The die
function simulates the roll of a die, picking a number between 1
and 6, inclusive, and returning it in the Rand
monad transformer. Notice
that this code will work with any random number generator g
.
die :: (RandomGen g) => Rand g Int die = getRandomR (1, 6)
The dice
function uses replicate
and sequence
to simulate the roll of
n
dice.
dice :: (RandomGen g) => Int -> Rand g [Int] dice n = sequence (replicate n die)
To extract a value from the Rand
monad transformer, we can use evalRandIO
.
main = do values <- evalRandIO (dice 2) putStrLn (show values)