monte-carlo-0.6.2: A monad and transformer for Monte Carlo calculations.

CopyrightCopyright (c) 2010 Patrick Perry <patperry@gmail.com>
LicenseBSD3
MaintainerPatrick Perry <patperry@gmail.com>
Stabilityexperimental
Safe HaskellNone
LanguageHaskell98

Control.Monad.MC

Contents

Description

A monad and monad transformer for Monte Carlo computations.

Synopsis

Monte Carlo monad transformer

newtype MC m a Source #

A Monte Carlo monad transformer. This type provides access to a random number generator while allowing operations in a base monad, m.

Constructors

MC 

Fields

Instances

MonadTrans MC Source # 

Methods

lift :: Monad m => m a -> MC m a #

Monad m => Monad (MC m) Source # 

Methods

(>>=) :: MC m a -> (a -> MC m b) -> MC m b #

(>>) :: MC m a -> MC m b -> MC m b #

return :: a -> MC m a #

fail :: String -> MC m a #

Functor m => Functor (MC m) Source # 

Methods

fmap :: (a -> b) -> MC m a -> MC m b #

(<$) :: a -> MC m b -> MC m a #

MonadFix m => MonadFix (MC m) Source # 

Methods

mfix :: (a -> MC m a) -> MC m a #

Applicative m => Applicative (MC m) Source # 

Methods

pure :: a -> MC m a #

(<*>) :: MC m (a -> b) -> MC m a -> MC m b #

(*>) :: MC m a -> MC m b -> MC m b #

(<*) :: MC m a -> MC m b -> MC m a #

MonadIO m => MonadIO (MC m) Source # 

Methods

liftIO :: IO a -> MC m a #

type STMC s a = MC (ST s) a Source #

Type alias for when the base monad is ST.

type IOMC a = MC IO a Source #

Type alias for when the base monad is IO.

evalMC :: (forall s. STMC s a) -> (forall s. ST s (STRNG s)) -> a Source #

Evaluate the result of a Monte Carlo computation using the given random number generator.

Random number generator

Types

data RNG s Source #

The random number generator type.

Instances

Eq (RNG s) Source # 

Methods

(==) :: RNG s -> RNG s -> Bool #

(/=) :: RNG s -> RNG s -> Bool #

Show (RNG s) Source # 

Methods

showsPrec :: Int -> RNG s -> ShowS #

show :: RNG s -> String #

showList :: [RNG s] -> ShowS #

type IORNG = RNG (PrimState IO) Source #

A shorter name for RNG in the IO monad.

type STRNG s = RNG (PrimState (ST s)) Source #

A shorter name for RNG in the ST monad.

type Seed = Word64 Source #

The seed type for the random number generators.

Creation

mt19937 :: PrimMonad m => Seed -> m (RNG (PrimState m)) Source #

Create a Mersenne Twister random number generator seeded with the given value.

mt19937WithState :: PrimMonad m => [Word8] -> m (RNG (PrimState m)) Source #

Create a Mersenne Twister seeded with the given state.

State

getRNGName :: PrimMonad m => RNG (PrimState m) -> m String Source #

Get the name of the random number generator algorithm.

getRNGSize :: PrimMonad m => RNG (PrimState m) -> m Int Source #

Get the size of the generator state, in bytes.

getRNGState :: PrimMonad m => RNG (PrimState m) -> m [Word8] Source #

Get the state of the generator.

setRNGState :: PrimMonad m => RNG (PrimState m) -> [Word8] -> m () Source #

Set the state of the generator.

Random number distributions

Uniform

uniform :: PrimMonad m => Double -> Double -> MC m Double Source #

uniform a b generates a value uniformly distributed in [a,b).

uniformInt :: PrimMonad m => Int -> MC m Int Source #

uniformInt n generates an integer uniformly in the range [0,n-1]. It is an error to call this function with a non-positive value.

Continuous

normal :: PrimMonad m => Double -> Double -> MC m Double Source #

normal mu sigma generates a Normal random variable with mean mu and standard deviation sigma.

exponential :: PrimMonad m => Double -> MC m Double Source #

exponential mu generates an Exponential variate with mean mu.

gamma :: PrimMonad m => Double -> Double -> MC m Double Source #

gamma a b generates a gamma random variable with parameters a and b.

cauchy :: PrimMonad m => Double -> MC m Double Source #

cauchy a generates a Cauchy random variable with scale parameter a.

levy :: PrimMonad m => Double -> Double -> MC m Double Source #

