system-random-effect-0.4.1.3: Random number generation for extensible effects.

Safe HaskellNone
LanguageHaskell2010

System.Random.Effect

Contents

Description

A random number effect, using a pure mersenne twister under the hood. This algorithm is not suitable for cryptography!

If you need cryptographically secure random numbers, you MUST use mkSecureRandomIO. Otherwise, mkRandom and mkRandomIO are much faster.

This effect should be plug-and-play with any application making use of extensible effects.

Patches, even for the smallest of documentation bugs, are always welcome!

Synopsis

Documentation

data Random Source

A random number generator. Either a fast, insecure mersenne twister or a secure one, depending on which smart constructor is used to construct this type.

Instances

Seeding

mkRandom :: Word64 -> Random Source

Create a random number generator from a Word64 seed. This uses the insecure (but fast) mersenne twister.

mkRandomIO :: SetMember Lift (Lift IO) r => Eff r Random Source

Create a new random number generator, using the clocktime as the base for the seed. This must be called from a computation with a lifted base effect of IO.

This is just a conveniently seeded mersenne twister.

mkSecureRandomIO :: SetMember Lift (Lift IO) r => Eff r Random Source

Creates a new random number generator, using the system entropy source as a seed. The random number generator returned from this function is cryptographically secure, but not nearly as fast as the one returned by mkRandom and mkRandomIO.

Running

forRandEff :: Eff r Random -> Eff (State Random :> r) w -> Eff r w Source

Use a non-random effect as the Random source for running a random effect.

runRandomState :: Random -> Eff (State Random :> r) w -> Eff r w Source

Runs an effectful random computation, returning the computation's result.

Uniform Distributions

uniformIntDist Source

Arguments

:: Member (State Random) r 
=> Integer

a

-> Integer

b

-> Eff r Integer 

Generates a uniformly distributed random number in the inclusive range [a, b].

uniformIntegralDist Source

Arguments

:: (Member (State Random) r, Integral a) 
=> a

a

-> a

b

-> Eff r a 

Generates a uniformly distributed random number in the inclusive range [a, b].

This function is more flexible than uniformIntDist since it relaxes type constraints, but passing in constant bounds such as uniformIntegralDist 0 10 will warn with -Wall.

uniformRealDist Source

Arguments

:: Member (State Random) r 
=> Double

a

-> Double

b

-> Eff r Double 

Generates a uniformly distributed random number in the range [a, b).

NOTE: This code might not be correct, in that the returned value may not be perfectly uniformly distributed. If you know how to make one of these a better way, PLEASE send me a pull request. I just stole this implementation from the C++11 random header.

Linear Distributions

linearRealDist :: Member (State Random) r => Double -> Double -> Eff r Double Source

Generates a linearly-distributed random number in the range [a, b); a with a probability of 0. This code is not guaranteed to be correct.

Bernoulli Distributions

bernoulliDist Source

Arguments

:: Member (State Random) r 
=> Rational

k: The fraction of results which should be true.

-> Eff r Bool 

Produces random boolean values, according to a discrete probability.

k must be in the range [0, 1].

binomialDist Source

Arguments

:: Member (State Random) r 
=> Int

t

-> Rational

p

-> Eff r Int 

The value obtained is the number of successes in a sequence of t yes/no experiments, each of which succeeds with probability p.

t must be >= 0 p must be in the range [0, 1].

negativeBinomialDist Source

Arguments

:: Member (State Random) r 
=> Rational

p

-> Integer

k

-> Eff r Integer 

The value represents the number of failures in a series of independent yes/no trials (each succeeds with probability p), before exactly k successes occur.

p must be in the range (0, 1] k must be >= 0

Warning: NOT IMPLEMENTED!

geometricDist Source

Arguments

:: Member (State Random) r 
=> Rational

p

-> Eff r Integer 

The value represents the number of yes/no trials (each succeeding with probability p) which are necessary to obtain a single success.

geometricDist p is equivalent to negativeBinomialDist 1 p

p must be in the range (0, 1]

Warning: NOT IMPLEMENTED!

Poisson Distributions

poissonDist Source

Arguments

:: Member (State Random) r 
=> Double

μ

-> Eff r Double

i

The value obtained is the probability of exactly i occurrences of a random event if the expected, mean number of its occurrence under the same conditions (on the same time/space interval) is μ.

Warning: NOT IMPLEMENTED!

exponentialDist Source

Arguments

:: Member (State Random) r 
=> Double

λ. Scale parameter.

-> Eff r Double 

The value obtained is the time/distance until the next random event if random events occur at constant rate λ per unit of time/distance. For example, this distribution describes the time between the clicks of a Geiger counter or the distance between point mutations in a DNA strand.

This is the continuous counterpart of geometricDist.

gammaDist Source

Arguments

:: Member (State Random) r 
=> Double

α. The shape parameter.

-> Double

β. The scale parameter.

