| Copyright | (c) Brent Yorgey 2016 | 
|---|---|
| License | BSD3 (see LICENSE) | 
| Maintainer | byorgey@gmail.com | 
| Safe Haskell | Safe | 
| Language | Haskell2010 | 
Control.Monad.Random.Class
Description
The MonadRandom, MonadSplit, and MonadInterleave classes.
- MonadRandomabstracts over monads with the capability of generating random values.
- MonadSplitabstracts over random monads with the ability to get a split generator state. It is not very useful but kept here for backwards compatibility.
- MonadInterleaveabstracts over random monads supporting an- interleaveoperation, which allows sequencing computations which do not depend on each other's random generator state, by splitting the generator between them.
This module also defines convenience functions for sampling from a given collection of values, either uniformly or according to given weights.
- class Monad m => MonadRandom m where
- class Monad m => MonadSplit g m | m -> g where
- class MonadRandom m => MonadInterleave m where
- fromList :: MonadRandom m => [(a, Rational)] -> m a
- fromListMay :: MonadRandom m => [(a, Rational)] -> m (Maybe a)
- uniform :: (Foldable t, MonadRandom m) => t a -> m a
- uniformMay :: (Foldable t, MonadRandom m) => t a -> m (Maybe a)
- weighted :: (Foldable t, MonadRandom m) => t (a, Rational) -> m a
- weightedMay :: (Foldable t, MonadRandom m) => t (a, Rational) -> m (Maybe a)
MonadRandom
class Monad m => MonadRandom m where Source #
With a source of random number supply in hand, the MonadRandom class
 allows the programmer to extract random values of a variety of types.
Minimal complete definition
Methods
getRandomR :: Random a => (a, a) -> m a Source #
Takes a range (lo,hi) and a random number generator g, and returns a computation that returns a random value uniformly distributed in the closed interval [lo,hi], together with a new generator. It is unspecified what happens if lo>hi. For continuous types there is no requirement that the values lo and hi are ever produced, but they may be, depending on the implementation and the interval.
See randomR for details.
getRandom :: Random a => m a Source #
The same as getRandomR, but using a default range determined by the type:
- For bounded types (instances of Bounded, such asChar), the range is normally the whole type.
- For fractional types, the range is normally the semi-closed interval
 [0,1).
- For Integer, the range is (arbitrarily) the range ofInt.
See random for details.
getRandomRs :: Random a => (a, a) -> m [a] Source #
Plural variant of getRandomR, producing an infinite list of
 random values instead of returning a new generator.
See randomRs for details.
getRandoms :: Random a => m [a] Source #
Instances
| MonadRandom IO Source # | |
| MonadRandom m => MonadRandom (ListT m) Source # | |
| MonadRandom m => MonadRandom (MaybeT m) Source # | |
| (Error e, MonadRandom m) => MonadRandom (ErrorT e m) Source # | |
| MonadRandom m => MonadRandom (ExceptT e m) Source # | |
| MonadRandom m => MonadRandom (StateT s m) Source # | |
| MonadRandom m => MonadRandom (StateT s m) Source # | |
| (MonadRandom m, Monoid w) => MonadRandom (WriterT w m) Source # | |
| (MonadRandom m, Monoid w) => MonadRandom (WriterT w m) Source # | |
| MonadRandom m => MonadRandom (IdentityT * m) Source # | |
| (RandomGen g, Monad m) => MonadRandom (RandT g m) Source # | |
| (RandomGen g, Monad m) => MonadRandom (RandT g m) Source # | |
| MonadRandom m => MonadRandom (ContT * r m) Source # | |
| MonadRandom m => MonadRandom (ReaderT * r m) Source # | |
| (Monoid w, MonadRandom m) => MonadRandom (RWST r w s m) Source # | |
| (Monoid w, MonadRandom m) => MonadRandom (RWST r w s m) Source # | |
MonadSplit
class Monad m => MonadSplit g m | m -> g where Source #
The class MonadSplit proivides a way to specify a random number
   generator that can be split into two new generators.
This class is not very useful in practice: typically, one cannot
   actually do anything with a generator.  It remains here to avoid
   breaking existing code unnecessarily.  For a more practically
   useful interface, see MonadInterleave.
Minimal complete definition
Methods
Instances
| MonadSplit StdGen IO Source # | |
| MonadSplit g m => MonadSplit g (MaybeT m) Source # | |
| MonadSplit g m => MonadSplit g (ListT m) Source # | |
| (Monoid w, MonadSplit g m) => MonadSplit g (WriterT w m) Source # | |
| (Monoid w, MonadSplit g m) => MonadSplit g (WriterT w m) Source # | |
| MonadSplit g m => MonadSplit g (StateT s m) Source # | |
| MonadSplit g m => MonadSplit g (StateT s m) Source # | |
| MonadSplit g m => MonadSplit g (IdentityT * m) Source # | |
| MonadSplit g m => MonadSplit g (ExceptT e m) Source # | |
| (Error e, MonadSplit g m) => MonadSplit g (ErrorT e m) Source # | |
| (RandomGen g, Monad m) => MonadSplit g (RandT g m) Source # | |
| (RandomGen g, Monad m) => MonadSplit g (RandT g m) Source # | |
| MonadSplit g m => MonadSplit g (ReaderT * r m) Source # | |
| MonadSplit g m => MonadSplit g (ContT * r m) Source # | |
| (Monoid w, MonadSplit g m) => MonadSplit g (RWST r w s m) Source # | |
| (Monoid w, MonadSplit g m) => MonadSplit g (RWST r w s m) Source # | |
MonadInterleave
class MonadRandom m => MonadInterleave m where Source #
The class MonadInterleave proivides a convenient interface atop
   a split operation on a random generator.
