random-fu-0.3.0.1/0000755000000000000000000000000007346545000011732 5ustar0000000000000000random-fu-0.3.0.1/Setup.lhs0000644000000000000000000000011607346545000013540 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain random-fu-0.3.0.1/changelog.md0000644000000000000000000000304307346545000014203 0ustar0000000000000000* Chnages in 0.3.0.0: * Drop usage of `random-source` in favor of `random` * Changes in 0.2.7.7: Update to random-1.2. Revert 0.2.7.6 changes (which added an extra constraint to `Data.Random.Sample.sampleState` and `Data.Random.Sample.sampleStateT`). * Changes in 0.2.7.4: Compatibility with ghc 8.8. * Changes in 0.2.7.3: Remove dependence on log-domain. Raise lower bound for base to 4.9. * Changes in 0.2.7.1: Add PDF instance for Poisson. * Changes in 0.2.7.0: Add Simplex, fix logBetaPdf, fix binomialPdf and binomialCdf to actually use the numerically stable method! * Changes in 2.6.1: now supports probability density functions and log probability density functions via the PDF class, similar to R and initially just for the Beta, Binomial, Normal and Uniform distributions. The log Binomial probability density function uses *Fast and Accurate Computation of Binomial Probabilities* by Catherine Loader (this is what is implemented in R and Octave) to minimize the occurrence of underflow. * Changes in 0.2.4.0: Added a Lift instance that resolves a common overlapping-instance issue in user code. * Changes in 0.2.3.1: Should now build on GHC 7.6 * Changes in 0.2.3.0: Added stretched exponential distribution, contributed by Ben Gamari. * Changes in 0.2.2.0: Bug fixes in Data.Random.Distribution.Categorical. * Changes in 0.2.1.1: Changed some one-field data types to newtypes, updated types for GHC 7.4's removal of Eq and Show from the context of Num, and added RVarT versions of random variables in Data.Random.List random-fu-0.3.0.1/random-fu.cabal0000644000000000000000000001063607346545000014614 0ustar0000000000000000name: random-fu version: 0.3.0.1 stability: provisional cabal-version: >= 1.10 build-type: Simple author: James Cook maintainer: Dominic Steinitz license: PublicDomain homepage: https://github.com/mokus0/random-fu category: Math synopsis: Random number generation description: Random number generation based on modeling random variables in two complementary ways: first, by the parameters of standard mathematical distributions and, second, by an abstract type ('RVar') which can be composed and manipulated monadically and sampled in either monadic or \"pure\" styles. . The primary purpose of this library is to support defining and sampling a wide variety of high quality random variables. Quality is prioritized over speed, but performance is an important goal too. . In my testing, I have found it capable of speed comparable to other Haskell libraries, but still a fair bit slower than straight C implementations of the same algorithms. tested-with: GHC == 8.10.7 extra-source-files: changelog.md source-repository head type: git location: https://github.com/haskell-numerics/random-fu subdir: random-fu Flag base4_2 Description: base-4.2 has an incompatible change in Data.Fixed (HasResolution) Flag mtl2 Description: mtl-2 has State, etc., as "type" rather than "newtype" Library ghc-options: -Wall -funbox-strict-fields hs-source-dirs: src default-language: Haskell2010 exposed-modules: Data.Random Data.Random.Distribution Data.Random.Distribution.Bernoulli Data.Random.Distribution.Beta Data.Random.Distribution.Binomial Data.Random.Distribution.Categorical Data.Random.Distribution.ChiSquare Data.Random.Distribution.Dirichlet Data.Random.Distribution.Exponential Data.Random.Distribution.StretchedExponential Data.Random.Distribution.Gamma Data.Random.Distribution.Multinomial Data.Random.Distribution.Normal Data.Random.Distribution.Pareto Data.Random.Distribution.Poisson Data.Random.Distribution.Rayleigh Data.Random.Distribution.Simplex Data.Random.Distribution.T Data.Random.Distribution.Triangular Data.Random.Distribution.Uniform Data.Random.Distribution.Weibull Data.Random.Distribution.Ziggurat Data.Random.Internal.Find Data.Random.Internal.Fixed Data.Random.Lift Data.Random.List Data.Random.RVar Data.Random.Sample Data.Random.Vector if flag(base4_2) build-depends: base >= 4.9 && <5 else cpp-options: -Dold_Fixed build-depends: base >= 4 && <4.2 if flag(mtl2) build-depends: mtl == 2.* cpp-options: -DMTL2 else build-depends: mtl == 1.* build-depends: math-functions, monad-loops >= 0.3.0.1, random >= 1.2 && < 1.3, random-shuffle, rvar >= 0.3, syb, template-haskell, transformers, vector >= 0.7, erf if impl(ghc == 7.2.1) -- Doesn't work under GHC 7.2.1 due to -- http://hackage.haskell.org/trac/ghc/ticket/5410 -- (7.2.2 is fine though, as long as random-source is new enough) Buildable: False random-fu-0.3.0.1/src/Data/0000755000000000000000000000000007346545000013372 5ustar0000000000000000random-fu-0.3.0.1/src/Data/Random.hs0000644000000000000000000000647407346545000015161 0ustar0000000000000000-- |Flexible modeling and sampling of random variables. -- -- The central abstraction in this library is the concept of a random -- variable. It is not fully formalized in the standard measure-theoretic -- language, but rather is informally defined as a \"thing you can get random -- values out of\". Different random variables may have different types of -- values they can return or the same types but different probabilities for -- each value they can return. The random values you get out of them are -- traditionally called \"random variates\". -- -- Most imperative-language random number libraries are all about obtaining -- and manipulating random variates. This one is about defining, manipulating -- and sampling random variables. Computationally, the distinction is small -- and mostly just a matter of perspective, but from a program design -- perspective it provides both a powerfully composable abstraction and a -- very useful separation of concerns. -- -- Abstract random variables as implemented by 'RVar' are composable. They can -- be defined in a monadic / \"imperative\" style that amounts to manipulating -- variates, but with strict type-level isolation. Concrete random variables -- are also provided, but they do not compose as generically. The 'Distribution' -- type class allows concrete random variables to \"forget\" their concreteness -- so that they can be composed. For examples of both, see the documentation -- for 'RVar' and 'Distribution', as well as the code for any of the concrete -- distributions such as 'Uniform', 'Gamma', etc. -- -- Both abstract and concrete random variables can be sampled (despite the -- types GHCi may list for the functions) by the functions in "Data.Random.Sample". -- -- Random variable sampling is done with regard to a generic basis of primitive -- random variables defined in "Data.Random.Internal.Primitives". This basis -- is very low-level and the actual set of primitives is still fairly experimental, -- which is why it is in the \"Internal\" sub-heirarchy. User-defined variables -- should use the existing high-level variables such as 'Uniform' and 'Normal' -- rather than these basis variables. "Data.Random.Source" defines classes for -- entropy sources that provide implementations of these primitive variables. -- Several implementations are available in the Data.Random.Source.* modules. module Data.Random ( -- * Random variables -- ** Abstract ('RVar') RVar, RVarT, runRVar, runRVarT, runRVarTWith, -- ** Concrete ('Distribution') Distribution(..), CDF(..), PDF(..), -- * Sampling random variables Sampleable(..), sample, sampleState, samplePure, -- * A few very common distributions Uniform(..), uniform, uniformT, StdUniform(..), stdUniform, stdUniformT, Normal(..), normal, stdNormal, normalT, stdNormalT, Gamma(..), gamma, gammaT, -- * Entropy Sources StatefulGen, RandomGen, -- * Useful list-based operations randomElement, shuffle, shuffleN, shuffleNofM ) where import Data.Random.Sample import Data.Random.Distribution import Data.Random.Distribution.Gamma import Data.Random.Distribution.Normal import Data.Random.Distribution.Uniform import Data.Random.Lift () import Data.Random.List import Data.Random.RVar import System.Random.Stateful (StatefulGen, RandomGen) random-fu-0.3.0.1/src/Data/Random/0000755000000000000000000000000007346545000014612 5ustar0000000000000000random-fu-0.3.0.1/src/Data/Random/Distribution.hs0000644000000000000000000001037607346545000017634 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-} module Data.Random.Distribution where import Data.Random.Lift import Data.Random.RVar -- |A 'Distribution' is a data representation of a random variable's probability -- structure. For example, in "Data.Random.Distribution.Normal", the 'Normal' -- distribution is defined as: -- -- > data Normal a -- > = StdNormal -- > | Normal a a -- -- Where the two parameters of the 'Normal' data constructor are the mean and -- standard deviation of the random variable, respectively. To make use of -- the 'Normal' type, one can convert it to an 'rvar' and manipulate it or -- sample it directly: -- -- > x <- sample (rvar (Normal 10 2)) -- > x <- sample (Normal 10 2) -- -- A 'Distribution' is typically more transparent than an 'RVar' -- but less composable (precisely because of that transparency). There are -- several practical uses for types implementing 'Distribution': -- -- * Typically, a 'Distribution' will expose several parameters of a standard -- mathematical model of a probability distribution, such as mean and std deviation for -- the normal distribution. Thus, they can be manipulated analytically using -- mathematical insights about the distributions they represent. For example, -- a collection of bernoulli variables could be simplified into a (hopefully) smaller -- collection of binomial variables. -- -- * Because they are generally just containers for parameters, they can be -- easily serialized to persistent storage or read from user-supplied -- configurations (eg, initialization data for a simulation). -- -- * If a type additionally implements the 'CDF' subclass, which extends -- 'Distribution' with a cumulative density function, an arbitrary random -- variable 'x' can be tested against the distribution by testing -- @fmap (cdf dist) x@ for uniformity. -- -- On the other hand, most 'Distribution's will not be closed under all the -- same operations as 'RVar' (which, being a monad, has a fully turing-complete -- internal computational model). The sum of two uniformly-distributed -- variables, for example, is not uniformly distributed. To support general -- composition, the 'Distribution' class defines a function 'rvar' to -- construct the more-abstract and more-composable 'RVar' representation -- of a random variable. class Distribution d t where -- |Return a random variable with this distribution. rvar :: d t -> RVar t rvar = rvarT -- |Return a random variable with the given distribution, pre-lifted to an arbitrary 'RVarT'. -- Any arbitrary 'RVar' can also be converted to an 'RVarT m' for an arbitrary 'm', using -- either 'lift' or 'sample'. rvarT :: d t -> RVarT n t rvarT d = lift (rvar d) -- FIXME: I am not sure about giving default instances class Distribution d t => PDF d t where pdf :: d t -> t -> Double pdf d = exp . logPdf d logPdf :: d t -> t -> Double logPdf d = log . pdf d class Distribution d t => CDF d t where -- |Return the cumulative distribution function of this distribution. -- That is, a function taking @x :: t@ to the probability that the next -- sample will return a value less than or equal to x, according to some -- order or partial order (not necessarily an obvious one). -- -- In the case where 't' is an instance of Ord, 'cdf' should correspond -- to the CDF with respect to that order. -- -- In other cases, 'cdf' is only required to satisfy the following law: -- @fmap (cdf d) (rvar d)@ -- must be uniformly distributed over (0,1). Inclusion of either endpoint is optional, -- though the preferred range is (0,1]. -- -- Note that this definition requires that 'cdf' for a product type -- should _not_ be a joint CDF as commonly defined, as that definition -- violates both conditions. -- Instead, it should be a univariate CDF over the product type. That is, -- it should represent the CDF with respect to the lexicographic order -- of the product. -- -- The present specification is probably only really useful for testing -- conformance of a variable to its target distribution, and I am open to -- suggestions for more-useful specifications (especially with regard to -- the interaction with product types). cdf :: d t -> t -> Double random-fu-0.3.0.1/src/Data/Random/Distribution/0000755000000000000000000000000007346545000017271 5ustar0000000000000000random-fu-0.3.0.1/src/Data/Random/Distribution/Bernoulli.hs0000644000000000000000000001442607346545000021567 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.Bernoulli where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Uniform import Data.Ratio import Data.Complex import Data.Int import Data.Word -- |Generate a Bernoulli variate with the given probability. For @Bool@ results, -- @bernoulli p@ will return True (p*100)% of the time and False otherwise. -- For numerical types, True is replaced by 1 and False by 0. bernoulli :: Distribution (Bernoulli b) a => b -> RVar a bernoulli p = rvar (Bernoulli p) -- |Generate a Bernoulli process with the given probability. For @Bool@ results, -- @bernoulli p@ will return True (p*100)% of the time and False otherwise. -- For numerical types, True is replaced by 1 and False by 0. bernoulliT :: Distribution (Bernoulli b) a => b -> RVarT m a bernoulliT p = rvarT (Bernoulli p) -- |A random variable whose value is 'True' the given fraction of the time -- and 'False' the rest. boolBernoulli :: (Fractional a, Ord a, Distribution StdUniform a) => a -> RVarT m Bool boolBernoulli p = do x <- stdUniformT return (x <= p) boolBernoulliCDF :: (Real a) => a -> Bool -> Double boolBernoulliCDF _ True = 1 boolBernoulliCDF p False = (1 - realToFrac p) -- | @generalBernoulli t f p@ generates a random variable whose value is @t@ -- with probability @p@ and @f@ with probability @1-p@. generalBernoulli :: Distribution (Bernoulli b) Bool => a -> a -> b -> RVarT m a generalBernoulli f t p = do x <- bernoulliT p return (if x then t else f) generalBernoulliCDF :: CDF (Bernoulli b) Bool => (a -> a -> Bool) -> a -> a -> b -> a -> Double generalBernoulliCDF gte f t p x | f `gte` t = error "generalBernoulliCDF: f >= t" | x `gte` t = cdf (Bernoulli p) True | x `gte` f = cdf (Bernoulli p) False | otherwise = 0 newtype Bernoulli b a = Bernoulli b instance (Fractional b, Ord b, Distribution StdUniform b) => Distribution (Bernoulli b) Bool where rvarT (Bernoulli p) = boolBernoulli p instance (Distribution (Bernoulli b) Bool, Real b) => CDF (Bernoulli b) Bool where cdf (Bernoulli p) = boolBernoulliCDF p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Integer where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Integer where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Int where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Int where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Int8 where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Int8 where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Int16 where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Int16 where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Int32 where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Int32 where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Int64 where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Int64 where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Word where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Word where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Word8 where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Word8 where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Word16 where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Word16 where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Word32 where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Word32 where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Word64 where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Word64 where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Float where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Float where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance Distribution (Bernoulli b) Bool => Distribution (Bernoulli b) Double where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance CDF (Bernoulli b) Bool => CDF (Bernoulli b) Double where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance (Distribution (Bernoulli b) Bool, Integral a) => Distribution (Bernoulli b) (Ratio a) where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance (CDF (Bernoulli b) Bool, Integral a) => CDF (Bernoulli b) (Ratio a) where cdf (Bernoulli p) = generalBernoulliCDF (>=) 0 1 p instance (Distribution (Bernoulli b) Bool, RealFloat a) => Distribution (Bernoulli b) (Complex a) where rvarT (Bernoulli p) = generalBernoulli 0 1 p instance (CDF (Bernoulli b) Bool, RealFloat a) => CDF (Bernoulli b) (Complex a) where cdf (Bernoulli p) = generalBernoulliCDF (\x y -> realPart x >= realPart y) 0 1 p random-fu-0.3.0.1/src/Data/Random/Distribution/Beta.hs0000644000000000000000000000346307346545000020506 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.Beta where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Gamma import Data.Random.Distribution.Uniform import Numeric.SpecFunctions {-# SPECIALIZE fractionalBeta :: Float -> Float -> RVarT m Float #-} {-# SPECIALIZE fractionalBeta :: Double -> Double -> RVarT m Double #-} fractionalBeta :: (Fractional a, Eq a, Distribution Gamma a, Distribution StdUniform a) => a -> a -> RVarT m a fractionalBeta 1 1 = stdUniformT fractionalBeta a b = do x <- gammaT a 1 y <- gammaT b 1 return (x / (x + y)) {-# SPECIALIZE beta :: Float -> Float -> RVar Float #-} {-# SPECIALIZE beta :: Double -> Double -> RVar Double #-} beta :: Distribution Beta a => a -> a -> RVar a beta a b = rvar (Beta a b) {-# SPECIALIZE betaT :: Float -> Float -> RVarT m Float #-} {-# SPECIALIZE betaT :: Double -> Double -> RVarT m Double #-} betaT :: Distribution Beta a => a -> a -> RVarT m a betaT a b = rvarT (Beta a b) data Beta a = Beta a a -- FIXME: I am far from convinced that NaNs are a good idea. logBetaPdf :: Double -> Double -> Double -> Double logBetaPdf a b x | a <= 0 || b <= 0 = nan | x <= 0 = log 0 | x >= 1 = log 0 | otherwise = (a-1)*log x + (b-1)*log (1-x) - logBeta a b where nan = 0.0 / 0.0 instance PDF Beta Double where pdf (Beta a b) = exp . logBetaPdf a b instance PDF Beta Float where pdf (Beta a b) = realToFrac . exp . logBetaPdf (realToFrac a) (realToFrac b) . realToFrac instance Distribution Beta Float where rvarT (Beta a b) = fractionalBeta a b instance Distribution Beta Double where rvarT (Beta a b) = fractionalBeta a b random-fu-0.3.0.1/src/Data/Random/Distribution/Binomial.hs0000644000000000000000000003043307346545000021362 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, BangPatterns #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.Binomial where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Beta import Data.Random.Distribution.Uniform import Data.Int import Data.Word import Numeric.SpecFunctions ( stirlingError ) import Numeric.SpecFunctions.Extra ( bd0 ) import Numeric ( log1p ) -- algorithm from Knuth's TAOCP, 3rd ed., p 136 -- specific choice of cutoff size taken from gsl source -- note that although it's fast enough for large (eg, 2^10000) -- @Integer@s, it's not accurate enough when using @Double@ as -- the @b@ parameter. integralBinomial :: (Integral a, Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => a -> b -> RVarT m a integralBinomial = bin 0 where bin :: (Integral a, Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => a -> a -> b -> RVarT m a bin !k !t !p | t > 10 = do let a = 1 + t `div` 2 b = 1 + t - a x <- betaT (fromIntegral a) (fromIntegral b) if x >= p then bin k (a - 1) (p / x) else bin (k + a) (b - 1) ((p - x) / (1 - x)) | otherwise = count k t where count !k' 0 = return k' count !k' n | n > 0 = do x <- stdUniformT count (if x < p then k' + 1 else k') (n-1) count _ _ = error "integralBinomial: negative number of trials specified" integralBinomialCDF :: (Integral a, Real b) => a -> b -> a -> Double integralBinomialCDF t p x = sum $ map (integralBinomialPDF t p) $ [0 .. x] -- | The probability of getting exactly k successes in n trials is -- given by the probability mass function: -- -- \[ -- f(k;n,p) = \Pr(X = k) = \binom n k p^k(1-p)^{n-k} -- \] -- -- Note that in `integralBinomialPDF` the parameters of the mass -- function are given first and the range of the random variable -- distributed according to the binomial distribution is given -- last. That is, \(f(2;4,0.5)\) is calculated by @integralBinomialPDF 4 0.5 2@. integralBinomialPDF :: (Integral a, Real b) => a -> b -> a -> Double integralBinomialPDF t p x = exp $ integralBinomialLogPdf t p x -- | We use the method given in \"Fast and accurate computation of -- binomial probabilities, Loader, C\", -- integralBinomialLogPdf :: (Integral a, Real b) => a -> b -> a -> Double integralBinomialLogPdf nI pR xI | p == 0.0 && xI == 0 = 1.0 | p == 0.0 = 0.0 | p == 1.0 && xI == nI = 1.0 | p == 1.0 = 0.0 | xI == 0 = n * log (1-p) | xI == nI = n * log p | otherwise = lc - 0.5 * lf where n = fromIntegral nI x = fromIntegral xI p = realToFrac pR lc = stirlingError n - stirlingError x - stirlingError (n - x) - bd0 x (n * p) - bd0 (n - x) (n * (1 - p)) lf = log (2 * pi) + log x + log1p (- x / n) -- would it be valid to repeat the above computation using fractional @t@? -- obviously something different would have to be done with @count@ as well... {-# SPECIALIZE floatingBinomial :: Float -> Float -> RVar Float #-} {-# SPECIALIZE floatingBinomial :: Float -> Double -> RVar Float #-} {-# SPECIALIZE floatingBinomial :: Double -> Float -> RVar Double #-} {-# SPECIALIZE floatingBinomial :: Double -> Double -> RVar Double #-} floatingBinomial :: (RealFrac a, Distribution (Binomial b) Integer) => a -> b -> RVar a floatingBinomial t p = fmap fromInteger (rvar (Binomial (truncate t) p)) floatingBinomialCDF :: (CDF (Binomial b) Integer, RealFrac a) => a -> b -> a -> Double floatingBinomialCDF t p x = cdf (Binomial (truncate t :: Integer) p) (floor x) floatingBinomialPDF :: (PDF (Binomial b) Integer, RealFrac a) => a -> b -> a -> Double floatingBinomialPDF t p x = pdf (Binomial (truncate t :: Integer) p) (floor x) floatingBinomialLogPDF :: (PDF (Binomial b) Integer, RealFrac a) => a -> b -> a -> Double floatingBinomialLogPDF t p x = logPdf (Binomial (truncate t :: Integer) p) (floor x) {-# SPECIALIZE binomial :: Int -> Float -> RVar Int #-} {-# SPECIALIZE binomial :: Int -> Double -> RVar Int #-} {-# SPECIALIZE binomial :: Integer -> Float -> RVar Integer #-} {-# SPECIALIZE binomial :: Integer -> Double -> RVar Integer #-} {-# SPECIALIZE binomial :: Float -> Float -> RVar Float #-} {-# SPECIALIZE binomial :: Float -> Double -> RVar Float #-} {-# SPECIALIZE binomial :: Double -> Float -> RVar Double #-} {-# SPECIALIZE binomial :: Double -> Double -> RVar Double #-} binomial :: Distribution (Binomial b) a => a -> b -> RVar a binomial t p = rvar (Binomial t p) {-# SPECIALIZE binomialT :: Int -> Float -> RVarT m Int #-} {-# SPECIALIZE binomialT :: Int -> Double -> RVarT m Int #-} {-# SPECIALIZE binomialT :: Integer -> Float -> RVarT m Integer #-} {-# SPECIALIZE binomialT :: Integer -> Double -> RVarT m Integer #-} {-# SPECIALIZE binomialT :: Float -> Float -> RVarT m Float #-} {-# SPECIALIZE binomialT :: Float -> Double -> RVarT m Float #-} {-# SPECIALIZE binomialT :: Double -> Float -> RVarT m Double #-} {-# SPECIALIZE binomialT :: Double -> Double -> RVarT m Double #-} binomialT :: Distribution (Binomial b) a => a -> b -> RVarT m a binomialT t p = rvarT (Binomial t p) data Binomial b a = Binomial a b instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Integer where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Integer) => CDF (Binomial b) Integer where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Integer) => PDF (Binomial b) Integer where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Int where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Int) => CDF (Binomial b) Int where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Int) => PDF (Binomial b) Int where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Int8 where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Int8) => CDF (Binomial b) Int8 where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Int8) => PDF (Binomial b) Int8 where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Int16 where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Int16) => CDF (Binomial b) Int16 where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Int16) => PDF (Binomial b) Int16 where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Int32 where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Int32) => CDF (Binomial b) Int32 where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Int32) => PDF (Binomial b) Int32 where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Int64 where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Int64) => CDF (Binomial b) Int64 where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Int64) => PDF (Binomial b) Int64 where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Word where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Word) => CDF (Binomial b) Word where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Word) => PDF (Binomial b) Word where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Word8 where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Word8) => CDF (Binomial b) Word8 where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Word8) => PDF (Binomial b) Word8 where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Word16 where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Word16) => CDF (Binomial b) Word16 where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Word16) => PDF (Binomial b) Word16 where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Word32 where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Word32) => CDF (Binomial b) Word32 where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Word32) => PDF (Binomial b) Word32 where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance (Floating b, Ord b, Distribution Beta b, Distribution StdUniform b) => Distribution (Binomial b) Word64 where rvarT (Binomial t p) = integralBinomial t p instance (Real b, Distribution (Binomial b) Word64) => CDF (Binomial b) Word64 where cdf (Binomial t p) = integralBinomialCDF t p instance (Real b, Distribution (Binomial b) Word64) => PDF (Binomial b) Word64 where pdf (Binomial t p) = integralBinomialPDF t p logPdf (Binomial t p) = integralBinomialLogPdf t p instance Distribution (Binomial b) Integer => Distribution (Binomial b) Float where rvar (Binomial t p) = floatingBinomial t p instance CDF (Binomial b) Integer => CDF (Binomial b) Float where cdf (Binomial t p) = floatingBinomialCDF t p instance PDF (Binomial b) Integer => PDF (Binomial b) Float where pdf (Binomial t p) = floatingBinomialPDF t p logPdf (Binomial t p) = floatingBinomialLogPDF t p instance Distribution (Binomial b) Integer => Distribution (Binomial b) Double where rvar (Binomial t p) = floatingBinomial t p instance CDF (Binomial b) Integer => CDF (Binomial b) Double where cdf (Binomial t p) = floatingBinomialCDF t p instance PDF (Binomial b) Integer => PDF (Binomial b) Double where pdf (Binomial t p) = floatingBinomialPDF t p logPdf (Binomial t p) = floatingBinomialLogPDF t p random-fu-0.3.0.1/src/Data/Random/Distribution/Categorical.hs0000644000000000000000000002433107346545000022045 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, CPP #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.Categorical ( Categorical , categorical, categoricalT , weightedCategorical, weightedCategoricalT , fromList, toList, totalWeight, numEvents , fromWeightedList, fromObservations , mapCategoricalPs, normalizeCategoricalPs , collectEvents, collectEventsBy ) where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Uniform import Control.Arrow import Control.Monad import Control.Monad.ST import Data.STRef import Data.List import Data.Function import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV -- |Construct a 'Categorical' random variable from a list of probabilities -- and categories, where the probabilities all sum to 1. categorical :: (Num p, Distribution (Categorical p) a) => [(p,a)] -> RVar a categorical = rvar . fromList -- |Construct a 'Categorical' random process from a list of probabilities -- and categories, where the probabilities all sum to 1. categoricalT :: (Num p, Distribution (Categorical p) a) => [(p,a)] -> RVarT m a categoricalT = rvarT . fromList -- |Construct a 'Categorical' random variable from a list of weights -- and categories. The weights do /not/ have to sum to 1. weightedCategorical :: (Fractional p, Eq p, Distribution (Categorical p) a) => [(p,a)] -> RVar a weightedCategorical = rvar . fromWeightedList -- |Construct a 'Categorical' random process from a list of weights -- and categories. The weights do /not/ have to sum to 1. weightedCategoricalT :: (Fractional p, Eq p, Distribution (Categorical p) a) => [(p,a)] -> RVarT m a weightedCategoricalT = rvarT . fromWeightedList -- | Construct a 'Categorical' distribution from a list of weighted categories. {-# INLINE fromList #-} fromList :: (Num p) => [(p,a)] -> Categorical p a fromList xs = Categorical (V.fromList (scanl1 f xs)) where f (p0, _) (p1, y) = (p0 + p1, y) {-# INLINE toList #-} toList :: (Num p) => Categorical p a -> [(p,a)] toList (Categorical ds) = V.foldr' g [] ds where g x [] = [x] g x@(p0,_) ((p1, y):xs) = x : (p1-p0,y) : xs totalWeight :: Num p => Categorical p a -> p totalWeight (Categorical ds) | V.null ds = 0 | otherwise = fst (V.last ds) numEvents :: Categorical p a -> Int numEvents (Categorical ds) = V.length ds -- |Construct a 'Categorical' distribution from a list of weighted categories, -- where the weights do not necessarily sum to 1. fromWeightedList :: (Fractional p, Eq p) => [(p,a)] -> Categorical p a fromWeightedList = normalizeCategoricalPs . fromList -- |Construct a 'Categorical' distribution from a list of observed outcomes. -- Equivalent events will be grouped and counted, and the probabilities of each -- event in the returned distribution will be proportional to the number of -- occurrences of that event. fromObservations :: (Fractional p, Eq p, Ord a) => [a] -> Categorical p a fromObservations = fromWeightedList . map (genericLength &&& head) . group . sort -- The following description refers to the public interface. For those reading -- the code, in the actual implementation Categorical is stored as a vector of -- (cumulative-probability, value) pairs, so that sampling can take advantage of -- binary search. -- |Categorical distribution; a list of events with corresponding probabilities. -- The sum of the probabilities must be 1, and no event should have a zero -- or negative probability (at least, at time of sampling; very clever users -- can do what they want with the numbers before sampling, just make sure -- that if you're one of those clever ones, you at least eliminate negative -- weights before sampling). newtype Categorical p a = Categorical (V.Vector (p, a)) deriving Eq instance (Num p, Show p, Show a) => Show (Categorical p a) where showsPrec p cat = showParen (p>10) ( showString "fromList " . showsPrec 11 (toList cat) ) instance (Num p, Read p, Read a) => Read (Categorical p a) where readsPrec p = readParen (p > 10) $ \str -> do ("fromList", valStr) <- lex str (vals, rest) <- readsPrec 11 valStr return (fromList vals, rest) instance (Fractional p, Ord p, Distribution Uniform p) => Distribution (Categorical p) a where rvarT (Categorical ds) | V.null ds = error "categorical distribution over empty set cannot be sampled" | n == 1 = return (snd (V.head ds)) | otherwise = do u <- uniformT 0 (fst (V.last ds)) let -- by construction, p is monotone; (i < j) ==> (p i <= p j) p i = fst (ds V.! i) x i = snd (ds V.! i) -- findEvent -- =========== -- invariants: (i <= j), (u <= p j), ((i == 0) || (p i < u)) -- (the last one means 'i' does not increase unless it bounds 'p' below 'u') -- variant: either i increases or j decreases. -- upon termination: ∀ k. if (k < j) then (p k < u) else (u <= p k) -- (that is, the chosen event 'x j' is the first one whose -- associated cumulative probability 'p j' is greater than -- or equal to 'u') findEvent i j | j <= i = x j | u <= p m = findEvent i m | otherwise = findEvent (max m (i+1)) j where -- midpoint rounding down -- (i < j) ==> (m < j) m = (i + j) `div` 2 return $! if u <= 0 then x 0 else findEvent 0 (n-1) where n = V.length ds instance Functor (Categorical p) where fmap f (Categorical ds) = Categorical (V.map (second f) ds) instance Foldable (Categorical p) where foldMap f (Categorical ds) = foldMap (f . snd) (V.toList ds) instance Traversable (Categorical p) where traverse f (Categorical ds) = Categorical . V.fromList <$> traverse (\(p,e) -> (\e' -> (p,e')) <$> f e) (V.toList ds) sequenceA (Categorical ds) = Categorical . V.fromList <$> traverse (\(p,e) -> (\e' -> (p,e')) <$> e) (V.toList ds) instance Fractional p => Monad (Categorical p) where return x = Categorical (V.singleton (1, x)) -- I'm not entirely sure whether this is a valid form of failure; see next -- set of comments. #if __GLASGOW_HASKELL__ < 808 fail _ = Categorical V.empty #endif -- Should the normalize step be included here, or should normalization -- be assumed? It seems like there is (at least) 1 valid situation where -- non-normal results would arise: the distribution being modeled is -- "conditional" and some event arose that contradicted the assumed -- condition and thus was eliminated ('f' returned an empty or -- zero-probability consequent, possibly by 'fail'ing). -- -- It seems reasonable to continue in such circumstances, but should there -- be any renormalization? If so, does it make a difference when that -- renormalization is done? I'm pretty sure it does, actually. So, the -- normalization will be omitted here for now, as it's easier for the -- user (who really better know what they mean if they're returning -- non-normalized probability anyway) to normalize explicitly than to -- undo any normalization that was done automatically. xs >>= f = {- normalizeCategoricalPs . -} fromList $ do (p, x) <- toList xs (q, y) <- toList (f x) return (p * q, y) instance Fractional p => Applicative (Categorical p) where pure = return (<*>) = ap -- |Like 'fmap', but for the probabilities of a categorical distribution. mapCategoricalPs :: (Num p, Num q) => (p -> q) -> Categorical p e -> Categorical q e mapCategoricalPs f = fromList . map (first f) . toList -- |Adjust all the weights of a categorical distribution so that they -- sum to unity and remove all events whose probability is zero. normalizeCategoricalPs :: (Fractional p, Eq p) => Categorical p e -> Categorical p e normalizeCategoricalPs orig@(Categorical ds) | ps == 0 = Categorical V.empty | otherwise = runST $ do lastP <- newSTRef 0 nDups <- newSTRef 0 normalized <- V.thaw ds let n = V.length ds skip = modifySTRef' nDups (1+) save i p x = do d <- readSTRef nDups MV.write normalized (i-d) (p, x) sequence_ [ do let (p,x) = ds V.! i p0 <- readSTRef lastP if p == p0 then skip else do save i (p * scale) x writeSTRef lastP $! p | i <- [0..n-1] ] -- force last element to 1 d <- readSTRef nDups let n' = n-d (_,lastX) <- MV.read normalized (n'-1) MV.write normalized (n'-1) (1,lastX) Categorical <$> V.unsafeFreeze (MV.unsafeSlice 0 n' normalized) where ps = totalWeight orig scale = recip ps #if __GLASGOW_HASKELL__ < 706 -- |strict 'modifySTRef' modifySTRef' :: STRef s a -> (a -> a) -> ST s () modifySTRef' x f = do v <- readSTRef x let fv = f v fv `seq` writeSTRef x fv #endif -- |Simplify a categorical distribution by combining equivalent events (the new -- event will have a probability equal to the sum of all the originals). collectEvents :: (Ord e, Num p, Ord p) => Categorical p e -> Categorical p e collectEvents = collectEventsBy compare ((sum *** head) . unzip) -- |Simplify a categorical distribution by combining equivalent events (the new -- event will have a weight equal to the sum of all the originals). -- The comparator function is used to identify events to combine. Once chosen, -- the events and their weights are combined by the provided probability and -- event aggregation function. collectEventsBy :: Num p => (e -> e -> Ordering) -> ([(p,e)] -> (p,e))-> Categorical p e -> Categorical p e collectEventsBy compareE combine = fromList . map combine . groupEvents . sortEvents . toList where groupEvents = groupBy (\x y -> snd x `compareE` snd y == EQ) sortEvents = sortBy (compareE `on` snd) random-fu-0.3.0.1/src/Data/Random/Distribution/ChiSquare.hs0000644000000000000000000000177007346545000021516 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.ChiSquare where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Gamma import Numeric.SpecFunctions chiSquare :: Distribution ChiSquare t => Integer -> RVar t chiSquare = rvar . ChiSquare chiSquareT :: Distribution ChiSquare t => Integer -> RVarT m t chiSquareT = rvarT . ChiSquare newtype ChiSquare b = ChiSquare Integer instance (Fractional t, Distribution Gamma t) => Distribution ChiSquare t where rvarT (ChiSquare 0) = return 0 rvarT (ChiSquare n) | n > 0 = gammaT (0.5 * fromInteger n) 2 | otherwise = error "chi-square distribution: degrees of freedom must be positive" instance (Real t, Distribution ChiSquare t) => CDF ChiSquare t where cdf (ChiSquare n) x = incompleteGamma (0.5 * fromInteger n) (0.5 * realToFrac x) random-fu-0.3.0.1/src/Data/Random/Distribution/Dirichlet.hs0000644000000000000000000000167707346545000021547 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, GADTs #-} module Data.Random.Distribution.Dirichlet where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Gamma import Data.List fractionalDirichlet :: (Fractional a, Distribution Gamma a) => [a] -> RVarT m [a] fractionalDirichlet [] = return [] fractionalDirichlet [_] = return [1] fractionalDirichlet as = do xs <- sequence [gammaT a 1 | a <- as] let total = foldl1' (+) xs return (map (* recip total) xs) dirichlet :: Distribution Dirichlet [a] => [a] -> RVar [a] dirichlet as = rvar (Dirichlet as) dirichletT :: Distribution Dirichlet [a] => [a] -> RVarT m [a] dirichletT as = rvarT (Dirichlet as) newtype Dirichlet a = Dirichlet a deriving (Eq, Show) instance (Fractional a, Distribution Gamma a) => Distribution Dirichlet [a] where rvarT (Dirichlet as) = fractionalDirichlet as random-fu-0.3.0.1/src/Data/Random/Distribution/Exponential.hs0000644000000000000000000000355607346545000022124 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.Exponential where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Uniform {-| A definition of the exponential distribution over the type @a@. @'Exp' mu@ models an exponential distribution with mean @mu@. This can alternatively be viewed as an exponential distribution with parameter @lambda = 1 / mu@. See also 'exponential'. -} newtype Exponential a = Exp a floatingExponential :: (Floating a, Distribution StdUniform a) => a -> RVarT m a floatingExponential lambdaRecip = do x <- stdUniformT return (negate (log x) * lambdaRecip) floatingExponentialCDF :: Real a => a -> a -> Double floatingExponentialCDF lambdaRecip x = 1 - exp (negate (realToFrac x) / realToFrac lambdaRecip) {-| A random variable which samples from the exponential distribution. @'exponential' mu@ is an exponential random variable with mean @mu@. This can alternatively be viewed as an exponential random variable with parameter @lambda = 1 / mu@. -} exponential :: Distribution Exponential a => a -> RVar a exponential = rvar . Exp {-| A random variable transformer which samples from the exponential distribution. @'exponentialT' mu@ is an exponential random variable with mean @mu@. This can alternatively be viewed as an exponential random variable with parameter @lambda = 1 / mu@. -} exponentialT :: Distribution Exponential a => a -> RVarT m a exponentialT = rvarT . Exp instance (Floating a, Distribution StdUniform a) => Distribution Exponential a where rvarT (Exp lambdaRecip) = floatingExponential lambdaRecip instance (Real a, Distribution Exponential a) => CDF Exponential a where cdf (Exp lambdaRecip) = floatingExponentialCDF lambdaRecip random-fu-0.3.0.1/src/Data/Random/Distribution/Gamma.hs0000644000000000000000000000551107346545000020651 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, BangPatterns #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.Gamma ( Gamma(..) , gamma, gammaT , Erlang(..) , erlang, erlangT , mtGamma ) where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Uniform import Data.Random.Distribution.Normal import Data.Ratio import Numeric.SpecFunctions -- |derived from Marsaglia & Tang, "A Simple Method for generating gamma -- variables", ACM Transactions on Mathematical Software, Vol 26, No 3 (2000), p363-372. {-# SPECIALIZE mtGamma :: Double -> Double -> RVarT m Double #-} {-# SPECIALIZE mtGamma :: Float -> Float -> RVarT m Float #-} mtGamma :: (Floating a, Ord a, Distribution StdUniform a, Distribution Normal a) => a -> a -> RVarT m a mtGamma a b | a < 1 = do u <- stdUniformT mtGamma (1+a) $! (b * u ** recip a) | otherwise = go where !d = a - fromRational (1%3) !c = recip (sqrt (9*d)) go = do x <- stdNormalT let !v = 1 + c*x if v <= 0 then go else do u <- stdUniformT let !x_2 = x*x; !x_4 = x_2*x_2 v3 = v*v*v dv = d * v3 if u < 1 - 0.0331*x_4 || log u < 0.5 * x_2 + d - dv + d*log v3 then return (b*dv) else go {-# SPECIALIZE gamma :: Float -> Float -> RVar Float #-} {-# SPECIALIZE gamma :: Double -> Double -> RVar Double #-} gamma :: (Distribution Gamma a) => a -> a -> RVar a gamma a b = rvar (Gamma a b) gammaT :: (Distribution Gamma a) => a -> a -> RVarT m a gammaT a b = rvarT (Gamma a b) erlang :: (Distribution (Erlang a) b) => a -> RVar b erlang a = rvar (Erlang a) erlangT :: (Distribution (Erlang a) b) => a -> RVarT m b erlangT a = rvarT (Erlang a) data Gamma a = Gamma a a newtype Erlang a b = Erlang a instance (Floating a, Ord a, Distribution Normal a, Distribution StdUniform a) => Distribution Gamma a where {-# SPECIALIZE instance Distribution Gamma Double #-} {-# SPECIALIZE instance Distribution Gamma Float #-} rvarT (Gamma a b) = mtGamma a b instance (Real a, Distribution Gamma a) => CDF Gamma a where cdf (Gamma a b) x = incompleteGamma (realToFrac a) (realToFrac x / realToFrac b) instance (Integral a, Floating b, Ord b, Distribution Normal b, Distribution StdUniform b) => Distribution (Erlang a) b where rvarT (Erlang a) = mtGamma (fromIntegral a) 1 instance (Integral a, Real b, Distribution (Erlang a) b) => CDF (Erlang a) b where cdf (Erlang a) x = incompleteGamma (fromIntegral a) (realToFrac x) random-fu-0.3.0.1/src/Data/Random/Distribution/Multinomial.hs0000644000000000000000000000275607346545000022131 0ustar0000000000000000{-# LANGUAGE GADTs, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} module Data.Random.Distribution.Multinomial where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Binomial multinomial :: Distribution (Multinomial p) [a] => [p] -> a -> RVar [a] multinomial ps n = rvar (Multinomial ps n) multinomialT :: Distribution (Multinomial p) [a] => [p] -> a -> RVarT m [a] multinomialT ps n = rvarT (Multinomial ps n) data Multinomial p a where Multinomial :: [p] -> a -> Multinomial p [a] instance (Num a, Eq a, Fractional p, Distribution (Binomial p) a) => Distribution (Multinomial p) [a] where -- TODO: implement faster version based on Categorical for small n, large (length ps) rvarT (Multinomial ps0 t) = go t ps0 (tailSums ps0) id where go _ [] _ f = return (f []) go n [_] _ f = return (f [n]) go 0 (_:ps) (_ :psums) f = go 0 ps psums (f . (0:)) go n (p:ps) (psum:psums) f = do x <- binomialT n (p / psum) go (n-x) ps psums (f . (x:)) go _ _ _ _ = error "rvar/Multinomial: programming error! this case should be impossible!" -- less wasteful version of (map sum . tails) tailSums [] = [0] tailSums (x:xs) = case tailSums xs of (s:rest) -> (x+s):s:rest _ -> error "rvar/Multinomial/tailSums: programming error! this case should be impossible!" random-fu-0.3.0.1/src/Data/Random/Distribution/Normal.hs0000644000000000000000000002375307346545000021067 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, ForeignFunctionInterface, BangPatterns, RankNTypes #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module Data.Random.Distribution.Normal ( Normal(..) , normal, normalT , stdNormal, stdNormalT , doubleStdNormal , floatStdNormal , realFloatStdNormal , normalTail , normalPair , boxMullerNormalPair , knuthPolarNormalPair ) where import Data.Bits import Data.Random.Distribution import Data.Random.Distribution.Uniform import Data.Random.Distribution.Ziggurat import Data.Random.RVar import Data.Word import Data.Vector.Generic (Vector) import qualified Data.Vector as V import qualified Data.Vector.Unboxed as UV import Data.Number.Erf import qualified System.Random.Stateful as Random -- |A random variable that produces a pair of independent -- normally-distributed values. normalPair :: (Floating a, Distribution StdUniform a) => RVar (a,a) normalPair = boxMullerNormalPair -- |A random variable that produces a pair of independent -- normally-distributed values, computed using the Box-Muller method. -- This algorithm is slightly slower than Knuth's method but using a -- constant amount of entropy (Knuth's method is a rejection method). -- It is also slightly more general (Knuth's method require an 'Ord' -- instance). {-# INLINE boxMullerNormalPair #-} boxMullerNormalPair :: (Floating a, Distribution StdUniform a) => RVar (a,a) boxMullerNormalPair = do u <- stdUniform t <- stdUniform let r = sqrt (-2 * log u) theta = (2 * pi) * t x = r * cos theta y = r * sin theta return (x,y) -- |A random variable that produces a pair of independent -- normally-distributed values, computed using Knuth's polar method. -- Slightly faster than 'boxMullerNormalPair' when it accepts on the -- first try, but does not always do so. {-# INLINE knuthPolarNormalPair #-} knuthPolarNormalPair :: (Floating a, Ord a, Distribution Uniform a) => RVar (a,a) knuthPolarNormalPair = do v1 <- uniform (-1) 1 v2 <- uniform (-1) 1 let s = v1*v1 + v2*v2 if s >= 1 then knuthPolarNormalPair else return $ if s == 0 then (0,0) else let scale = sqrt (-2 * log s / s) in (v1 * scale, v2 * scale) -- |Draw from the tail of a normal distribution (the region beyond the provided value) {-# INLINE normalTail #-} normalTail :: (Distribution StdUniform a, Floating a, Ord a) => a -> RVarT m a normalTail r = go where go = do !u <- stdUniformT let !x = log u / r !v <- stdUniformT let !y = log v if x*x + y+y > 0 then go else return (r - x) -- |Construct a 'Ziggurat' for sampling a normal distribution, given -- @logBase 2 c@ and the 'zGetIU' implementation. normalZ :: (RealFloat a, Erf a, Vector v a, Distribution Uniform a, Integral b) => b -> (forall m. RVarT m (Int, a)) -> Ziggurat v a normalZ p = mkZigguratRec True normalF normalFInv normalFInt normalFVol (2^p) -- | Ziggurat target function (upper half of a non-normalized gaussian PDF) normalF :: (Floating a, Ord a) => a -> a normalF x | x <= 0 = 1 | otherwise = exp ((-0.5) * x*x) -- | inverse of 'normalF' normalFInv :: Floating a => a -> a normalFInv y = sqrt ((-2) * log y) -- | integral of 'normalF' normalFInt :: (Floating a, Erf a, Ord a) => a -> a normalFInt x | x <= 0 = 0 | otherwise = normalFVol * erf (x * sqrt 0.5) -- | volume of 'normalF' normalFVol :: Floating a => a normalFVol = sqrt (0.5 * pi) -- |A random variable sampling from the standard normal distribution -- over any 'RealFloat' type (subject to the rest of the constraints - -- it builds and uses a 'Ziggurat' internally, which requires the 'Erf' -- class). -- -- Because it computes a 'Ziggurat', it is very expensive to use for -- just one evaluation, or even for multiple evaluations if not used and -- reused monomorphically (to enable the ziggurat table to be let-floated -- out). If you don't know whether your use case fits this description -- then you're probably better off using a different algorithm, such as -- 'boxMullerNormalPair' or 'knuthPolarNormalPair'. And of course if -- you don't need the full generality of this definition then you're much -- better off using 'doubleStdNormal' or 'floatStdNormal'. -- -- As far as I know, this should be safe to use in any monomorphic -- @Distribution Normal@ instance declaration. realFloatStdNormal :: (RealFloat a, Erf a, Distribution Uniform a) => RVarT m a realFloatStdNormal = runZiggurat (normalZ p getIU `asTypeOf` (undefined :: Ziggurat V.Vector a)) where p :: Int p = 6 getIU :: (Num a, Distribution Uniform a) => RVarT m (Int, a) getIU = do i <- Random.uniformWord8 RGen u <- uniformT (-1) 1 return (fromIntegral i .&. (2^p-1), u) -- |A random variable sampling from the standard normal distribution -- over the 'Double' type. doubleStdNormal :: RVarT m Double doubleStdNormal = runZiggurat doubleStdNormalZ -- doubleStdNormalC must not be over 2^12 if using wordToDoubleWithExcess doubleStdNormalC :: Int doubleStdNormalC = 512 doubleStdNormalR, doubleStdNormalV :: Double doubleStdNormalR = 3.852046150368388 doubleStdNormalV = 2.4567663515413507e-3 {-# NOINLINE doubleStdNormalZ #-} doubleStdNormalZ :: Ziggurat UV.Vector Double doubleStdNormalZ = mkZiggurat_ True normalF normalFInv doubleStdNormalC doubleStdNormalR doubleStdNormalV getIU (normalTail doubleStdNormalR) where getIU :: RVarT m (Int, Double) getIU = do !w <- Random.uniformWord64 RGen let (u,i) = wordToDoubleWithExcess w return $! (fromIntegral i .&. (doubleStdNormalC-1), u+u-1) -- NOTE: inlined from random-source {-# INLINE wordToDouble #-} -- |Pack the low 52 bits from a 'Word64' into a 'Double' in the range [0,1). -- Used to convert a 'stdUniform' 'Word64' to a 'stdUniform' 'Double'. wordToDouble :: Word64 -> Double wordToDouble x = (encodeFloat $! toInteger (x .&. 0x000fffffffffffff {- 2^52-1 -})) $ (-52) {-# INLINE wordToDoubleWithExcess #-} -- |Same as wordToDouble, but also return the unused bits (as the 12 -- least significant bits of a 'Word64') wordToDoubleWithExcess :: Word64 -> (Double, Word64) wordToDoubleWithExcess x = (wordToDouble x, x `shiftR` 52) -- |A random variable sampling from the standard normal distribution -- over the 'Float' type. floatStdNormal :: RVarT m Float floatStdNormal = runZiggurat floatStdNormalZ -- floatStdNormalC must not be over 2^9 if using word32ToFloatWithExcess floatStdNormalC :: Int floatStdNormalC = 512 floatStdNormalR, floatStdNormalV :: Float floatStdNormalR = 3.852046150368388 floatStdNormalV = 2.4567663515413507e-3 {-# NOINLINE floatStdNormalZ #-} floatStdNormalZ :: Ziggurat UV.Vector Float floatStdNormalZ = mkZiggurat_ True normalF normalFInv floatStdNormalC floatStdNormalR floatStdNormalV getIU (normalTail floatStdNormalR) where getIU :: RVarT m (Int, Float) getIU = do !w <- Random.uniformWord32 RGen let (u,i) = word32ToFloatWithExcess w return (fromIntegral i .&. (floatStdNormalC-1), u+u-1) -- NOTE: inlined from random-source {-# INLINE word32ToFloat #-} -- |Pack the low 23 bits from a 'Word32' into a 'Float' in the range [0,1). -- Used to convert a 'stdUniform' 'Word32' to a 'stdUniform' 'Double'. word32ToFloat :: Word32 -> Float word32ToFloat x = (encodeFloat $! toInteger (x .&. 0x007fffff {- 2^23-1 -} )) $ (-23) {-# INLINE word32ToFloatWithExcess #-} -- |Same as word32ToFloat, but also return the unused bits (as the 9 -- least significant bits of a 'Word32') word32ToFloatWithExcess :: Word32 -> (Float, Word32) word32ToFloatWithExcess x = (word32ToFloat x, x `shiftR` 23) normalCdf :: (Real a) => a -> a -> a -> Double normalCdf m s x = normcdf ((realToFrac x - realToFrac m) / realToFrac s) normalPdf :: (Real a, Floating b) => a -> a -> a -> b normalPdf mu sigma x = (recip (sqrt (2 * pi * sigma2))) * (exp ((-((realToFrac x) - (realToFrac mu))^2) / (2 * sigma2))) where sigma2 = realToFrac sigma^2 normalLogPdf :: (Real a, Floating b) => a -> a -> a -> b normalLogPdf mu sigma x = log (recip (sqrt (2 * pi * sigma2))) + ((-((realToFrac x) - (realToFrac mu))^2) / (2 * sigma2)) where sigma2 = realToFrac sigma^2 -- |A specification of a normal distribution over the type 'a'. data Normal a -- |The \"standard\" normal distribution - mean 0, stddev 1 = StdNormal -- |@Normal m s@ is a normal distribution with mean @m@ and stddev @sd@. | Normal a a -- mean, sd instance Distribution Normal Double where rvarT StdNormal = doubleStdNormal rvarT (Normal m s) = do x <- doubleStdNormal return (x * s + m) instance Distribution Normal Float where rvarT StdNormal = floatStdNormal rvarT (Normal m s) = do x <- floatStdNormal return (x * s + m) instance (Real a, Distribution Normal a) => CDF Normal a where cdf StdNormal = normalCdf 0 1 cdf (Normal m s) = normalCdf m s instance (Real a, Floating a, Distribution Normal a) => PDF Normal a where pdf StdNormal = normalPdf 0 1 pdf (Normal m s) = normalPdf m s logPdf StdNormal = normalLogPdf 0 1 logPdf (Normal m s) = normalLogPdf m s {-# SPECIALIZE stdNormal :: RVar Double #-} {-# SPECIALIZE stdNormal :: RVar Float #-} -- |'stdNormal' is a normal variable with distribution 'StdNormal'. stdNormal :: Distribution Normal a => RVar a stdNormal = rvar StdNormal -- |'stdNormalT' is a normal process with distribution 'StdNormal'. stdNormalT :: Distribution Normal a => RVarT m a stdNormalT = rvarT StdNormal -- |@normal m s@ is a random variable with distribution @'Normal' m s@. normal :: Distribution Normal a => a -> a -> RVar a normal m s = rvar (Normal m s) -- |@normalT m s@ is a random process with distribution @'Normal' m s@. normalT :: Distribution Normal a => a -> a -> RVarT m a normalT m s = rvarT (Normal m s) random-fu-0.3.0.1/src/Data/Random/Distribution/Pareto.hs0000644000000000000000000000152307346545000021060 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.Pareto where import Data.Random pareto :: Distribution Pareto a => a -> a -> RVar a pareto xM a = rvar (Pareto xM a) paretoT :: Distribution Pareto a => a -> a -> RVarT m a paretoT xM a = rvarT (Pareto xM a) data Pareto a = Pareto !a !a instance (Floating a, Distribution StdUniform a) => Distribution Pareto a where rvarT (Pareto xM a) = do u <- stdUniformT return (xM / (1 - u) ** recip a) instance (Real a, Distribution Pareto a) => CDF Pareto a where cdf (Pareto xM a) x | x >= xM = 1 - (realToFrac xM / realToFrac x) ** realToFrac a | otherwise = 0 random-fu-0.3.0.1/src/Data/Random/Distribution/Poisson.hs0000644000000000000000000002122507346545000021261 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.Poisson where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Uniform import Data.Random.Distribution.Gamma import Data.Random.Distribution.Binomial import Control.Monad import Data.Int import Data.Word -- from Knuth, with interpretation help from gsl sources integralPoisson :: (Integral a, RealFloat b, Distribution StdUniform b, Distribution (Erlang a) b, Distribution (Binomial b) a) => b -> RVarT m a integralPoisson = psn 0 where psn :: (Integral a, RealFloat b, Distribution StdUniform b, Distribution (Erlang a) b, Distribution (Binomial b) a) => a -> b -> RVarT m a psn j mu | mu > 10 = do let m = floor (mu * (7/8)) x <- erlangT m if x >= mu then do b <- binomialT (m - 1) (mu / x) return (j + b) else psn (j + m) (mu - x) | otherwise = prod 1 j where emu = exp (-mu) prod p k = do u <- stdUniformT if p * u > emu then prod (p * u) (k + 1) else return k integralPoissonCDF :: (Integral a, Real b) => b -> a -> Double integralPoissonCDF mu k = exp (negate lambda) * sum [ exp (fromIntegral i * log lambda - i_fac_ln) | (i, i_fac_ln) <- zip [0..k] (scanl (+) 0 (map log [1..])) ] where lambda = realToFrac mu -- | The probability of getting exactly k successes is -- given by the probability mass function: -- -- \[ -- f(k;\lambda) = \Pr(X = k) = \frac{\lambda^k e^{-\lambda}}{k!} -- \] -- -- Note that in `integralPoissonPDF` the parameter of the mass -- function are given first and the range of the random variable -- distributed according to the Poisson distribution is given -- last. That is, \(f(2;0.5)\) is calculated by @integralPoissonPDF 0.5 2@. integralPoissonPDF :: (Integral a, Real b) => b -> a -> Double integralPoissonPDF mu k = exp (negate lambda) * exp (fromIntegral k * log lambda - k_fac_ln) where k_fac_ln = foldl (+) 0 (map (log . fromIntegral) [1..k]) lambda = realToFrac mu fractionalPoisson :: (Num a, Distribution (Poisson b) Integer) => b -> RVarT m a fractionalPoisson mu = liftM fromInteger (poissonT mu) fractionalPoissonCDF :: (CDF (Poisson b) Integer, RealFrac a) => b -> a -> Double fractionalPoissonCDF mu k = cdf (Poisson mu) (floor k :: Integer) fractionalPoissonPDF :: (PDF (Poisson b) Integer, RealFrac a) => b -> a -> Double fractionalPoissonPDF mu k = pdf (Poisson mu) (floor k :: Integer) poisson :: (Distribution (Poisson b) a) => b -> RVar a poisson mu = rvar (Poisson mu) poissonT :: (Distribution (Poisson b) a) => b -> RVarT m a poissonT mu = rvarT (Poisson mu) newtype Poisson b a = Poisson b instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Integer) b, Distribution (Binomial b) Integer) => Distribution (Poisson b) Integer where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Integer) => CDF (Poisson b) Integer where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Integer) => PDF (Poisson b) Integer where pdf (Poisson mu) = integralPoissonPDF mu instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Int) b, Distribution (Binomial b) Int) => Distribution (Poisson b) Int where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Int) => CDF (Poisson b) Int where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Int) => PDF (Poisson b) Int where pdf (Poisson mu) = integralPoissonPDF mu instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Int8) b, Distribution (Binomial b) Int8) => Distribution (Poisson b) Int8 where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Int8) => CDF (Poisson b) Int8 where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Int8) => PDF (Poisson b) Int8 where pdf (Poisson mu) = integralPoissonPDF mu instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Int16) b, Distribution (Binomial b) Int16) => Distribution (Poisson b) Int16 where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Int16) => CDF (Poisson b) Int16 where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Int16) => PDF (Poisson b) Int16 where pdf (Poisson mu) = integralPoissonPDF mu instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Int32) b, Distribution (Binomial b) Int32) => Distribution (Poisson b) Int32 where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Int32) => CDF (Poisson b) Int32 where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Int32) => PDF (Poisson b) Int32 where pdf (Poisson mu) = integralPoissonPDF mu instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Int64) b, Distribution (Binomial b) Int64) => Distribution (Poisson b) Int64 where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Int64) => CDF (Poisson b) Int64 where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Int64) => PDF (Poisson b) Int64 where pdf (Poisson mu) = integralPoissonPDF mu instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Word) b, Distribution (Binomial b) Word) => Distribution (Poisson b) Word where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Word) => CDF (Poisson b) Word where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Word) => PDF (Poisson b) Word where pdf (Poisson mu) = integralPoissonPDF mu instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Word8) b, Distribution (Binomial b) Word8) => Distribution (Poisson b) Word8 where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Word8) => CDF (Poisson b) Word8 where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Word8) => PDF (Poisson b) Word8 where pdf (Poisson mu) = integralPoissonPDF mu instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Word16) b, Distribution (Binomial b) Word16) => Distribution (Poisson b) Word16 where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Word16) => CDF (Poisson b) Word16 where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Word16) => PDF (Poisson b) Word16 where pdf (Poisson mu) = integralPoissonPDF mu instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Word32) b, Distribution (Binomial b) Word32) => Distribution (Poisson b) Word32 where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Word32) => CDF (Poisson b) Word32 where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Word32) => PDF (Poisson b) Word32 where pdf (Poisson mu) = integralPoissonPDF mu instance (RealFloat b, Distribution StdUniform b, Distribution (Erlang Word64) b, Distribution (Binomial b) Word64) => Distribution (Poisson b) Word64 where rvarT (Poisson mu) = integralPoisson mu instance (Real b, Distribution (Poisson b) Word64) => CDF (Poisson b) Word64 where cdf (Poisson mu) = integralPoissonCDF mu instance (Real b, Distribution (Poisson b) Word64) => PDF (Poisson b) Word64 where pdf (Poisson mu) = integralPoissonPDF mu instance Distribution (Poisson b) Integer => Distribution (Poisson b) Float where rvarT (Poisson mu) = fractionalPoisson mu instance CDF (Poisson b) Integer => CDF (Poisson b) Float where cdf (Poisson mu) = fractionalPoissonCDF mu instance PDF (Poisson b) Integer => PDF (Poisson b) Float where pdf (Poisson mu) = fractionalPoissonPDF mu instance Distribution (Poisson b) Integer => Distribution (Poisson b) Double where rvarT (Poisson mu) = fractionalPoisson mu instance CDF (Poisson b) Integer => CDF (Poisson b) Double where cdf (Poisson mu) = fractionalPoissonCDF mu instance PDF (Poisson b) Integer => PDF (Poisson b) Double where pdf (Poisson mu) = fractionalPoissonPDF mu random-fu-0.3.0.1/src/Data/Random/Distribution/Rayleigh.hs0000644000000000000000000000242607346545000021375 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.Rayleigh where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Uniform floatingRayleigh :: (Floating a, Eq a, Distribution StdUniform a) => a -> RVarT m a floatingRayleigh s = do u <- stdUniformPosT return (s * sqrt (-2 * log u)) -- |The rayleigh distribution with a specified mode (\"sigma\") parameter. -- Its mean will be @sigma*sqrt(pi/2)@ and its variance will be @sigma^2*(4-pi)/2@ -- -- (therefore if you want one with a particular mean @m@, @sigma@ should be @m*sqrt(2/pi)@) newtype Rayleigh a = Rayleigh a rayleigh :: Distribution Rayleigh a => a -> RVar a rayleigh = rvar . Rayleigh rayleighT :: Distribution Rayleigh a => a -> RVarT m a rayleighT = rvarT . Rayleigh rayleighCDF :: Real a => a -> a -> Double rayleighCDF s x = 1 - exp ((-0.5)* realToFrac (x*x) / realToFrac (s*s)) instance (RealFloat a, Distribution StdUniform a) => Distribution Rayleigh a where rvarT (Rayleigh s) = floatingRayleigh s instance (Real a, Distribution Rayleigh a) => CDF Rayleigh a where cdf (Rayleigh s) x = rayleighCDF s x random-fu-0.3.0.1/src/Data/Random/Distribution/Simplex.hs0000644000000000000000000000342107346545000021246 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances, GADTs #-} module Data.Random.Distribution.Simplex ( StdSimplex(..) , stdSimplex , stdSimplexT , fractionalStdSimplex ) where import Control.Monad import Data.List import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Uniform -- |Uniform distribution over a standard simplex. newtype StdSimplex as = -- | @StdSimplex k@ constructs a standard simplex of dimension @k@ -- (standard /k/-simplex). -- An element of the simplex represents a vector variable @as = (a_0, -- a_1, ..., a_k)@. The elements of @as@ are more than or equal to @0@ -- and @sum as@ is always equal to @1@. StdSimplex Int deriving (Eq, Show) instance (Ord a, Fractional a, Distribution StdUniform a) => Distribution StdSimplex [a] where rvar (StdSimplex k) = fractionalStdSimplex k -- |@stdSimplex k@ returns a random variable being uniformly distributed over -- a standard simplex of dimension @k@. stdSimplex :: Distribution StdSimplex [a] => Int -> RVar [a] stdSimplex k = rvar (StdSimplex k) stdSimplexT :: Distribution StdSimplex [a] => Int -> RVarT m [a] stdSimplexT k = rvarT (StdSimplex k) -- |An algorithm proposed by Rubinstein & Melamed (1998). -- See, /e.g./, S. Onn, I. Weissman. -- Generating uniform random vectors over a simplex with implications to -- the volume of a certain polytope and to multivariate extremes. -- /Ann Oper Res/ (2011) __189__:331-342. fractionalStdSimplex :: (Ord a, Fractional a, Distribution StdUniform a) => Int -> RVar [a] fractionalStdSimplex k = do us <- replicateM k stdUniform let us' = sort us ++ [1] return $ zipWith (-) us' (0 : us') random-fu-0.3.0.1/src/Data/Random/Distribution/StretchedExponential.hs0000644000000000000000000000274107346545000023765 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.StretchedExponential where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Uniform newtype StretchedExponential a = StretchedExp (a,a) floatingStretchedExponential :: (Floating a, Distribution StdUniform a) => a -> a -> RVarT m a floatingStretchedExponential beta lambdaRecip = do x <- stdUniformT return (negate (log (1-x))**(1/beta) * lambdaRecip) floatingStretchedExponentialCDF :: Real a => a -> a -> a -> Double floatingStretchedExponentialCDF beta lambdaRecip x = 1 - exp (negate (realToFrac x / realToFrac lambdaRecip)**(realToFrac beta)) stretchedExponential :: Distribution StretchedExponential a => a -> a -> RVar a stretchedExponential beta lambdaRecip = rvar $ StretchedExp (beta, lambdaRecip) stretchedExponentialT :: Distribution StretchedExponential a => a -> a -> RVarT m a stretchedExponentialT beta lambdaRecip = rvarT $ StretchedExp (beta, lambdaRecip) instance (Floating a, Distribution StdUniform a) => Distribution StretchedExponential a where rvarT (StretchedExp (beta,lambdaRecip)) = floatingStretchedExponential beta lambdaRecip instance (Real a, Distribution StretchedExponential a) => CDF StretchedExponential a where cdf (StretchedExp (beta,lambdaRecip)) = floatingStretchedExponentialCDF beta lambdaRecip random-fu-0.3.0.1/src/Data/Random/Distribution/T.hs0000644000000000000000000000270707346545000020036 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Distribution.T where import Data.RVar import Data.Random.Distribution import Data.Random.Distribution.ChiSquare import Data.Random.Distribution.Normal import Numeric.SpecFunctions t :: Distribution T a => Integer -> RVar a t = rvar . T tT :: Distribution T a => Integer -> RVarT m a tT = rvarT . T newtype T a = T Integer deriving (Eq, Ord, Show) instance (Floating a, Distribution Normal a, Distribution ChiSquare a) => Distribution T a where rvarT (T n) | n > 0 = do x <- stdNormalT y <- chiSquareT n return (x * sqrt (fromInteger n / y)) | otherwise = error "Student's t-distribution: degrees of freedom must be positive" instance (Real a, Distribution T a) => CDF T a where cdf (T n) t = incompleteBeta v2 v2 x where v = fromIntegral n v2 = 0.5 * v tD = realToFrac t u = sqrt (tD*tD + v) x = (tD + u) / (u + u) random-fu-0.3.0.1/src/Data/Random/Distribution/Triangular.hs0000644000000000000000000000445307346545000021743 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} module Data.Random.Distribution.Triangular where import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Uniform -- |A description of a triangular distribution - a distribution whose PDF -- is a triangle ramping up from a lower bound to a specified midpoint -- and back down to the upper bound. This is a very simple distribution -- that does not generally occur naturally but is used sometimes as an -- estimate of a true distribution when only the range of the values and -- an approximate mode of the true distribution are known. data Triangular a = Triangular { -- |The lower bound of the triangle in the PDF (the smallest number the distribution can generate) triLower :: a, -- |The midpoint of the triangle (also the mode of the distribution) triMid :: a, -- |The upper bound of the triangle (and the largest number the distribution can generate) triUpper :: a} deriving (Eq, Show) -- |Compute a triangular distribution for a 'Floating' type. floatingTriangular :: (Floating a, Ord a, Distribution StdUniform a) => a -> a -> a -> RVarT m a floatingTriangular a b c | a > b = floatingTriangular b a c | b > c = floatingTriangular a c b | otherwise = do let p = (c-b)/(c-a) u <- stdUniformT let d | u >= p = a | otherwise = c x | u >= p = (u - p) / (1 - p) | otherwise = u / p -- may prefer this: reusing u costs resolution, especially if p or 1-p is small and c-a is large. -- x <- stdUniform return (b - ((1 - sqrt x) * (b-d))) -- |@triangularCDF a b c@ is the CDF of @realFloatTriangular a b c@. triangularCDF :: RealFrac a => a -> a -> a -> a -> Double triangularCDF a b c x | x < a = 0 | x <= b = realToFrac ((x - a)^(2 :: Int) / ((c - a) * (b - a))) | x <= c = realToFrac (1 - (c - x)^(2 :: Int) / ((c - a) * (c - b))) | otherwise = 1 instance (RealFloat a, Ord a, Distribution StdUniform a) => Distribution Triangular a where rvarT (Triangular a b c) = floatingTriangular a b c instance (RealFrac a, Distribution Triangular a) => CDF Triangular a where cdf (Triangular a b c) = triangularCDF a b c random-fu-0.3.0.1/src/Data/Random/Distribution/Uniform.hs0000644000000000000000000003544507346545000021257 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, FlexibleInstances, UndecidableInstances, EmptyDataDecls, TemplateHaskell, BangPatterns #-} module Data.Random.Distribution.Uniform ( Uniform(..) , uniform , uniformT , StdUniform(..) , stdUniform , stdUniformT , stdUniformPos , stdUniformPosT , integralUniform , realFloatUniform , floatUniform , doubleUniform , fixedUniform , enumUniform , boundedStdUniform , boundedEnumStdUniform , realFloatStdUniform , fixedStdUniform , floatStdUniform , doubleStdUniform , boundedStdUniformCDF , realStdUniformCDF , realUniformCDF , enumUniformCDF ) where import Data.Random.Internal.Fixed import Data.Random.Distribution import Data.Random.RVar import Data.Fixed import Data.Word import Data.Int import Control.Monad.Loops import qualified System.Random.Stateful as Random -- |Compute a random 'Integral' value between the 2 values provided (inclusive). {-# INLINE integralUniform #-} integralUniform :: Random.UniformRange a => a -> a -> RVarT m a integralUniform !x !y = Random.uniformRM (x, y) RGen -- Maybe switch to uniformIntegralM (requires exposing from `random` internals): -- Random.uniformIntegralM (x, y) RGen integralUniformCDF :: (Integral a, Fractional b) => a -> a -> a -> b integralUniformCDF a b x | b < a = integralUniformCDF b a x | x < a = 0 | x > b = 1 | otherwise = (fromIntegral x - fromIntegral a) / (fromIntegral b - fromIntegral a) -- |Compute a random value for a 'Bounded' type, between 'minBound' and 'maxBound' -- (inclusive for 'Integral' or 'Enum' types, in ['minBound', 'maxBound') for Fractional types.) boundedStdUniform :: (Distribution Uniform a, Bounded a) => RVar a boundedStdUniform = uniform minBound maxBound boundedStdUniformCDF :: (CDF Uniform a, Bounded a) => a -> Double boundedStdUniformCDF = cdf (Uniform minBound maxBound) -- |Compute a random value for a 'Bounded' 'Enum' type, between 'minBound' and -- 'maxBound' (inclusive) boundedEnumStdUniform :: (Enum a, Bounded a) => RVarT m a boundedEnumStdUniform = enumUniform minBound maxBound boundedEnumStdUniformCDF :: (Enum a, Bounded a, Ord a) => a -> Double boundedEnumStdUniformCDF = enumUniformCDF minBound maxBound -- |Compute a uniform random 'Float' value in the range [0,1) floatStdUniform :: RVarT m Float floatStdUniform = do x <- uniformRangeRVarT (0, 1) -- exclude 1. TODO: come up with something smarter if x == 1 then floatStdUniform else pure x -- |Compute a uniform random 'Double' value in the range [0,1) {-# INLINE doubleStdUniform #-} doubleStdUniform :: RVarT m Double doubleStdUniform = do x <- uniformRangeRVarT (0, 1) -- exclude 1. TODO: come up with something smarter if x == 1 then doubleStdUniform else pure x -- |Compute a uniform random value in the range [0,1) for any 'RealFloat' type realFloatStdUniform :: RealFloat a => RVarT m a realFloatStdUniform = do let (b, e) = decodeFloat one x <- uniformT 0 (b-1) if x == 0 then return (0 `asTypeOf` one) else return (encodeFloat x e) where one = 1 -- |Compute a uniform random 'Fixed' value in the range [0,1), with any -- desired precision. fixedStdUniform :: HasResolution r => RVarT m (Fixed r) fixedStdUniform = x where res = resolutionOf2 x x = do u <- uniformT 0 (res) return (mkFixed u) -- |The CDF of the random variable 'realFloatStdUniform'. realStdUniformCDF :: Real a => a -> Double realStdUniformCDF x | x <= 0 = 0 | x >= 1 = 1 | otherwise = realToFrac x -- |The PDF of the random variable 'realFloatStdUniform'. realStdUniformPDF :: Real a => a -> Double realStdUniformPDF x | x <= 0 = 0 | x >= 1 = 0 | otherwise = 1 -- |(internal) basic linear interpolation; @lerp x y@ is a linear function whose -- value is @x@ at 0 and @y@ at 1 lerp :: Num a => a -> a -> a -> a lerp x y a = (1-a)*x + a*y -- |@floatUniform a b@ computes a uniform random 'Float' value in the range [a,b) floatUniform :: Float -> Float -> RVarT m Float floatUniform 0 1 = floatStdUniform floatUniform a b = do x <- floatStdUniform return (lerp a b x) -- |@doubleUniform a b@ computes a uniform random 'Double' value in the range [a,b) {-# INLINE doubleUniform #-} doubleUniform :: Double -> Double -> RVarT m Double doubleUniform 0 1 = doubleStdUniform doubleUniform a b = do x <- doubleStdUniform return (lerp a b x) -- |@realFloatUniform a b@ computes a uniform random value in the range [a,b) for -- any 'RealFloat' type realFloatUniform :: RealFloat a => a -> a -> RVarT m a realFloatUniform 0 1 = realFloatStdUniform realFloatUniform a b = do x <- realFloatStdUniform return (lerp a b x) -- |@fixedUniform a b@ computes a uniform random 'Fixed' value in the range -- [a,b), with any desired precision. fixedUniform :: HasResolution r => Fixed r -> Fixed r -> RVarT m (Fixed r) fixedUniform a b = do u <- integralUniform (unMkFixed a) (unMkFixed b) return (mkFixed u) -- |@realUniformCDF a b@ is the CDF of the random variable @realFloatUniform a b@. realUniformCDF :: RealFrac a => a -> a -> a -> Double realUniformCDF a b x | b < a = realUniformCDF b a x | x <= a = 0 | x >= b = 1 | otherwise = realToFrac ((x-a) / (b-a)) -- |@realFloatUniform a b@ computes a uniform random value in the range [a,b) for -- any 'Enum' type enumUniform :: Enum a => a -> a -> RVarT m a enumUniform a b = do x <- integralUniform (fromEnum a) (fromEnum b) return (toEnum x) enumUniformCDF :: (Enum a, Ord a) => a -> a -> a -> Double enumUniformCDF a b x | b < a = enumUniformCDF b a x | x <= a = 0 | x >= b = 1 | otherwise = (e2f x - e2f a) / (e2f b - e2f a) where e2f = fromIntegral . fromEnum -- @uniform a b@ is a uniformly distributed random variable in the range -- [a,b] for 'Integral' or 'Enum' types and in the range [a,b) for 'Fractional' -- types. Requires a @Distribution Uniform@ instance for the type. uniform :: Distribution Uniform a => a -> a -> RVar a uniform a b = rvar (Uniform a b) -- @uniformT a b@ is a uniformly distributed random process in the range -- [a,b] for 'Integral' or 'Enum' types and in the range [a,b) for 'Fractional' -- types. Requires a @Distribution Uniform@ instance for the type. uniformT :: Distribution Uniform a => a -> a -> RVarT m a uniformT a b = rvarT (Uniform a b) -- |Get a \"standard\" uniformly distributed variable. -- For integral types, this means uniformly distributed over the full range -- of the type (there is no support for 'Integer'). For fractional -- types, this means uniformly distributed on the interval [0,1). {-# SPECIALIZE stdUniform :: RVar Double #-} {-# SPECIALIZE stdUniform :: RVar Float #-} stdUniform :: (Distribution StdUniform a) => RVar a stdUniform = rvar StdUniform -- |Get a \"standard\" uniformly distributed process. -- For integral types, this means uniformly distributed over the full range -- of the type (there is no support for 'Integer'). For fractional -- types, this means uniformly distributed on the interval [0,1). {-# SPECIALIZE stdUniformT :: RVarT m Double #-} {-# SPECIALIZE stdUniformT :: RVarT m Float #-} stdUniformT :: (Distribution StdUniform a) => RVarT m a stdUniformT = rvarT StdUniform -- |Like 'stdUniform', but returns only positive or zero values. Not -- exported because it is not truly uniform: nonzero values are twice -- as likely as zero on signed types. stdUniformNonneg :: (Distribution StdUniform a, Num a, Eq a) => RVarT m a stdUniformNonneg = fmap abs stdUniformT -- |Like 'stdUniform' but only returns positive values. stdUniformPos :: (Distribution StdUniform a, Num a, Eq a) => RVar a stdUniformPos = stdUniformPosT -- |Like 'stdUniform' but only returns positive values. stdUniformPosT :: (Distribution StdUniform a, Num a, Eq a) => RVarT m a stdUniformPosT = iterateUntil (/= 0) stdUniformNonneg -- |A definition of a uniform distribution over the type @t@. See also 'uniform'. data Uniform t = -- |A uniform distribution defined by a lower and upper range bound. -- For 'Integral' and 'Enum' types, the range is inclusive. For 'Fractional' -- types the range includes the lower bound but not the upper. Uniform !t !t -- |A name for the \"standard\" uniform distribution over the type @t@, -- if one exists. See also 'stdUniform'. -- -- For 'Integral' and 'Enum' types that are also 'Bounded', this is -- the uniform distribution over the full range of the type. -- For un-'Bounded' 'Integral' types this is not defined. -- For 'Fractional' types this is a random variable in the range [0,1) -- (that is, 0 to 1 including 0 but not including 1). data StdUniform t = StdUniform instance Distribution Uniform Integer where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Integer where cdf (Uniform a b) = integralUniformCDF a b instance Distribution Uniform Int where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Int where cdf (Uniform a b) = integralUniformCDF a b instance Distribution Uniform Int8 where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Int8 where cdf (Uniform a b) = integralUniformCDF a b instance Distribution Uniform Int16 where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Int16 where cdf (Uniform a b) = integralUniformCDF a b instance Distribution Uniform Int32 where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Int32 where cdf (Uniform a b) = integralUniformCDF a b instance Distribution Uniform Int64 where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Int64 where cdf (Uniform a b) = integralUniformCDF a b instance Distribution Uniform Word where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Word where cdf (Uniform a b) = integralUniformCDF a b instance Distribution Uniform Word8 where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Word8 where cdf (Uniform a b) = integralUniformCDF a b instance Distribution Uniform Word16 where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Word16 where cdf (Uniform a b) = integralUniformCDF a b instance Distribution Uniform Word32 where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Word32 where cdf (Uniform a b) = integralUniformCDF a b instance Distribution Uniform Word64 where rvarT (Uniform a b) = integralUniform a b instance CDF Uniform Word64 where cdf (Uniform a b) = integralUniformCDF a b instance Distribution StdUniform Word8 where rvarT _ = Random.uniformWord8 RGen instance Distribution StdUniform Word16 where rvarT _ = Random.uniformWord16 RGen instance Distribution StdUniform Word32 where rvarT _ = Random.uniformWord32 RGen instance Distribution StdUniform Word64 where rvarT _ = Random.uniformWord64 RGen instance Distribution StdUniform Word where rvarT _ = uniformRVarT instance Distribution StdUniform Int8 where rvarT _ = uniformRVarT instance Distribution StdUniform Int16 where rvarT _ = uniformRVarT instance Distribution StdUniform Int32 where rvarT _ = uniformRVarT instance Distribution StdUniform Int64 where rvarT _ = uniformRVarT instance Distribution StdUniform Int where rvarT _ = uniformRVarT -- Integer has no StdUniform... instance CDF StdUniform Word8 where cdf _ = integralUniformCDF minBound maxBound instance CDF StdUniform Word16 where cdf _ = integralUniformCDF minBound maxBound instance CDF StdUniform Word32 where cdf _ = integralUniformCDF minBound maxBound instance CDF StdUniform Word64 where cdf _ = integralUniformCDF minBound maxBound instance CDF StdUniform Word where cdf _ = integralUniformCDF minBound maxBound instance CDF StdUniform Int8 where cdf _ = integralUniformCDF minBound maxBound instance CDF StdUniform Int16 where cdf _ = integralUniformCDF minBound maxBound instance CDF StdUniform Int32 where cdf _ = integralUniformCDF minBound maxBound instance CDF StdUniform Int64 where cdf _ = integralUniformCDF minBound maxBound instance CDF StdUniform Int where cdf _ = integralUniformCDF minBound maxBound instance Distribution Uniform Float where rvarT (Uniform a b) = floatUniform a b instance Distribution Uniform Double where rvarT (Uniform a b) = doubleUniform a b instance CDF Uniform Float where cdf (Uniform a b) = realUniformCDF a b instance CDF Uniform Double where cdf (Uniform a b) = realUniformCDF a b instance Distribution StdUniform Float where rvarT _ = floatStdUniform instance Distribution StdUniform Double where rvarT _ = uniformRangeRVarT (0, 1) instance CDF StdUniform Float where cdf _ = realStdUniformCDF instance CDF StdUniform Double where cdf _ = realStdUniformCDF instance PDF StdUniform Float where pdf _ = realStdUniformPDF instance PDF StdUniform Double where pdf _ = realStdUniformPDF instance HasResolution r => Distribution Uniform (Fixed r) where rvarT (Uniform a b) = fixedUniform a b instance HasResolution r => CDF Uniform (Fixed r) where cdf (Uniform a b) = realUniformCDF a b instance HasResolution r => Distribution StdUniform (Fixed r) where rvarT ~StdUniform = fixedStdUniform instance HasResolution r => CDF StdUniform (Fixed r) where cdf ~StdUniform = realStdUniformCDF instance Distribution Uniform () where rvarT (Uniform _ _) = return () instance CDF Uniform () where cdf (Uniform _ _) = return 1 instance Distribution Uniform Char where rvarT (Uniform a b) = enumUniform a b instance CDF Uniform Char where cdf (Uniform a b) = enumUniformCDF a b instance Distribution Uniform Bool where rvarT (Uniform a b) = enumUniform a b instance CDF Uniform Bool where cdf (Uniform a b) = enumUniformCDF a b instance Distribution Uniform Ordering where rvarT (Uniform a b) = enumUniform a b instance CDF Uniform Ordering where cdf (Uniform a b) = enumUniformCDF a b instance Distribution StdUniform () where rvarT ~StdUniform = return () instance CDF StdUniform () where cdf ~StdUniform = return 1 instance Distribution StdUniform Bool where rvarT ~StdUniform = uniformRVarT instance CDF StdUniform Bool where cdf ~StdUniform = boundedEnumStdUniformCDF instance Distribution StdUniform Char where rvarT ~StdUniform = boundedEnumStdUniform instance CDF StdUniform Char where cdf ~StdUniform = boundedEnumStdUniformCDF instance Distribution StdUniform Ordering where rvarT ~StdUniform = boundedEnumStdUniform instance CDF StdUniform Ordering where cdf ~StdUniform = boundedEnumStdUniformCDF random-fu-0.3.0.1/src/Data/Random/Distribution/Weibull.hs0000644000000000000000000000124207346545000021227 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, FlexibleContexts #-} module Data.Random.Distribution.Weibull where import Data.Random.Distribution import Data.Random.Distribution.Uniform data Weibull a = Weibull { weibullLambda :: !a, weibullK :: !a } deriving (Eq, Show) instance (Floating a, Distribution StdUniform a) => Distribution Weibull a where rvarT (Weibull lambda k) = do u <- rvarT StdUniform return (lambda * (negate (log u)) ** recip k) instance (Real a, Distribution Weibull a) => CDF Weibull a where cdf (Weibull lambda k) x = 1 - exp (negate ((realToFrac x / realToFrac lambda) ** realToFrac k)) random-fu-0.3.0.1/src/Data/Random/Distribution/Ziggurat.hs0000644000000000000000000003165207346545000021430 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, RankNTypes, FlexibleInstances, FlexibleContexts, RecordWildCards, BangPatterns #-} -- |A generic \"ziggurat algorithm\" implementation. Fairly rough right -- now. -- -- There is a lot of room for improvement in 'findBin0' especially. -- It needs a fair amount of cleanup and elimination of redundant -- calculation, as well as either a justification for using the simple -- 'findMinFrom' or a proper root-finding algorithm. -- -- It would also be nice to add (preferably by pulling in an -- external package) support for numerical integration and -- differentiation, so that tables can be derived from only a -- PDF (if the end user is willing to take the performance and -- accuracy hit for the convenience). module Data.Random.Distribution.Ziggurat ( Ziggurat(..) , mkZigguratRec , mkZiggurat , mkZiggurat_ , findBin0 , runZiggurat ) where import Data.Random.Internal.Find import Data.Random.Distribution.Uniform import Data.Random.Distribution import Data.Random.RVar import Data.Vector.Generic as Vec import qualified Data.Vector as V import qualified Data.Vector.Unboxed as UV -- |A data structure containing all the data that is needed -- to implement Marsaglia & Tang's \"ziggurat\" algorithm for -- sampling certain kinds of random distributions. -- -- The documentation here is probably not sufficient to tell a user exactly -- how to build one of these from scratch, but it is not really intended to -- be. There are several helper functions that will build 'Ziggurat's. -- The pathologically curious may wish to read the 'runZiggurat' source. -- That is the ultimate specification of the semantics of all these fields. data Ziggurat v t = Ziggurat { -- |The X locations of each bin in the distribution. Bin 0 is the -- 'infinite' one. -- -- In the case of bin 0, the value given is sort of magical - x[0] is -- defined to be V/f(R). It's not actually the location of any bin, -- but a value computed to make the algorithm more concise and slightly -- faster by not needing to specially-handle bin 0 quite as often. -- If you really need to know why it works, see the 'runZiggurat' -- source or \"the literature\" - it's a fairly standard setup. zTable_xs :: !(v t), -- |The ratio of each bin's Y value to the next bin's Y value zTable_y_ratios :: !(v t), -- |The Y value (zFunc x) of each bin zTable_ys :: !(v t), -- |An RVar providing a random tuple consisting of: -- -- * a bin index, uniform over [0,c) :: Int (where @c@ is the -- number of bins in the tables) -- -- * a uniformly distributed fractional value, from -1 to 1 -- if not mirrored, from 0 to 1 otherwise. -- -- This is provided as a single 'RVar' because it can be implemented -- more efficiently than naively sampling 2 separate values - a -- single random word (64 bits) can be efficiently converted to -- a double (using 52 bits) and a bin number (using up to 12 bits), -- for example. zGetIU :: !(forall m. RVarT m (Int, t)), -- |The distribution for the final \"virtual\" bin -- (the ziggurat algorithm does not handle distributions -- that wander off to infinity, so another distribution is needed -- to handle the last \"bin\" that stretches to infinity) zTailDist :: (forall m. RVarT m t), -- |A copy of the uniform RVar generator for the base type, -- so that @Distribution Uniform t@ is not needed when sampling -- from a Ziggurat (makes it a bit more self-contained). zUniform :: !(forall m. t -> t -> RVarT m t), -- |The (one-sided antitone) PDF, not necessarily normalized zFunc :: !(t -> t), -- |A flag indicating whether the distribution should be -- mirrored about the origin (the ziggurat algorithm in -- its native form only samples from one-sided distributions. -- By mirroring, we can extend it to symmetric distributions -- such as the normal distribution) zMirror :: !Bool } -- |Sample from the distribution encoded in a 'Ziggurat' data structure. {-# INLINE runZiggurat #-} {-# SPECIALIZE runZiggurat :: Ziggurat UV.Vector Float -> RVarT m Float #-} {-# SPECIALIZE runZiggurat :: Ziggurat UV.Vector Double -> RVarT m Double #-} {-# SPECIALIZE runZiggurat :: Ziggurat V.Vector Float -> RVarT m Float #-} {-# SPECIALIZE runZiggurat :: Ziggurat V.Vector Double -> RVarT m Double #-} runZiggurat :: (Num a, Ord a, Vector v a) => Ziggurat v a -> RVarT m a runZiggurat !Ziggurat{..} = go where {-# NOINLINE go #-} go = do -- Select a bin (I) and a uniform value (U) from -1 to 1 -- (or 0 to 1 if not mirroring the distribution). -- Let X be U scaled to the size of the selected bin. (!i,!u) <- zGetIU -- if the uniform value U falls in the area "clearly inside" the -- bin, accept X immediately. -- Otherwise, depending on the bin selected, use either the -- tail distribution or an accept/reject test. if abs u < zTable_y_ratios ! i then return $! (u * zTable_xs ! i) else if i == 0 then sampleTail u else sampleGreyArea i $! (u * zTable_xs ! i) -- when the sample falls in the "grey area" (the area between -- the Y values of the selected bin and the bin after that one), -- use an accept/reject method based on the target PDF. {-# INLINE sampleGreyArea #-} sampleGreyArea i x = do !v <- zUniform (zTable_ys ! (i+1)) (zTable_ys ! i) if v < zFunc (abs x) then return $! x else go -- if the selected bin is the "infinite" one, call it quits and -- defer to the tail distribution (mirroring if needed to ensure -- the result has the sign already selected by zGetIU) {-# INLINE sampleTail #-} sampleTail x | zMirror && x < 0 = fmap negate zTailDist | otherwise = zTailDist -- |Build the tables to implement the \"ziggurat algorithm\" devised by -- Marsaglia & Tang, attempting to automatically compute the R and V -- values. -- -- Arguments: -- -- * flag indicating whether to mirror the distribution -- -- * the (one-sided antitone) PDF, not necessarily normalized -- -- * the inverse of the PDF -- -- * the number of bins -- -- * R, the x value of the first bin -- -- * V, the volume of each bin -- -- * an RVar providing the 'zGetIU' random tuple -- -- * an RVar sampling from the tail (the region where x > R) -- {-# INLINE mkZiggurat_ #-} {-# SPECIALIZE mkZiggurat_ :: Bool -> (Float -> Float) -> (Float -> Float) -> Int -> Float -> Float -> (forall m. RVarT m (Int, Float)) -> (forall m. RVarT m Float ) -> Ziggurat UV.Vector Float #-} {-# SPECIALIZE mkZiggurat_ :: Bool -> (Double -> Double) -> (Double -> Double) -> Int -> Double -> Double -> (forall m. RVarT m (Int, Double)) -> (forall m. RVarT m Double) -> Ziggurat UV.Vector Double #-} {-# SPECIALIZE mkZiggurat_ :: Bool -> (Float -> Float) -> (Float -> Float) -> Int -> Float -> Float -> (forall m. RVarT m (Int, Float)) -> (forall m. RVarT m Float ) -> Ziggurat V.Vector Float #-} {-# SPECIALIZE mkZiggurat_ :: Bool -> (Double -> Double) -> (Double -> Double) -> Int -> Double -> Double -> (forall m. RVarT m (Int, Double)) -> (forall m. RVarT m Double) -> Ziggurat V.Vector Double #-} mkZiggurat_ :: (RealFloat t, Vector v t, Distribution Uniform t) => Bool -> (t -> t) -> (t -> t) -> Int -> t -> t -> (forall m. RVarT m (Int, t)) -> (forall m. RVarT m t) -> Ziggurat v t mkZiggurat_ m f fInv c r v getIU tailDist = Ziggurat { zTable_xs = xs , zTable_y_ratios = precomputeRatios xs , zTable_ys = Vec.map f xs , zGetIU = getIU , zUniform = uniformT , zFunc = f , zTailDist = tailDist , zMirror = m } where xs = zigguratTable f fInv c r v -- |Build the tables to implement the \"ziggurat algorithm\" devised by -- Marsaglia & Tang, attempting to automatically compute the R and V -- values. -- -- Arguments are the same as for 'mkZigguratRec', with an additional -- argument for the tail distribution as a function of the selected -- R value. mkZiggurat :: (RealFloat t, Vector v t, Distribution Uniform t) => Bool -> (t -> t) -> (t -> t) -> (t -> t) -> t -> Int -> (forall m. RVarT m (Int, t)) -> (forall m. t -> RVarT m t) -> Ziggurat v t mkZiggurat m f fInv fInt fVol c getIU tailDist = mkZiggurat_ m f fInv c r v getIU (tailDist r) where (r,v) = findBin0 c f fInv fInt fVol -- |Build a lazy recursive ziggurat. Uses a lazily-constructed ziggurat -- as its tail distribution (with another as its tail, ad nauseam). -- -- Arguments: -- -- * flag indicating whether to mirror the distribution -- -- * the (one-sided antitone) PDF, not necessarily normalized -- -- * the inverse of the PDF -- -- * the integral of the PDF (definite, from 0) -- -- * the estimated volume under the PDF (from 0 to +infinity) -- -- * the chunk size (number of bins in each layer). 64 seems to -- perform well in practice. -- -- * an RVar providing the 'zGetIU' random tuple -- mkZigguratRec :: (RealFloat t, Vector v t, Distribution Uniform t) => Bool -> (t -> t) -> (t -> t) -> (t -> t) -> t -> Int -> (forall m. RVarT m (Int, t)) -> Ziggurat v t mkZigguratRec m f fInv fInt fVol c getIU = z where fix :: ((forall m. a -> RVarT m a) -> (forall m. a -> RVarT m a)) -> (forall m. a -> RVarT m a) fix g = g (fix g) z = mkZiggurat m f fInv fInt fVol c getIU (fix (mkTail m f fInv fInt fVol c getIU z)) mkTail :: (RealFloat a, Vector v a, Distribution Uniform a) => Bool -> (a -> a) -> (a -> a) -> (a -> a) -> a -> Int -> (forall m. RVarT m (Int, a)) -> Ziggurat v a -> (forall m. a -> RVarT m a) -> (forall m. a -> RVarT m a) mkTail m f fInv fInt fVol c getIU typeRep nextTail r = do x <- rvarT (mkZiggurat m f' fInv' fInt' fVol' c getIU nextTail `asTypeOf` typeRep) return (x + r * signum x) where fIntR = fInt r f' x | x < 0 = f r | otherwise = f (x+r) fInv' = subtract r . fInv fInt' x | x < 0 = 0 | otherwise = fInt (x+r) - fIntR fVol' = fVol - fIntR zigguratTable :: (Fractional a, Vector v a, Ord a) => (a -> a) -> (a -> a) -> Int -> a -> a -> v a zigguratTable f fInv c r v = case zigguratXs f fInv c r v of (xs, _excess) -> fromList xs zigguratExcess :: (Fractional a, Ord a) => (a -> a) -> (a -> a) -> Int -> a -> a -> a zigguratExcess f fInv c r v = snd (zigguratXs f fInv c r v) zigguratXs :: (Fractional a, Ord a) => (a -> a) -> (a -> a) -> Int -> a -> a -> ([a], a) zigguratXs f fInv c r v = (xs, excess) where xs = Prelude.map x [0..c] -- sample c x ys = Prelude.map f xs x 0 = v / f r x 1 = r x i | i == c = 0 x i | i > 1 = next (i-1) x _ = error "zigguratXs: programming error! this case should be impossible!" next i = let x_i = xs!!i in if x_i <= 0 then -1 else fInv (ys!!i + (v / x_i)) excess = xs!!(c-1) * (f 0 - ys !! (c-1)) - v precomputeRatios :: (Vector v a, Fractional a) => v a -> v a precomputeRatios zTable_xs = generate (c-1) $ \i -> zTable_xs!(i+1) / zTable_xs!i where c = Vec.length zTable_xs -- |I suspect this isn't completely right, but it works well so far. -- Search the distribution for an appropriate R and V. -- -- Arguments: -- -- * Number of bins -- -- * target function (one-sided antitone PDF, not necessarily normalized) -- -- * function inverse -- -- * function definite integral (from 0 to _) -- -- * estimate of total volume under function (integral from 0 to infinity) -- -- Result: (R,V) findBin0 :: (RealFloat b) => Int -> (b -> b) -> (b -> b) -> (b -> b) -> b -> (b, b) findBin0 cInt f fInv fInt fVol = (rMin,v rMin) where c = fromIntegral cInt v r = r * f r + fVol - fInt r -- initial R guess: r0 = findMin (\r -> v r <= fVol / c) -- find a better R: rMin = findMinFrom r0 1 $ \r -> let e = exc r in e >= 0 && not (isNaN e) exc x = zigguratExcess f fInv cInt x (v x) instance (Num t, Ord t, Vector v t) => Distribution (Ziggurat v) t where rvar = runZiggurat random-fu-0.3.0.1/src/Data/Random/Internal/0000755000000000000000000000000007346545000016366 5ustar0000000000000000random-fu-0.3.0.1/src/Data/Random/Internal/Find.hs0000644000000000000000000000421407346545000017603 0ustar0000000000000000{- - ``Data/Random/Internal/Find'' - Utilities for searching fractional domains. Needs cleanup, testing, - and such. Used for constructing generic ziggurats. -} module Data.Random.Internal.Find where findMax :: (Fractional a, Ord a) => (a -> Bool) -> a findMax p = negate (findMin (p.negate)) -- |Given an upward-closed predicate on an ordered Fractional type, -- find the smallest value satisfying the predicate. findMin :: (Fractional a, Ord a) => (a -> Bool) -> a findMin = findMinFrom 0 1 -- |Given an upward-closed predicate on an ordered Fractional type, -- find the smallest value satisfying the predicate. Starts at the -- specified point with the specified stepsize, performs an exponential -- search out from there until it finds an interval bracketing the -- change-point of the predicate, and then performs a bisection search -- to isolate the change point. Note that infinitely-divisible domains -- such as 'Rational' cannot be searched by this function because it does -- not terminate until it reaches a point where further subdivision of the -- interval has no effect. findMinFrom :: (Fractional a, Ord a) => a -> a -> (a -> Bool) -> a findMinFrom z0 0 p = findMinFrom z0 1 p findMinFrom z0 step1 p | p z0 = descend (z0-step1) z0 | otherwise = fixZero (ascend z0 (z0+step1)) where -- eliminate negative zero, which, in many domains, is technically -- a feasible answer fixZero 0 = 0 fixZero z = z -- preconditions: -- not (p l) -- 0 <= l < x ascend l x | p x = bisect l x | otherwise = ascend x $! 2*x-z0 -- preconditions: -- p h -- x < h <= 0 descend x h | p x = (descend $! 2*x-z0) x | otherwise = bisect x h -- preconditions: -- not (p l) -- p h -- l <= h bisect l h | l /< h = h | l /< mid || mid /< h = if p mid then mid else h | p mid = bisect l mid | otherwise = bisect mid h where a /< b = not (a < b) mid = (l+h)*0.5 random-fu-0.3.0.1/src/Data/Random/Internal/Fixed.hs0000644000000000000000000000227107346545000017763 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Random.Internal.Fixed where import Data.Fixed import Unsafe.Coerce #ifdef old_Fixed -- So much for backward compatibility through base (>=5) ... resolutionOf :: HasResolution r => f r -> Integer resolutionOf x = resolution (res x) where res :: HasResolution r => f r -> r res = undefined resolutionOf2 :: HasResolution r => f (g r) -> Integer resolutionOf2 x = resolution (res x) where res :: HasResolution r => f (g r) -> r res = undefined #else resolutionOf :: HasResolution r => f r -> Integer resolutionOf = resolution resolutionOf2 :: HasResolution r => f (g r) -> Integer resolutionOf2 x = resolution (res x) where res :: HasResolution r => f (g r) -> g r res = undefined #endif -- |The 'Fixed' type doesn't expose its constructors, but I need a way to -- convert them to and from their raw representation in order to sample -- them. As long as 'Fixed' is a newtype wrapping 'Integer', 'mkFixed' and -- 'unMkFixed' as defined here will work. Both are implemented using -- 'unsafeCoerce'. mkFixed :: Integer -> Fixed r mkFixed = unsafeCoerce unMkFixed :: Fixed r -> Integer unMkFixed = unsafeCoerce random-fu-0.3.0.1/src/Data/Random/Lift.hs0000644000000000000000000000440707346545000016051 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, IncoherentInstances, CPP #-} module Data.Random.Lift where import Data.RVar import qualified Data.Functor.Identity as T import qualified Control.Monad.Trans.Class as T #ifndef MTL2 import qualified Control.Monad.Identity as MTL #endif -- | A class for \"liftable\" data structures. Conceptually -- an extension of 'T.MonadTrans' to allow deep lifting, -- but lifting need not be done between monads only. Eg lifting -- between 'Applicative's is allowed. -- -- For instances where 'm' and 'n' have 'return'/'pure' defined, -- these instances must satisfy -- @lift (return x) == return x@. -- -- This form of 'lift' has an extremely general type and is used primarily to -- support 'sample'. Its excessive generality is the main reason it's not -- exported from "Data.Random". 'RVarT' is, however, an instance of -- 'T.MonadTrans', which in most cases is the preferred way -- to do the lifting. class Lift m n where lift :: m a -> n a instance (Monad m, T.MonadTrans t) => Lift m (t m) where lift = T.lift instance Lift m m where lift = id -- | This instance is incoherent with the others. However, -- by the law @lift (return x) == return x@, the results -- must always be the same. instance Monad m => Lift T.Identity m where lift = return . T.runIdentity instance Lift (RVarT T.Identity) (RVarT m) where lift x = runRVar x RGen -- | This instance is again incoherent with the others, but provides a -- more-specific instance to resolve the overlap between the -- @Lift m (t m)@ and @Lift Identity m@ instances. instance T.MonadTrans t => Lift T.Identity (t T.Identity) where lift = T.lift #ifndef MTL2 -- | This instance is incoherent with the others. However, -- by the law @lift (return x) == return x@, the results -- must always be the same. instance Monad m => Lift MTL.Identity m where lift = return . MTL.runIdentity instance Lift (RVarT MTL.Identity) (RVarT m) where lift x = runRVarTWith (return . MTL.runIdentity) x RGen -- | This instance is again incoherent with the others, but provides a -- more-specific instance to resolve the overlap between the -- @Lift m (t m)@ and @Lift Identity m@ instances. instance T.MonadTrans t => Lift MTL.Identity (t MTL.Identity) where lift = T.lift #endif random-fu-0.3.0.1/src/Data/Random/List.hs0000644000000000000000000000356607346545000016073 0ustar0000000000000000module Data.Random.List where import Data.Random.RVar import Data.Random.Distribution.Uniform import qualified System.Random.Shuffle as SRS import Control.Monad -- | A random variable returning an arbitrary element of the given list. -- Every element has equal probability of being chosen. Because it is a -- pure 'RVar' it has no memory - that is, it \"draws with replacement.\" randomElement :: [a] -> RVar a randomElement = randomElementT randomElementT :: [a] -> RVarT m a randomElementT [] = error "randomElementT: empty list!" randomElementT xs = do n <- uniformT 0 (length xs - 1) return (xs !! n) -- | A random variable that returns the given list in an arbitrary shuffled -- order. Every ordering of the list has equal probability. shuffle :: [a] -> RVar [a] shuffle = shuffleT shuffleT :: [a] -> RVarT m [a] shuffleT [] = return [] shuffleT xs = do is <- zipWithM (\_ i -> uniformT 0 i) (tail xs) [1..] return (SRS.shuffle xs (reverse is)) -- | A random variable that shuffles a list of a known length (or a list -- prefix of the specified length). Useful for shuffling large lists when -- the length is known in advance. Avoids needing to traverse the list to -- discover its length. Each ordering has equal probability. shuffleN :: Int -> [a] -> RVar [a] shuffleN = shuffleNT shuffleNT :: Int -> [a] -> RVarT m [a] shuffleNT n xs = shuffleNofMT n n xs -- | A random variable that selects N arbitrary elements of a list of known length M. shuffleNofM :: Int -> Int -> [a] -> RVar [a] shuffleNofM = shuffleNofMT shuffleNofMT :: Int -> Int -> [a] -> RVarT m [a] shuffleNofMT 0 _ _ = return [] shuffleNofMT n m xs | n > m = error "shuffleNofMT: n > m" | n >= 0 = do is <- sequence [uniformT 0 i | i <- take n [m-1, m-2 ..1]] return (take n $ SRS.shuffle (take m xs) is) shuffleNofMT _ _ _ = error "shuffleNofMT: negative length specified" random-fu-0.3.0.1/src/Data/Random/RVar.hs0000644000000000000000000000074407346545000016025 0ustar0000000000000000{-# LANGUAGE RankNTypes, FlexibleInstances, MultiParamTypeClasses #-} module Data.Random.RVar ( RVar, runRVar , RVarT, runRVarT, runRVarTWith , RGen(..), uniformRVarT, uniformRangeRVarT ) where import Data.Random.Lift import Data.RVar hiding (runRVarT) import System.Random.Stateful -- |Like 'runRVarTWith', but using an implicit lifting (provided by the -- 'Lift' class) runRVarT :: (Lift n m, StatefulGen g m) => RVarT n a -> g -> m a runRVarT = runRVarTWith lift random-fu-0.3.0.1/src/Data/Random/Sample.hs0000644000000000000000000000415107346545000016370 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, IncoherentInstances #-} {-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-} module Data.Random.Sample where import Control.Monad.State import Control.Monad.Reader import Data.Random.Distribution import Data.Random.Lift import Data.Random.RVar import System.Random.Stateful -- |A typeclass allowing 'Distribution's and 'RVar's to be sampled. Both may -- also be sampled via 'runRVar' or 'runRVarT', but I find it psychologically -- pleasing to be able to sample both using this function, as they are two -- separate abstractions for one base concept: a random variable. class Sampleable d m t where -- |Directly sample from a distribution or random variable, using the given source of entropy. sampleFrom :: StatefulGen g m => g -> d t -> m t instance Distribution d t => Sampleable d m t where sampleFrom gen d = runRVarT (rvar d) gen -- This instance overlaps with the other, but because RVarT is not a Distribution there is no conflict. instance Lift m n => Sampleable (RVarT m) n t where sampleFrom gen x = runRVarT x gen -- |Sample a random variable using the default source of entropy for the -- monad in which the sampling occurs. sample :: (Sampleable d m t, StatefulGen g m, MonadReader g m) => d t -> m t sample thing = ask >>= \gen -> sampleFrom gen thing -- |Sample a random variable in a \"functional\" style. Typical instantiations -- of @s@ are @System.Random.StdGen@ or @System.Random.Mersenne.Pure64.PureMT@. -- sample :: (Distribution d a, StatefulGen g m, MonadReader g m) => d t -> m t -- sample thing gen = runStateGen gen (\stateGen -> sampleFrom stateGen thing) sampleState :: (Distribution d t, RandomGen g, MonadState g m) => d t -> m t sampleState thing = sampleFrom StateGenM thing -- |Sample a random variable in a \"functional\" style. Typical instantiations -- of @g@ are @System.Random.StdGen@ or @System.Random.Mersenne.Pure64.PureMT@. samplePure :: (Distribution d t, RandomGen g) => d t -> g -> (t, g) samplePure thing gen = runStateGen gen (\stateGen -> sampleFrom stateGen thing) random-fu-0.3.0.1/src/Data/Random/Vector.hs0000644000000000000000000000047007346545000016411 0ustar0000000000000000module Data.Random.Vector(randomElement) where import Data.Random.RVar import Data.Random.Distribution.Uniform import qualified Data.Vector as V -- | Take a random element of a vector. randomElement :: V.Vector a -> RVar a randomElement wrds = (wrds V.!) <$> uniform 0 (V.length wrds - 1)