-> Eff r Double 

For floating-point α, the value obtained is the sum of α independent exponentially distributed random variables, each of which has a mean of β.

weibullDist Source

Arguments

:: Member (State Random) r 
=> Double

α. The shape parameter.

-> Double

β. The scale parameter.

-> Eff r Double 

Generates random numbers as sampled from a Weibull distribution. It was originally identified to describe particle size distribution.

extremeValueDist Source

Arguments

:: Member (State Random) r 
=> Double

α. The shape parameter.

-> Double

β. The scale parameter.

-> Eff r Double 

???

Warning: NOT IMPLEMENTED!

Normal Distributions

normalDist Source

Arguments

:: Member (State Random) r 
=> Double

μ. The mean.

-> Double

σ. The standard deviation.

-> Eff r Double 

Generates random numbers as sampled from the normal distribution.

lognormalDist Source

Arguments

:: Member (State Random) r 
=> Double

μ. The mean.

-> Double

σ. The standard deviation.

-> Eff r Double 

Generates a log-normally distributed random number. This is based off of sampling the normal distribution, and then following the instructions at http://en.wikipedia.org/wiki/Log-normal_distribution#Generating_log-normally_distributed_random_variates.

chiSquaredDist Source

Arguments

:: Member (State Random) r 
=> Int

n. The number of degrees of freedom.

-> Eff r Double 

Produces random numbers according to a chi-squared distribution.

cauchyDist Source

Arguments

:: Member (State Random) r 
=> Double

Central point

-> Double

Scale parameter (full width half maximum)

-> Eff r Double 

Produced random numbers according to a Cauchy (or Lorentz) distribution.

fisherFDist Source

Arguments

:: Member (State Random) r 
=> Int

m

-> Int

n

-> Eff r Double 

Produces random numbers according to an F-distribution.

m and n are the degrees of freedom.

studentTDist Source

Arguments

:: Member (State Random) r 
=> Double

The number of degrees of freedom

-> Eff r Double 

This distribution is used when estimating the mean of an unknown normally distributed value given n+1 independent measurements, each with additive errors of unknown standard deviation, as in physical measurements. Or, alternatively, when estimating the unknown mean of a normal distribution with unknown standard deviation, given n+1 samples.

Sampling Distributions

data DiscreteDistributionHelper Source

Contains a sorted list of cumulative probabilities, so we can do a sample by generating a uniformly distributed random number in the range [0, 1), and binary searching the vector for where to put it.

buildDDH :: [Word64] -> DiscreteDistributionHelper Source

Performs O(n) work building a table which we can later use sample with discreteDist.

discreteDist :: Member (State Random) r => DiscreteDistributionHelper -> Eff r Int Source

Given a pre-build DiscreteDistributionHelper (use buildDDH), produces random integers on the interval [0, n), where the probability of each individual integer i is defined as w_i/S, that is the weight of the ith integer divided by the sum of all n weights.

i.e. This function produces an integer with probability equal to the weight given in its index into the parameter to buildDDH.

piecewiseConstantDist Source

Arguments

:: Member (State Random) r 
=> [Double]

Intervals

-> DiscreteDistributionHelper

Weights

-> Eff r Double 

This function produces random floating-point numbers, which are uniformly distributed within each of the several subintervals [b_i, b_(i+1)), each with its own weight w_i. The set of interval boundaries and the set of weights are the parameters of this distribution.

For example, piecewiseConstantDist [ 0, 1, 10, 15 ] (buildDDH [ 1, 0, 1 ]) will produce values between 0 and 1 half the time, and values between 10 and 15 the other half of the time.

piecewiseLinearDist Source

Arguments

:: Member (State Random) r 
=> [Double]

Intervals

-> DiscreteDistributionHelper

Weights

-> Eff r Double 

This function produces random floating-point numbers, which are distributed with linearly-increasing probability within each of the several subintervals [b_i, b_(i+1)), each with its own weight w_i. The set of interval boundaries and the set of weights are the parameters of this distribution.

For example, `piecewiseLinearDist [ 0, 1, 10, 15 ] (buildDDH [ 1, 0, 1 ])` will produce values between 0 and 1 half the time, and values between 10 and 15 the other half of the time.

Shuffling

knuthShuffle :: Member (State Random) r => Vector a -> Eff r (Vector a) Source

Shuffle an immutable vector.

knuthShuffleM :: (PrimMonad m, Applicative m, Typeable m, Member (State Random) r, SetMember Lift (Lift m) r) => MVector (PrimState m) a -> Eff r () Source

Shuffle a mutable vector.

Raw Generators

randomBits :: (Member (State Random) r, FiniteBits x) => Eff r x Source

Yields a set of random from the internal generator, using randomWord64 internally.

randomBitList Source

Arguments

:: Member (State Random) r 
=> Int

The number of bits to generate

-> Eff r [Bool] 

Returns a list of bits which have been randomly generated.