levy c alpha gets a Levy alpha-stable variate with scale c and exponent alpha. The algorithm only works for 0 < alpha <= 2.

levySkew :: PrimMonad m => Double -> Double -> Double -> MC m Double Source #

levySkew c alpha beta gets a skew Levy alpha-stable variate with scale c, exponent alpha, and skewness beta. The skew parameter must lie in the range [-1,1]. The algorithm only works for 0 < alpha <= 2.

pareto :: PrimMonad m => Double -> Double -> MC m Double Source #

pareto a b generates a Pareto random variable with exponent a and scale b.

weibull :: PrimMonad m => Double -> Double -> MC m Double Source #

weibull a b generates a Weibull random variable with scale a and exponent b.

logistic :: PrimMonad m => Double -> MC m Double Source #

logistic a generates a logistic random variable with parameter a.

beta :: PrimMonad m => Double -> Double -> MC m Double Source #

beta a b generates a beta random variable with parameters a and b.

Discrete

bernoulli :: PrimMonad m => Double -> MC m Bool Source #

Generate True events with the given probability.

poisson :: PrimMonad m => Double -> MC m Int Source #

poisson mu generates a Poisson random variable with mean mu.

Multivariate

dirichlet :: PrimMonad m => Vector Double -> MC m (Vector Double) Source #

dirichlet alphas generates a Dirichlet random variable with parameters alphas.

multinomial :: PrimMonad m => Int -> Vector Double -> MC m (Vector Int) Source #

multinomial n ps generates a multinomial random variable with parameters ps formed by n trials.

Sampling

Lists

sample :: PrimMonad m => [a] -> MC m a Source #

sample xs samples a value uniformly from the elements of xs. The results are undefined if length xs is zero.

sampleWithWeights :: PrimMonad m => [(Double, a)] -> MC m a Source #

sampleWithWeights wxs samples a value from the list with the given weight.

sampleSubset :: PrimMonad m => [a] -> Int -> MC m [a] Source #

sampleSubset xs k samples a subset of size k from xs by sampling without replacement. The return value is a list of length k with the elements in the subset in the order that they were sampled.

sampleSubsetWithWeights :: PrimMonad m => [(Double, a)] -> Int -> MC m [a] Source #

Sample a subset of the elements with the given weights. Return the elements of the subset in the order they were sampled.

shuffle :: PrimMonad m => [a] -> MC m [a] Source #

shuffle xs randomly permutes the list xs and returns the result. All permutations of the elements of xs are equally likely.

Ints

sampleInt :: PrimMonad m => Int -> MC m Int Source #

sampleInt n samples integers uniformly from [ 0..n-1 ]. It is an error to call this function with a non-positive n.

sampleIntWithWeights :: PrimMonad m => [Double] -> Int -> MC m Int Source #

sampleIntWithWeights ws n samples integers from [ 0..n-1 ] with the probability of choosing i proportional to ws !! i. The list ws must have length equal to n. Also, the elements of ws must be non-negative with at least one nonzero entry.

sampleIntSubset :: PrimMonad m => Int -> Int -> MC m [Int] Source #

sampleIntSubset n k samples a subset of size k by sampling without replacement from the integers { 0, ..., n-1 }. The return value is a list of length k with the elements in the subset in the order that they were sampled.

sampleIntSubsetWithWeights :: PrimMonad m => [Double] -> Int -> Int -> MC m [Int] Source #

sampleIntSubsetWithWeights ws n k samplea size k subset of { 0, ..., n-1 } with the given weights by sampling elements without replacement. It returns the elements of the subset in the order they were sampled.

shuffleInt :: PrimMonad m => Int -> MC m [Int] Source #

shuffleInt n randomly permutes the elements of the list [ 0..n-1 ].

Repeating computations

foldMC Source #

Arguments

:: PrimMonad m 
=> (a -> b -> MC m a)

Replicate consumer.

-> a

Initial state for replicate consumer.

-> Int

Number of replicates.

-> MC m b

Generator.

-> MC m a 

Generate a sequence of replicates and incrementally consume them via a left fold.

This fold is not strict. The replicate consumer is responsible for forcing the evaluation of its result to avoid space leaks.

repeatMC :: (forall s. STMC s a) -> (forall s. ST s (STRNG s)) -> [a] Source #

Produce a lazy infinite list of replicates from the given random number generator and Monte Carlo procedure.

replicateMC :: Int -> (forall s. STMC s a) -> (forall s. ST s (STRNG s)) -> [a] Source #

Produce a lazy list of the given length using the specified random number genrator and Monte Carlo procedure.