Minimal complete definition
Methods
interleave :: m a -> m a Source #
If x :: m a is a computation in some random monad, then
   interleave x works by splitting the generator, running x
   using one half, and using the other half as the final generator
   state of interleave x (replacing whatever the final generator
   state otherwise would have been).  This means that computation
   needing random values which comes after interleave x does not
   necessarily depend on the computation of x.  For example:
>>> evalRandIO $ snd <$> ((,) <$> undefined <*> getRandom) *** Exception: Prelude.undefined >>> evalRandIO $ snd <$> ((,) <$> interleave undefined <*> getRandom) 6192322188769041625
This can be used, for example, to allow random computations to
   run in parallel, or to create lazy infinite structures of
   random values.  In the example below, the infinite tree
   randTree cannot be evaluated lazily: even though it is cut
   off at two levels deep by hew 2, the random value in the
   right subtree still depends on generation of all the random
   values in the (infinite) left subtree, even though they are
   ultimately unneeded.  Inserting a call to interleave, as in
   randTreeI, solves the problem: the generator splits at each
   Node, so random values in the left and right subtrees are
   generated independently.
data Tree = Leaf | Node Int Tree Tree deriving Show hew :: Int -> Tree -> Tree hew 0 _ = Leaf hew _ Leaf = Leaf hew n (Node x l r) = Node x (hew (n-1) l) (hew (n-1) r) randTree :: Rand StdGen Tree randTree = Node <$> getRandom <*> randTree <*> randTree randTreeI :: Rand StdGen Tree randTreeI = interleave $ Node <$> getRandom <*> randTreeI <*> randTreeI
>>> hew 2 <$> evalRandIO randTree Node 2168685089479838995 (Node (-1040559818952481847) Leaf Leaf) (Node ^CInterrupted. >>> hew 2 <$> evalRandIO randTreeI Node 8243316398511136358 (Node 4139784028141790719 Leaf Leaf) (Node 4473998613878251948 Leaf Leaf)
Instances
| MonadInterleave m => MonadInterleave (ListT m) Source # | |
| MonadInterleave m => MonadInterleave (MaybeT m) Source # | |
| (Error e, MonadInterleave m) => MonadInterleave (ErrorT e m) Source # | |
| MonadInterleave m => MonadInterleave (ExceptT e m) Source # | |
| MonadInterleave m => MonadInterleave (StateT s m) Source # | |
| MonadInterleave m => MonadInterleave (StateT s m) Source # | |
| (Monoid w, MonadInterleave m) => MonadInterleave (WriterT w m) Source # | |
| (Monoid w, MonadInterleave m) => MonadInterleave (WriterT w m) Source # | |
| MonadInterleave m => MonadInterleave (IdentityT * m) Source # | |
| (Monad m, RandomGen g) => MonadInterleave (RandT g m) Source # | |
| (Monad m, RandomGen g) => MonadInterleave (RandT g m) Source # | |
| MonadInterleave m => MonadInterleave (ContT * r m) Source # | |
| MonadInterleave m => MonadInterleave (ReaderT * r m) Source # | |
| (Monoid w, MonadInterleave m) => MonadInterleave (RWST r w s m) Source # | |
| (Monoid w, MonadInterleave m) => MonadInterleave (RWST r w s m) Source # | |
Sampling functions
fromList :: MonadRandom m => [(a, Rational)] -> m a Source #
Sample a random value from a weighted list. The list must be non-empty and the total weight must be non-zero.
fromListMay :: MonadRandom m => [(a, Rational)] -> m (Maybe a) Source #
Sample a random value from a weighted list.  Return Nothing if
   the list is empty or the total weight is zero.
uniform :: (Foldable t, MonadRandom m) => t a -> m a Source #
Sample a value uniformly from a nonempty collection of elements.
uniformMay :: (Foldable t, MonadRandom m) => t a -> m (Maybe a) Source #
Sample a value uniformly from a collection of elements.  Return
   Nothing if the collection is empty.
weighted :: (Foldable t, MonadRandom m) => t (a, Rational) -> m a Source #
Sample a random value from a weighted nonempty collection of
   elements.  Crashes with a call to error if the collection is
   empty or the total weight is zero.
weightedMay :: (Foldable t, MonadRandom m) => t (a, Rational) -> m (Maybe a) Source #
Sample a random value from a weighted collection of elements.
   Returns Nothing if the collection is empty or the total weight is
   zero.