mwc-random-0.13.3.2/0000755000000000000000000000000012506066656012204 5ustar0000000000000000mwc-random-0.13.3.2/Setup.lhs0000644000000000000000000000011412506066656014010 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain mwc-random-0.13.3.2/README.markdown0000644000000000000000000000132712506066656014710 0ustar0000000000000000# Efficient, general purpose pseudo-random number generation This package provides the System.Random.MWC module, a Haskell library for generating high-quality pseudo-random numbers in a space- and time-efficient way. # Get involved! Please report bugs via the [github issue tracker](http://github.com/bos/mwc-random). Master git [git repository](http://github.com/bos/mwc-random): * `git clone git://github.com/bos/mwc-random.git` There's also a [Mercurial mirror](http://bitbucket.org/bos/mwc-random): * `hg clone http://bitbucket.org/bos/mwc-random` (You can create and contribute changes using either Mercurial or git.) # Authors This library is written and maintained by Bryan O'Sullivan, . mwc-random-0.13.3.2/mwc-random.cabal0000644000000000000000000000442012506066656015234 0ustar0000000000000000name: mwc-random version: 0.13.3.2 synopsis: Fast, high quality pseudo random number generation description: This package contains code for generating high quality random numbers that follow either a uniform or normal distribution. The generated numbers are suitable for use in statistical applications. . The uniform PRNG uses Marsaglia's MWC256 (also known as MWC8222) multiply-with-carry generator, which has a period of 2^8222 and fares well in tests of randomness. It is also extremely fast, between 2 and 3 times faster than the Mersenne Twister. . Compared to the mersenne-random package, this package has a more convenient API, is faster, and supports more statistical distributions. license: BSD3 license-file: LICENSE homepage: https://github.com/bos/mwc-random bug-reports: https://github.com/bos/mwc-random/issues author: Bryan O'Sullivan maintainer: Bryan O'Sullivan copyright: 2009, 2010, 2011 Bryan O'Sullivan category: Math, Statistics build-type: Simple cabal-version: >= 1.8 extra-source-files: ChangeLog README.markdown benchmarks/*.hs benchmarks/Quickie.hs benchmarks/mwc-random-benchmarks.cabal test/*.R test/*.sh test/visual.hs library exposed-modules: System.Random.MWC System.Random.MWC.Distributions System.Random.MWC.CondensedTable build-depends: base < 5, primitive, time, vector >= 0.7 if impl(ghc >= 6.10) build-depends: base >= 4 -- gather extensive profiling data for now ghc-prof-options: -auto-all ghc-options: -Wall -funbox-strict-fields if impl(ghc >= 6.8) ghc-options: -fwarn-tabs test-suite tests buildable: False type: exitcode-stdio-1.0 hs-source-dirs: test main-is: tests.hs other-modules: KS QC ghc-options: -Wall -threaded -rtsopts build-depends: vector >= 0.7, HUnit, QuickCheck, base, mwc-random, statistics >= 0.10.1.0, test-framework, test-framework-hunit, test-framework-quickcheck2 source-repository head type: git location: git://github.com/bos/mwc-random source-repository head type: mercurial location: https://bitbucket.org/bos/mwc-random mwc-random-0.13.3.2/LICENSE0000644000000000000000000000245412506066656013216 0ustar0000000000000000Copyright (c) 2009, Bryan O'Sullivan All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. mwc-random-0.13.3.2/ChangeLog0000644000000000000000000000203412506066656013755 0ustar0000000000000000Changes in 0.13.3.1 * primitive-0.6 compatibility Changes in 0.13.3.0 * Monadic variant of vector shuffle added: `uniformShuffleM` * Context on `uniformShuffle` loosened Changes in 0.13.2.2 * Fixed crash during gen. initialization on Windows when stderr is not available (#36). Changes in 0.13.2.0 * Generators for beta, Bernoully, Dirichlet and categorical distributions added. * Functions for generating random shuffles added. Changes in 0.13.1.2 * GHC 7.9 support Changes in 0.13.1.1 * Long standing performance problem in normal distribution fixed (#16) Changes in 0.13.1.0 * createSystemRandom added Changes in 0.13.0.0 * Workaround for GHC bug 8072 (bug 25). GHC 7.6 on 32-bit platrofms is affected. * Generators for truncated exponential and geometric distributions added. Changes in 0.12.0.0 * Fucntion `asGenIO' and `asGenST' added. * Generation of discrete random variates using condensed tables methed. Tables for Poisson and binomial distributions are provided. mwc-random-0.13.3.2/test/0000755000000000000000000000000012506066656013163 5ustar0000000000000000mwc-random-0.13.3.2/test/KS.hs0000644000000000000000000000433512506066656014041 0ustar0000000000000000-- Kolmogorov-Smirnov tests for distribution -- -- Note that it's not most powerful test for normality. module KS ( tests ) where import qualified Data.Vector.Unboxed as U import Statistics.Test.KolmogorovSmirnov import Statistics.Distribution import Statistics.Distribution.Binomial import Statistics.Distribution.Exponential import Statistics.Distribution.Gamma import Statistics.Distribution.Normal import Statistics.Distribution.Uniform import Statistics.Distribution.Beta import qualified System.Random.MWC as MWC import qualified System.Random.MWC.Distributions as MWC import Test.HUnit hiding (Test) import Test.Framework import Test.Framework.Providers.HUnit tests :: MWC.GenIO -> Test tests g = testGroup "Kolmogorov-Smirnov" [ testCase "standard" $ testKS standard MWC.standard g , testCase "normal m=1 s=2" $ testKS (normalDistr 1 2) (MWC.normal 1 2) g -- Gamma distribution , testCase "gamma k=1 θ=1" $ testKS (gammaDistr 1 1 ) (MWC.gamma 1 1 ) g , testCase "gamma k=0.3 θ=0.4" $ testKS (gammaDistr 0.3 0.4) (MWC.gamma 0.3 0.4) g , testCase "gamma k=0.3 θ=3" $ testKS (gammaDistr 0.3 3 ) (MWC.gamma 0.3 3 ) g , testCase "gamma k=3 θ=0.4" $ testKS (gammaDistr 3 0.4) (MWC.gamma 3 0.4) g , testCase "gamma k=3 θ=3" $ testKS (gammaDistr 3 3 ) (MWC.gamma 3 3 ) g -- Uniform , testCase "uniform -2 .. 3" $ testKS (uniformDistr (-2) 3) (MWC.uniformR (-2,3)) g -- Exponential , testCase "exponential l=1" $ testKS (exponential 1) (MWC.exponential 1) g , testCase "exponential l=3" $ testKS (exponential 3) (MWC.exponential 3) g -- Beta , testCase "beta a=0.3,b=0.5" $ testKS (betaDistr 0.3 0.5) (MWC.beta 0.3 0.5) g , testCase "beta a=0.1,b=0.8" $ testKS (betaDistr 0.3 0.5) (MWC.beta 0.3 0.5) g , testCase "beta a=0.8,b=0.1" $ testKS (betaDistr 0.3 0.5) (MWC.beta 0.3 0.5) g ] testKS :: (Distribution d) => d -> (MWC.GenIO -> IO Double) -> MWC.GenIO -> IO () testKS distr generator g = do sample <- U.replicateM 1000 (generator g) case kolmogorovSmirnovTest distr 0.01 sample of Significant -> assertFailure "KS test failed" NotSignificant -> return () mwc-random-0.13.3.2/test/visual.R0000644000000000000000000000577012506066656014622 0ustar0000000000000000# Ugly script for displaying distributions alogside with theoretical # distribution. view.dumps <- function() { # Load random data from dist load.d <- function(name) read.table(name)[,1] # Plots for continous distribution plot.d <- function(name, dens, rng) { smp <- load.d( name ) plot( density(smp), xlim=rng, main=name, col='blue', lwd=2) hist( smp, probability=TRUE, breaks=100, add=TRUE) plot( dens, xlim=rng, col='red', add=TRUE, lwd=2) } # plots for discrete distribution plot.ds <- function( name, xs, prob) { smp <- load.d( name ) h <- hist( smp, breaks = c( max(xs) + 0.5, xs - 0.5), freq=FALSE, main = name ) dh <- sqrt( h$count ) / max( 1, sum( h$count ) ) arrows( xs, h$density + dh, xs, h$density - dh, angle=90, code=3, length=0.2 ) points( xs, prob(xs), pch='0', col='red', type='b') } ################################################################ # Normal plot.d ("distr/normal-0-1", function(x) dnorm( x, 0, 1 ), c(-4,4) ) readline() # plot.d ("distr/normal-1-2", function(x) dnorm( x, 1, 2 ), c(-6,8) ) readline(); ################################################################ # Gamma plot.d ("distr/gamma-1.0-1.0", function(x) dgamma( x, 1, 1 ), c(-1,8) ) readline(); # plot.d ("distr/gamma-0.3-0.4", function(x) dgamma( x, 0.3, scale=0.4 ), c(-0.25,2) ) readline(); # plot.d ("distr/gamma-0.3-3.0", function(x) dgamma( x, 0.3, scale=3.0 ), c(-1,5) ) readline(); # plot.d ("distr/gamma-3.0-0.4", function(x) dgamma( x, 3.0, scale=0.4 ), c(-1,6) ) readline(); # plot.d ("distr/gamma-3.0-3.0", function(x) dgamma( x, 3.0, scale=3.0 ), c(-1,32) ) readline(); ################################################################ # Exponential plot.d ("distr/exponential-1", function(x) dexp(x,1), c(-0.5, 9) ) readline() # plot.d ("distr/exponential-3", function(x) dexp(x,3), c(-0.5, 3) ) readline() ################################################################ # Poisson plot.ds( "distr/poisson-0.1", 0:6, function(x) dpois(x, lambda=0.1) ) readline() # plot.ds( "distr/poisson-1.0", 0:10, function(x) dpois(x, lambda=1.0) ) readline() # plot.ds( "distr/poisson-4.5", 0:20, function(x) dpois(x, lambda=4.5) ) readline() # plot.ds( "distr/poisson-30", 0:100, function(x) dpois(x, lambda=30) ) readline() # ################################################################ # Binomial plot.ds( "distr/binom-4-0.5", 0:4, function(x) dbinom(x, 4, 0.5) ) readline() # plot.ds( "distr/binom-10-0.1", 0:10, function(x) dbinom(x, 10, 0.1) ) readline() # plot.ds( "distr/binom-10-0.6", 0:10, function(x) dbinom(x, 10, 0.6) ) readline() # plot.ds( "distr/binom-10-0.8", 0:10, function(x) dbinom(x, 10, 0.8) ) readline() # } mwc-random-0.13.3.2/test/QC.hs0000644000000000000000000000351612506066656014027 0ustar0000000000000000-- QC tests for random number generators -- -- Require QuickCheck >= 2.2 module QC ( tests ) where import Control.Applicative import Data.Word (Word8,Word16,Word32,Word64,Word) import Data.Int (Int8, Int16, Int32, Int64 ) import Test.QuickCheck import Test.QuickCheck.Monadic import Test.Framework import Test.Framework.Providers.QuickCheck2 import System.Random.MWC ---------------------------------------------------------------- tests :: GenIO -> Test tests g = testGroup "Range" [ testProperty "Int8" $ (prop_InRange g :: InRange Int8) , testProperty "Int16" $ (prop_InRange g :: InRange Int16) , testProperty "Int32" $ (prop_InRange g :: InRange Int32) , testProperty "Int64" $ (prop_InRange g :: InRange Int64) , testProperty "Word8" $ (prop_InRange g :: InRange Word8) , testProperty "Word16" $ (prop_InRange g :: InRange Word16) , testProperty "Word32" $ (prop_InRange g :: InRange Word32) , testProperty "Word64" $ (prop_InRange g :: InRange Word64) , testProperty "Int" $ (prop_InRange g :: InRange Int) , testProperty "Word64" $ (prop_InRange g :: InRange Word) , testProperty "Float" $ (prop_InRange g :: InRange Float) , testProperty "Double" $ (prop_InRange g :: InRange Double) ] ---------------------------------------------------------------- -- Test that values generated with uniformR never lie outside range. prop_InRange :: (Variate a, Ord a,Num a) => GenIO -> OrderedPair a -> Property prop_InRange g (OrderedPair (x1,x2)) = monadicIO $ do r <- run $ uniformR (x1,x2) g assert (x1 <= r && r <= x2) type InRange a = OrderedPair a -> Property -- Ordered pair (x,y) for which x <= y newtype OrderedPair a = OrderedPair (a,a) deriving Show instance (Ord a, Arbitrary a) => Arbitrary (OrderedPair a) where arbitrary = OrderedPair <$> suchThat arbitrary (uncurry (<=)) mwc-random-0.13.3.2/test/run-dieharder-test.sh0000644000000000000000000000154212506066656017227 0ustar0000000000000000#!/bin/sh # # Run dieharder set of tests for PRNG. All command line parameters are # passed directly to the dieharder. If no parameters are given -a flag # is passed which runs all available tests. Full list of dieharder # options is available at dieharder manpage # # NOTE: # Full set of test require a lot of time to complete. From several # hours to a few days depending on CPU speed and thoroughness # settings. # # dieharder-source.hs is enthropy source for this test. # # This test require dieharder to be installed. It is available at: # http://www.phy.duke.edu/~rgb/General/dieharder.php which dieharder > /dev/null || { echo "dieharder is not found. Aborting"; exit 1; } ghc -fforce-recomp -O2 diehard-source ( date ./diehard-source | \ if [ $# = 0 ]; then dieharder -a -g 200; else dieharder "$@" -g 200; fi date ) | tee diehard.log mwc-random-0.13.3.2/test/visual.hs0000644000000000000000000000344112506066656015024 0ustar0000000000000000-- Generates samples of value for display with visual.R import Control.Monad import System.Directory (createDirectoryIfMissing,setCurrentDirectory) import System.IO import qualified System.Random.MWC as MWC import qualified System.Random.MWC.Distributions as MWC import qualified System.Random.MWC.CondensedTable as MWC dumpSample :: Show a => Int -> FilePath -> IO a -> IO () dumpSample n fname gen = withFile fname WriteMode $ \h -> replicateM_ n (hPutStrLn h . show =<< gen) main :: IO () main = MWC.withSystemRandom $ \g -> do let n = 30000 dir = "distr" createDirectoryIfMissing True dir setCurrentDirectory dir -- Normal dumpSample n "normal-0-1" $ MWC.normal 0 1 g dumpSample n "normal-1-2" $ MWC.normal 1 2 g -- Gamma dumpSample n "gamma-1.0-1.0" $ MWC.gamma 1.0 1.0 g dumpSample n "gamma-0.3-0.4" $ MWC.gamma 0.3 0.4 g dumpSample n "gamma-0.3-3.0" $ MWC.gamma 0.3 3.0 g dumpSample n "gamma-3.0-0.4" $ MWC.gamma 3.0 0.4 g dumpSample n "gamma-3.0-3.0" $ MWC.gamma 3.0 3.0 g -- Exponential dumpSample n "exponential-1" $ MWC.exponential 1 g dumpSample n "exponential-3" $ MWC.exponential 3 g -- Poisson dumpSample n "poisson-0.1" $ MWC.genFromTable (MWC.tablePoisson 0.1) g dumpSample n "poisson-1.0" $ MWC.genFromTable (MWC.tablePoisson 1.0) g dumpSample n "poisson-4.5" $ MWC.genFromTable (MWC.tablePoisson 4.5) g dumpSample n "poisson-30" $ MWC.genFromTable (MWC.tablePoisson 30) g -- Binomial dumpSample n "binom-4-0.5" $ MWC.genFromTable (MWC.tableBinomial 4 0.5) g dumpSample n "binom-10-0.1" $ MWC.genFromTable (MWC.tableBinomial 10 0.1) g dumpSample n "binom-10-0.6" $ MWC.genFromTable (MWC.tableBinomial 10 0.6) g dumpSample n "binom-10-0.8" $ MWC.genFromTable (MWC.tableBinomial 10 0.8) g mwc-random-0.13.3.2/test/tests.hs0000644000000000000000000000045312506066656014663 0ustar0000000000000000import Test.Framework (defaultMain) import System.Random.MWC (withSystemRandom) import qualified QC import qualified ChiSquare import qualified KS main :: IO () main = withSystemRandom $ \g -> defaultMain [ QC.tests g , ChiSquare.tests g , KS.tests g ] mwc-random-0.13.3.2/System/0000755000000000000000000000000012506066656013470 5ustar0000000000000000mwc-random-0.13.3.2/System/Random/0000755000000000000000000000000012506066656014710 5ustar0000000000000000mwc-random-0.13.3.2/System/Random/MWC.hs0000644000000000000000000006121512506066656015677 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, FlexibleContexts, MagicHash, Rank2Types, ScopedTypeVariables, TypeFamilies, UnboxedTuples #-} -- | -- Module : System.Random.MWC -- Copyright : (c) 2009-2012 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Pseudo-random number generation. This module contains code for -- generating high quality random numbers that follow a uniform -- distribution. -- -- For non-uniform distributions, see the -- 'System.Random.MWC.Distributions' module. -- -- The uniform PRNG uses Marsaglia's MWC256 (also known as MWC8222) -- multiply-with-carry generator, which has a period of 2^8222 and -- fares well in tests of randomness. It is also extremely fast, -- between 2 and 3 times faster than the Mersenne Twister. -- -- The generator state is stored in the 'Gen' data type. It can be -- created in several ways: -- -- 1. Using the 'withSystemRandom' call, which creates a random state. -- -- 2. Supply your own seed to 'initialize' function. -- -- 3. Finally, 'create' makes a generator from a fixed seed. -- Generators created in this way aren't really random. -- -- For repeatability, the state of the generator can be snapshotted -- and replayed using the 'save' and 'restore' functions. -- -- The simplest use is to generate a vector of uniformly distributed values: -- -- @ -- vs \<- 'withSystemRandom' . 'asGenST' $ \\gen -> 'uniformVector' gen 100 -- @ -- -- These values can be of any type which is an instance of the class -- 'Variate'. -- -- To generate random values on demand, first 'create' a random number -- generator. -- -- @ -- gen <- 'create' -- @ -- -- Hold onto this generator and use it wherever random values are -- required (creating a new generator is expensive compared to -- generating a random number, so you don't want to throw them -- away). Get a random value using 'uniform' or 'uniformR': -- -- @ -- v <- 'uniform' gen -- @ -- -- @ -- v <- 'uniformR' (1, 52) gen -- @ module System.Random.MWC ( -- * Gen: Pseudo-Random Number Generators Gen , create , initialize , withSystemRandom , createSystemRandom -- ** Type helpers -- $typehelp , GenIO , GenST , asGenIO , asGenST -- * Variates: uniformly distributed values , Variate(..) , uniformVector -- * Seed: state management , Seed , fromSeed , toSeed , save , restore -- * References -- $references ) where #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) #include "MachDeps.h" #endif import Control.Monad (ap, liftM, unless) import Control.Monad.Primitive (PrimMonad, PrimState, unsafePrimToIO) #if MIN_VERSION_primitive(0,6,0) import Control.Monad.Primitive (PrimBase) #endif import Control.Monad.ST (ST) import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR, xor) import Data.Int (Int8, Int16, Int32, Int64) import Data.IORef (atomicModifyIORef, newIORef) import Data.Ratio ((%), numerator) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Typeable (Typeable) import Data.Vector.Generic (Vector) import Data.Word (Word, Word8, Word16, Word32, Word64) import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Marshal.Array (peekArray) import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as I import qualified Data.Vector.Unboxed.Mutable as M import System.CPUTime (cpuTimePrecision, getCPUTime) import System.IO (IOMode(..), hGetBuf, hPutStrLn, stderr, withBinaryFile) import System.IO.Unsafe (unsafePerformIO) import qualified Control.Exception as E -- | The class of types for which we can generate uniformly -- distributed random variates. -- -- The uniform PRNG uses Marsaglia's MWC256 (also known as MWC8222) -- multiply-with-carry generator, which has a period of 2^8222 and -- fares well in tests of randomness. It is also extremely fast, -- between 2 and 3 times faster than the Mersenne Twister. -- -- /Note/: Marsaglia's PRNG is not known to be cryptographically -- secure, so you should not use it for cryptographic operations. class Variate a where -- | Generate a single uniformly distributed random variate. The -- range of values produced varies by type: -- -- * For fixed-width integral types, the type's entire range is -- used. -- -- * For floating point numbers, the range (0,1] is used. Zero is -- explicitly excluded, to allow variates to be used in -- statistical calculations that require non-zero values -- (e.g. uses of the 'log' function). -- -- To generate a 'Float' variate with a range of [0,1), subtract -- 2**(-33). To do the same with 'Double' variates, subtract -- 2**(-53). uniform :: (PrimMonad m) => Gen (PrimState m) -> m a -- | Generate single uniformly distributed random variable in a -- given range. -- -- * For integral types inclusive range is used. -- -- * For floating point numbers range (a,b] is used if one ignores -- rounding errors. uniformR :: (PrimMonad m) => (a,a) -> Gen (PrimState m) -> m a instance Variate Int8 where uniform = uniform1 fromIntegral uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Int16 where uniform = uniform1 fromIntegral uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Int32 where uniform = uniform1 fromIntegral uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Int64 where uniform = uniform2 wordsTo64Bit uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Word8 where uniform = uniform1 fromIntegral uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Word16 where uniform = uniform1 fromIntegral uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Word32 where uniform = uniform1 fromIntegral uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Word64 where uniform = uniform2 wordsTo64Bit uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Bool where uniform = uniform1 wordToBool uniformR (False,True) g = uniform g uniformR (False,False) _ = return False uniformR (True,True) _ = return True uniformR (True,False) g = uniform g {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Float where uniform = uniform1 wordToFloat uniformR (x1,x2) = uniform1 (\w -> x1 + (x2-x1) * wordToFloat w) {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Double where uniform = uniform2 wordsToDouble uniformR (x1,x2) = uniform2 (\w1 w2 -> x1 + (x2-x1) * wordsToDouble w1 w2) {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Int where #if WORD_SIZE_IN_BITS < 64 uniform = uniform1 fromIntegral #else uniform = uniform2 wordsTo64Bit #endif uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} instance Variate Word where #if WORD_SIZE_IN_BITS < 64 uniform = uniform1 fromIntegral #else uniform = uniform2 wordsTo64Bit #endif uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} {- instance Variate Integer where uniform g = do u <- uniform g return $! fromIntegral (u :: Int) {-# INLINE uniform #-} -} instance (Variate a, Variate b) => Variate (a,b) where uniform g = (,) `liftM` uniform g `ap` uniform g uniformR ((x1,y1),(x2,y2)) g = (,) `liftM` uniformR (x1,x2) g `ap` uniformR (y1,y2) g {-# INLINE uniform #-} {-# INLINE uniformR #-} instance (Variate a, Variate b, Variate c) => Variate (a,b,c) where uniform g = (,,) `liftM` uniform g `ap` uniform g `ap` uniform g uniformR ((x1,y1,z1),(x2,y2,z2)) g = (,,) `liftM` uniformR (x1,x2) g `ap` uniformR (y1,y2) g `ap` uniformR (z1,z2) g {-# INLINE uniform #-} {-# INLINE uniformR #-} instance (Variate a, Variate b, Variate c, Variate d) => Variate (a,b,c,d) where uniform g = (,,,) `liftM` uniform g `ap` uniform g `ap` uniform g `ap` uniform g uniformR ((x1,y1,z1,t1),(x2,y2,z2,t2)) g = (,,,) `liftM` uniformR (x1,x2) g `ap` uniformR (y1,y2) g `ap` uniformR (z1,z2) g `ap` uniformR (t1,t2) g {-# INLINE uniform #-} {-# INLINE uniformR #-} wordsTo64Bit :: (Integral a) => Word32 -> Word32 -> a wordsTo64Bit x y = fromIntegral ((fromIntegral x `shiftL` 32) .|. fromIntegral y :: Word64) {-# INLINE wordsTo64Bit #-} wordToBool :: Word32 -> Bool wordToBool i = (i .&. 1) /= 0 {-# INLINE wordToBool #-} wordToFloat :: Word32 -> Float wordToFloat x = (fromIntegral i * m_inv_32) + 0.5 + m_inv_33 where m_inv_33 = 1.16415321826934814453125e-10 m_inv_32 = 2.3283064365386962890625e-10 i = fromIntegral x :: Int32 {-# INLINE wordToFloat #-} wordsToDouble :: Word32 -> Word32 -> Double wordsToDouble x y = (fromIntegral u * m_inv_32 + (0.5 + m_inv_53) + fromIntegral (v .&. 0xFFFFF) * m_inv_52) where m_inv_52 = 2.220446049250313080847263336181640625e-16 m_inv_53 = 1.1102230246251565404236316680908203125e-16 m_inv_32 = 2.3283064365386962890625e-10 u = fromIntegral x :: Int32 v = fromIntegral y :: Int32 {-# INLINE wordsToDouble #-} -- | State of the pseudo-random number generator. newtype Gen s = Gen (M.MVector s Word32) -- | A shorter name for PRNG state in the 'IO' monad. type GenIO = Gen (PrimState IO) -- | A shorter name for PRNG state in the 'ST' monad. type GenST s = Gen (PrimState (ST s)) -- | Constrain the type of an action to run in the 'IO' monad. asGenIO :: (GenIO -> IO a) -> (GenIO -> IO a) asGenIO = id -- | Constrain the type of an action to run in the 'ST' monad. asGenST :: (GenST s -> ST s a) -> (GenST s -> ST s a) asGenST = id ioff, coff :: Int ioff = 256 coff = 257 -- | Create a generator for variates using a fixed seed. create :: PrimMonad m => m (Gen (PrimState m)) create = initialize defaultSeed {-# INLINE create #-} -- | Create a generator for variates using the given seed, of which up -- to 256 elements will be used. For arrays of less than 256 -- elements, part of the default seed will be used to finish -- initializing the generator's state. -- -- Examples: -- -- > initialize (singleton 42) -- -- > initialize (fromList [4, 8, 15, 16, 23, 42]) -- -- If a seed contains fewer than 256 elements, it is first used -- verbatim, then its elements are 'xor'ed against elements of the -- default seed until 256 elements are reached. -- -- If a seed contains exactly 258 elements, then the last two elements -- are used to set the generator's initial state. This allows for -- complete generator reproducibility, so that e.g. @gen' == gen@ in -- the following example: -- -- @gen' <- 'initialize' . 'fromSeed' =<< 'save'@ initialize :: (PrimMonad m, Vector v Word32) => v Word32 -> m (Gen (PrimState m)) initialize seed = do q <- M.unsafeNew 258 fill q if fini == 258 then do M.unsafeWrite q ioff $ G.unsafeIndex seed ioff .&. 255 M.unsafeWrite q coff $ G.unsafeIndex seed coff else do M.unsafeWrite q ioff 255 M.unsafeWrite q coff 362436 return (Gen q) where fill q = go 0 where go i | i == 256 = return () | otherwise = M.unsafeWrite q i s >> go (i+1) where s | i >= fini = if fini == 0 then G.unsafeIndex defaultSeed i else G.unsafeIndex defaultSeed i `xor` G.unsafeIndex seed (i `mod` fini) | otherwise = G.unsafeIndex seed i fini = G.length seed {-# INLINE initialize #-} -- | An immutable snapshot of the state of a 'Gen'. newtype Seed = Seed { -- | Convert seed into vector. fromSeed :: I.Vector Word32 } deriving (Eq, Show, Typeable) -- | Convert vector to 'Seed'. It acts similarily to 'initialize' and -- will accept any vector. If you want to pass seed immediately to -- restore you better call initialize directly since following law holds: -- -- > restore (toSeed v) = initialize v toSeed :: (Vector v Word32) => v Word32 -> Seed toSeed v = Seed $ I.create $ do { Gen q <- initialize v; return q } -- | Save the state of a 'Gen', for later use by 'restore'. save :: PrimMonad m => Gen (PrimState m) -> m Seed save (Gen q) = Seed `liftM` G.freeze q {-# INLINE save #-} -- | Create a new 'Gen' that mirrors the state of a saved 'Seed'. restore :: PrimMonad m => Seed -> m (Gen (PrimState m)) restore (Seed s) = Gen `liftM` G.thaw s {-# INLINE restore #-} -- Aquire seed from current time. This is horrible fallback for -- Windows system. acquireSeedTime :: IO [Word32] acquireSeedTime = do c <- (numerator . (%cpuTimePrecision)) `liftM` getCPUTime t <- toRational `liftM` getPOSIXTime let n = fromIntegral (numerator t) :: Word64 return [fromIntegral c, fromIntegral n, fromIntegral (n `shiftR` 32)] -- | Acquire seed from /dev/urandom acquireSeedSystem :: IO [Word32] acquireSeedSystem = do let nbytes = 1024 random = "/dev/urandom" allocaBytes nbytes $ \buf -> do nread <- withBinaryFile random ReadMode $ \h -> hGetBuf h buf nbytes peekArray (nread `div` 4) buf -- | Seed a PRNG with data from the system's fast source of -- pseudo-random numbers (\"@\/dev\/urandom@\" on Unix-like systems), -- then run the given action. -- -- This is a somewhat expensive function, and is intended to be called -- only occasionally (e.g. once per thread). You should use the `Gen` -- it creates to generate many random numbers. -- -- /Note/: on Windows, this code does not yet use the native -- Cryptographic API as a source of random numbers (it uses the system -- clock instead). As a result, the sequences it generates may not be -- highly independent. withSystemRandom :: #if MIN_VERSION_primitive(0,6,0) PrimBase m #else PrimMonad m #endif => (Gen (PrimState m) -> m a) -> IO a withSystemRandom act = do seed <- acquireSeedSystem `E.catch` \(_::E.IOException) -> do seen <- atomicModifyIORef warned ((,) True) unless seen $ E.handle (\(_::E.IOException) -> return ()) $ do hPutStrLn stderr ("Warning: Couldn't open /dev/urandom") hPutStrLn stderr ("Warning: using system clock for seed instead " ++ "(quality will be lower)") acquireSeedTime unsafePrimToIO $ initialize (I.fromList seed) >>= act where warned = unsafePerformIO $ newIORef False {-# NOINLINE warned #-} -- | Seed a PRNG with data from the system's fast source of pseudo-random -- numbers. All the caveats of 'withSystemRandom' apply here as well. createSystemRandom :: IO GenIO createSystemRandom = withSystemRandom (return :: GenIO -> IO GenIO) -- | Compute the next index into the state pool. This is simply -- addition modulo 256. nextIndex :: Integral a => a -> Int nextIndex i = fromIntegral j where j = fromIntegral (i+1) :: Word8 {-# INLINE nextIndex #-} aa :: Word64 aa = 1540315826 {-# INLINE aa #-} uniformWord32 :: PrimMonad m => Gen (PrimState m) -> m Word32 uniformWord32 (Gen q) = do i <- nextIndex `liftM` M.unsafeRead q ioff c <- fromIntegral `liftM` M.unsafeRead q coff qi <- fromIntegral `liftM` M.unsafeRead q i let t = aa * qi + c c' = fromIntegral (t `shiftR` 32) x = fromIntegral t + c' (# x', c'' #) | x < c' = (# x + 1, c' + 1 #) | otherwise = (# x, c' #) M.unsafeWrite q i x' M.unsafeWrite q ioff (fromIntegral i) M.unsafeWrite q coff (fromIntegral c'') return x' {-# INLINE uniformWord32 #-} uniform1 :: PrimMonad m => (Word32 -> a) -> Gen (PrimState m) -> m a uniform1 f gen = do i <- uniformWord32 gen return $! f i {-# INLINE uniform1 #-} uniform2 :: PrimMonad m => (Word32 -> Word32 -> a) -> Gen (PrimState m) -> m a uniform2 f (Gen q) = do i <- nextIndex `liftM` M.unsafeRead q ioff let j = nextIndex i c <- fromIntegral `liftM` M.unsafeRead q coff qi <- fromIntegral `liftM` M.unsafeRead q i qj <- fromIntegral `liftM` M.unsafeRead q j let t = aa * qi + c c' = fromIntegral (t `shiftR` 32) x = fromIntegral t + c' (# x', c'' #) | x < c' = (# x + 1, c' + 1 #) | otherwise = (# x, c' #) u = aa * qj + fromIntegral c'' d' = fromIntegral (u `shiftR` 32) y = fromIntegral u + d' (# y', d'' #) | y < d' = (# y + 1, d' + 1 #) | otherwise = (# y, d' #) M.unsafeWrite q i x' M.unsafeWrite q j y' M.unsafeWrite q ioff (fromIntegral j) M.unsafeWrite q coff (fromIntegral d'') return $! f x' y' {-# INLINE uniform2 #-} -- Type family for fixed size integrals. For signed data types it's -- its unsigned couterpart with same size and for unsigned data types -- it's same type type family Unsigned a :: * type instance Unsigned Int8 = Word8 type instance Unsigned Int16 = Word16 type instance Unsigned Int32 = Word32 type instance Unsigned Int64 = Word64 type instance Unsigned Word8 = Word8 type instance Unsigned Word16 = Word16 type instance Unsigned Word32 = Word32 type instance Unsigned Word64 = Word64 -- This is workaround for bug #25. -- -- GHC-7.6 has a bug (#8072) which results in calculation of wrong -- number of buckets in function `uniformRange'. Consequently uniformR -- generates values in wrong range. -- -- Bug only affects 32-bit systems and Int/Word data types. Word32 -- works just fine. So we set Word32 as unsigned counterpart for Int -- and Word on 32-bit systems. It's done only for GHC-7.6 because -- other versions are unaffected by the bug and we expect that GHC may -- optimise code which uses Word better. #if (WORD_SIZE_IN_BITS < 64) && (__GLASGOW_HASKELL__ == 706) type instance Unsigned Int = Word32 type instance Unsigned Word = Word32 #else type instance Unsigned Int = Word type instance Unsigned Word = Word #endif -- Subtract two numbers under assumption that x>=y and store result in -- unsigned data type of same size sub :: (Integral a, Integral (Unsigned a)) => a -> a -> Unsigned a sub x y = fromIntegral x - fromIntegral y {-# INLINE sub #-} add :: (Integral a, Integral (Unsigned a)) => a -> Unsigned a -> a add m x = m + fromIntegral x {-# INLINE add #-} -- Generate uniformly distributed value in inclusive range. -- -- NOTE: This function must be fully applied. Otherwise it won't be -- inlined, which will cause a severe performance loss. -- -- > uniformR = uniformRange -- won't be inlined -- > uniformR a b = uniformRange a b -- will be inlined uniformRange :: ( PrimMonad m , Integral a, Bounded a, Variate a , Integral (Unsigned a), Bounded (Unsigned a), Variate (Unsigned a)) => (a,a) -> Gen (PrimState m) -> m a uniformRange (x1,x2) g | n == 0 = uniform g -- Abuse overflow in unsigned types | otherwise = loop where -- Allow ranges where x2 Gen (PrimState m) -> Int -> m (v a) uniformVector gen n = G.replicateM n (uniform gen) {-# INLINE uniformVector #-} defaultSeed :: I.Vector Word32 defaultSeed = I.fromList [ 0x7042e8b3, 0x06f7f4c5, 0x789ea382, 0x6fb15ad8, 0x54f7a879, 0x0474b184, 0xb3f8f692, 0x4114ea35, 0xb6af0230, 0xebb457d2, 0x47693630, 0x15bc0433, 0x2e1e5b18, 0xbe91129c, 0xcc0815a0, 0xb1260436, 0xd6f605b1, 0xeaadd777, 0x8f59f791, 0xe7149ed9, 0x72d49dd5, 0xd68d9ded, 0xe2a13153, 0x67648eab, 0x48d6a1a1, 0xa69ab6d7, 0x236f34ec, 0x4e717a21, 0x9d07553d, 0x6683a701, 0x19004315, 0x7b6429c5, 0x84964f99, 0x982eb292, 0x3a8be83e, 0xc1df1845, 0x3cf7b527, 0xb66a7d3f, 0xf93f6838, 0x736b1c85, 0x5f0825c1, 0x37e9904b, 0x724cd7b3, 0xfdcb7a46, 0xfdd39f52, 0x715506d5, 0xbd1b6637, 0xadabc0c0, 0x219037fc, 0x9d71b317, 0x3bec717b, 0xd4501d20, 0xd95ea1c9, 0xbe717202, 0xa254bd61, 0xd78a6c5b, 0x043a5b16, 0x0f447a25, 0xf4862a00, 0x48a48b75, 0x1e580143, 0xd5b6a11b, 0x6fb5b0a4, 0x5aaf27f9, 0x668bcd0e, 0x3fdf18fd, 0x8fdcec4a, 0x5255ce87, 0xa1b24dbf, 0x3ee4c2e1, 0x9087eea2, 0xa4131b26, 0x694531a5, 0xa143d867, 0xd9f77c03, 0xf0085918, 0x1e85071c, 0x164d1aba, 0xe61abab5, 0xb8b0c124, 0x84899697, 0xea022359, 0x0cc7fa0c, 0xd6499adf, 0x746da638, 0xd9e5d200, 0xefb3360b, 0x9426716a, 0xabddf8c2, 0xdd1ed9e4, 0x17e1d567, 0xa9a65000, 0x2f37dbc5, 0x9a4b8fd5, 0xaeb22492, 0x0ebe8845, 0xd89dd090, 0xcfbb88c6, 0xb1325561, 0x6d811d90, 0x03aa86f4, 0xbddba397, 0x0986b9ed, 0x6f4cfc69, 0xc02b43bc, 0xee916274, 0xde7d9659, 0x7d3afd93, 0xf52a7095, 0xf21a009c, 0xfd3f795e, 0x98cef25b, 0x6cb3af61, 0x6fa0e310, 0x0196d036, 0xbc198bca, 0x15b0412d, 0xde454349, 0x5719472b, 0x8244ebce, 0xee61afc6, 0xa60c9cb5, 0x1f4d1fd0, 0xe4fb3059, 0xab9ec0f9, 0x8d8b0255, 0x4e7430bf, 0x3a22aa6b, 0x27de22d3, 0x60c4b6e6, 0x0cf61eb3, 0x469a87df, 0xa4da1388, 0xf650f6aa, 0x3db87d68, 0xcdb6964c, 0xb2649b6c, 0x6a880fa9, 0x1b0c845b, 0xe0af2f28, 0xfc1d5da9, 0xf64878a6, 0x667ca525, 0x2114b1ce, 0x2d119ae3, 0x8d29d3bf, 0x1a1b4922, 0x3132980e, 0xd59e4385, 0x4dbd49b8, 0x2de0bb05, 0xd6c96598, 0xb4c527c3, 0xb5562afc, 0x61eeb602, 0x05aa192a, 0x7d127e77, 0xc719222d, 0xde7cf8db, 0x2de439b8, 0x250b5f1a, 0xd7b21053, 0xef6c14a1, 0x2041f80f, 0xc287332e, 0xbb1dbfd3, 0x783bb979, 0x9a2e6327, 0x6eb03027, 0x0225fa2f, 0xa319bc89, 0x864112d4, 0xfe990445, 0xe5e2e07c, 0xf7c6acb8, 0x1bc92142, 0x12e9b40e, 0x2979282d, 0x05278e70, 0xe160ba4c, 0xc1de0909, 0x458b9bf4, 0xbfce9c94, 0xa276f72a, 0x8441597d, 0x67adc2da, 0x6162b854, 0x7f9b2f4a, 0x0d995b6b, 0x193b643d, 0x399362b3, 0x8b653a4b, 0x1028d2db, 0x2b3df842, 0x6eecafaf, 0x261667e9, 0x9c7e8cda, 0x46063eab, 0x7ce7a3a1, 0xadc899c9, 0x017291c4, 0x528d1a93, 0x9a1ee498, 0xbb7d4d43, 0x7837f0ed, 0x34a230cc, 0x614a628d, 0xb03f93b8, 0xd72e3b08, 0x604c98db, 0x3cfacb79, 0x8b81646a, 0xc0f082fa, 0xd1f92388, 0xe5a91e39, 0xf95c756d, 0x1177742f, 0xf8819323, 0x5c060b80, 0x96c1cd8f, 0x47d7b440, 0xbbb84197, 0x35f749cc, 0x95b0e132, 0x8d90ad54, 0x5c3f9423, 0x4994005b, 0xb58f53b9, 0x32df7348, 0x60f61c29, 0x9eae2f32, 0x85a3d398, 0x3b995dd4, 0x94c5e460, 0x8e54b9f3, 0x87bc6e2a, 0x90bbf1ea, 0x55d44719, 0x2cbbfe6e, 0x439d82f0, 0x4eb3782d, 0xc3f1e669, 0x61ff8d9e, 0x0909238d, 0xef406165, 0x09c1d762, 0x705d184f, 0x188f2cc4, 0x9c5aa12a, 0xc7a5d70e, 0xbc78cb1b, 0x1d26ae62, 0x23f96ae3, 0xd456bf32, 0xe4654f55, 0x31462bd8 ] {-# NOINLINE defaultSeed #-} -- $references -- -- * Marsaglia, G. (2003) Seeds for random number generators. -- /Communications of the ACM/ 46(5):90–93. -- -- -- * Doornik, J.A. (2007) Conversion of high-period random numbers to -- floating point. -- /ACM Transactions on Modeling and Computer Simulation/ 17(1). -- -- $typehelp -- -- The functions in this package are deliberately written for -- flexibility, and will run in both the 'IO' and 'ST' monads. -- -- This can defeat the compiler's ability to infer a principal type in -- simple (and common) cases. For instance, we would like the -- following to work cleanly: -- -- > import System.Random.MWC -- > import Data.Vector.Unboxed -- > -- > main = do -- > v <- withSystemRandom $ \gen -> uniformVector gen 20 -- > print (v :: Vector Int) -- -- Unfortunately, the compiler cannot tell what monad 'uniformVector' -- should execute in. The \"fix\" of adding explicit type annotations -- is not pretty: -- -- > {-# LANGUAGE ScopedTypeVariables #-} -- > -- > import Control.Monad.ST -- > -- > main = do -- > vs <- withSystemRandom $ -- > \(gen::GenST s) -> uniformVector gen 20 :: ST s (Vector Int) -- > print vs -- -- As a more readable alternative, this library provides 'asGenST' and -- 'asGenIO' to constrain the types appropriately. We can get rid of -- the explicit type annotations as follows: -- -- > main = do -- > vs <- withSystemRandom . asGenST $ \gen -> uniformVector gen 20 -- > print (vs :: Vector Int) -- -- This is almost as compact as the original code that the compiler -- rejected. mwc-random-0.13.3.2/System/Random/MWC/0000755000000000000000000000000012506066656015336 5ustar0000000000000000mwc-random-0.13.3.2/System/Random/MWC/Distributions.hs0000644000000000000000000002662112506066656020543 0ustar0000000000000000{-# LANGUAGE BangPatterns, GADTs, FlexibleContexts, ScopedTypeVariables #-} -- | -- Module : System.Random.MWC.Distributions -- Copyright : (c) 2012 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Pseudo-random number generation for non-uniform distributions. module System.Random.MWC.Distributions ( -- * Variates: non-uniformly distributed values -- ** Continuous distributions normal , standard , exponential , truncatedExp , gamma , chiSquare , beta -- ** Discrete distribution , categorical , geometric0 , geometric1 , bernoulli -- ** Multivariate , dirichlet -- * Permutations , uniformPermutation , uniformShuffle , uniformShuffleM -- * References -- $references ) where import Prelude hiding (mapM) import Control.Monad (liftM) import Control.Monad.Primitive (PrimMonad, PrimState) import Data.Bits ((.&.)) import Data.Foldable (foldl') import Data.Traversable (Traversable,mapM) import Data.Word (Word32) import System.Random.MWC (Gen, uniform, uniformR) import qualified Data.Vector.Unboxed as I import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M -- Unboxed 2-tuple data T = T {-# UNPACK #-} !Double {-# UNPACK #-} !Double -- | Generate a normally distributed random variate with given mean -- and standard deviation. normal :: PrimMonad m => Double -- ^ Mean -> Double -- ^ Standard deviation -> Gen (PrimState m) -> m Double {-# INLINE normal #-} -- We express standard in terms of normal and not other way round -- because of bug in GHC. See bug #16 for more details. normal m s gen = do x <- standard gen return $! m + s * x -- | Generate a normally distributed random variate with zero mean and -- unit variance. -- -- The implementation uses Doornik's modified ziggurat algorithm. -- Compared to the ziggurat algorithm usually used, this is slower, -- but generates more independent variates that pass stringent tests -- of randomness. standard :: PrimMonad m => Gen (PrimState m) -> m Double {-# INLINE standard #-} standard gen = loop where loop = do u <- (subtract 1 . (*2)) `liftM` uniform gen ri <- uniform gen let i = fromIntegral ((ri :: Word32) .&. 127) bi = I.unsafeIndex blocks i bj = I.unsafeIndex blocks (i+1) case () of _| abs u < I.unsafeIndex ratios i -> return $! u * bi | i == 0 -> normalTail (u < 0) | otherwise -> do let x = u * bi xx = x * x d = exp (-0.5 * (bi * bi - xx)) e = exp (-0.5 * (bj * bj - xx)) c <- uniform gen if e + c * (d - e) < 1 then return x else loop normalTail neg = tailing where tailing = do x <- ((/rNorm) . log) `liftM` uniform gen y <- log `liftM` uniform gen if y * (-2) < x * x then tailing else return $! if neg then x - rNorm else rNorm - x -- Constants used by standard/normal. They are floated to the top -- level to avoid performance regression (Bug #16) when blocks/ratios -- are recalculated on each call to standard/normal. It's also -- somewhat difficult to trigger reliably. blocks :: I.Vector Double blocks = (`I.snoc` 0) . I.cons (v/f) . I.cons rNorm . I.unfoldrN 126 go $! T rNorm f where go (T b g) = let !u = T h (exp (-0.5 * h * h)) h = sqrt (-2 * log (v / b + g)) in Just (h, u) v = 9.91256303526217e-3 f = exp (-0.5 * rNorm * rNorm) {-# NOINLINE blocks #-} rNorm :: Double rNorm = 3.442619855899 ratios :: I.Vector Double ratios = I.zipWith (/) (I.tail blocks) blocks {-# NOINLINE ratios #-} -- | Generate an exponentially distributed random variate. exponential :: PrimMonad m => Double -- ^ Scale parameter -> Gen (PrimState m) -- ^ Generator -> m Double {-# INLINE exponential #-} exponential b gen = do x <- uniform gen return $! - log x / b -- | Generate truncated exponentially distributed random variate. truncatedExp :: PrimMonad m => Double -- ^ Scale parameter -> (Double,Double) -- ^ Range to which distribution is -- truncated. Values may be negative. -> Gen (PrimState m) -- ^ Generator. -> m Double {-# INLINE truncatedExp #-} truncatedExp scale (a,b) gen = do -- We shift a to 0 and then generate distribution truncated to [0,b-a] -- It's easier let delta = b - a p <- uniform gen return $! a - log ( (1 - p) + p*exp(-scale*delta)) / scale -- | Random variate generator for gamma distribution. gamma :: PrimMonad m => Double -- ^ Shape parameter -> Double -- ^ Scale parameter -> Gen (PrimState m) -- ^ Generator -> m Double {-# INLINE gamma #-} gamma a b gen | a <= 0 = pkgError "gamma" "negative alpha parameter" | otherwise = mainloop where mainloop = do T x v <- innerloop u <- uniform gen let cont = u > 1 - 0.331 * sqr (sqr x) && log u > 0.5 * sqr x + a1 * (1 - v + log v) -- Rarely evaluated case () of _| cont -> mainloop | a >= 1 -> return $! a1 * v * b | otherwise -> do y <- uniform gen return $! y ** (1 / a) * a1 * v * b -- inner loop innerloop = do x <- standard gen case 1 + a2*x of v | v <= 0 -> innerloop | otherwise -> return $! T x (v*v*v) -- constants a' = if a < 1 then a + 1 else a a1 = a' - 1/3 a2 = 1 / sqrt(9 * a1) -- | Random variate generator for the chi square distribution. chiSquare :: PrimMonad m => Int -- ^ Number of degrees of freedom -> Gen (PrimState m) -- ^ Generator -> m Double {-# INLINE chiSquare #-} chiSquare n gen | n <= 0 = pkgError "chiSquare" "number of degrees of freedom must be positive" | otherwise = do x <- gamma (0.5 * fromIntegral n) 1 gen return $! 2 * x -- | Random variate generator for the geometric distribution, -- computing the number of failures before success. Distribution's -- support is [0..]. geometric0 :: PrimMonad m => Double -- ^ /p/ success probability lies in (0,1] -> Gen (PrimState m) -- ^ Generator -> m Int {-# INLINE geometric0 #-} geometric0 p gen | p == 1 = return 0 | p > 0 && p < 1 = do q <- uniform gen -- FIXME: We want to use log1p here but it will -- introduce dependency on math-functions. return $! floor $ log q / log (1 - p) | otherwise = pkgError "geometric0" "probability out of [0,1] range" -- | Random variate generator for geometric distribution for number of -- trials. Distribution's support is [1..] (i.e. just 'geometric0' -- shifted by 1). geometric1 :: PrimMonad m => Double -- ^ /p/ success probability lies in (0,1] -> Gen (PrimState m) -- ^ Generator -> m Int {-# INLINE geometric1 #-} geometric1 p gen = do n <- geometric0 p gen return $! n + 1 -- | Random variate generator for Beta distribution beta :: PrimMonad m => Double -- ^ alpha (>0) -> Double -- ^ beta (>0) -> Gen (PrimState m) -- ^ Generator -> m Double {-# INLINE beta #-} beta a b gen = do x <- gamma a 1 gen y <- gamma b 1 gen return $! x / (x+y) -- | Random variate generator for Dirichlet distribution dirichlet :: (PrimMonad m, Traversable t) => t Double -- ^ container of parameters -> Gen (PrimState m) -- ^ Generator -> m (t Double) {-# INLINE dirichlet #-} dirichlet t gen = do t' <- mapM (\x -> gamma x 1 gen) t let total = foldl' (+) 0 t' return $ fmap (/total) t' -- | Random variate generator for Bernoulli distribution bernoulli :: PrimMonad m => Double -- ^ Probability of success (returning True) -> Gen (PrimState m) -- ^ Generator -> m Bool {-# INLINE bernoulli #-} bernoulli p gen = ( v Double -- ^ List of weights [>0] -> Gen (PrimState m) -- ^ Generator -> m Int {-# INLINE categorical #-} categorical v gen | G.null v = pkgError "categorical" "empty weights!" | otherwise = do let cv = G.scanl1' (+) v p <- (G.last cv *) `liftM` uniform gen return $! case G.findIndex (>=p) cv of Just i -> i Nothing -> pkgError "categorical" "bad weights!" -- | Random variate generator for uniformly distributed permutations. -- It returns random permutation of vector /[0 .. n-1]/. -- -- This is the Fisher-Yates shuffle uniformPermutation :: forall m v. (PrimMonad m, G.Vector v Int) => Int -> Gen (PrimState m) -> m (v Int) {-# INLINE uniformPermutation #-} uniformPermutation n gen | n < 0 = pkgError "uniformPermutation" "size must be >=0" | otherwise = uniformShuffle (G.generate n id :: v Int) gen -- | Random variate generator for a uniformly distributed shuffle (all -- shuffles are equiprobable) of a vector. It uses Fisher-Yates -- shuffle algorithm. uniformShuffle :: (PrimMonad m, G.Vector v a) => v a -> Gen (PrimState m) -> m (v a) {-# INLINE uniformShuffle #-} uniformShuffle vec gen | G.length vec <= 1 = return vec | otherwise = do mvec <- G.thaw vec uniformShuffleM mvec gen G.unsafeFreeze mvec -- | In-place uniformly distributed shuffle (all shuffles are -- equiprobable)of a vector. uniformShuffleM :: (PrimMonad m, M.MVector v a) => v (PrimState m) a -> Gen (PrimState m) -> m () {-# INLINE uniformShuffleM #-} uniformShuffleM vec gen | M.length vec <= 1 = return () | otherwise = loop 0 where n = M.length vec lst = n-1 loop i | i == lst = return () | otherwise = do j <- uniformR (i,lst) gen M.unsafeSwap vec i j loop (i+1) sqr :: Double -> Double sqr x = x * x {-# INLINE sqr #-} pkgError :: String -> String -> a pkgError func msg = error $ "System.Random.MWC.Distributions." ++ func ++ ": " ++ msg -- $references -- -- * Doornik, J.A. (2005) An improved ziggurat method to generate -- normal random samples. Mimeo, Nuffield College, University of -- Oxford. -- -- * Thomas, D.B.; Leong, P.G.W.; Luk, W.; Villasenor, J.D. -- (2007). Gaussian random number generators. -- /ACM Computing Surveys/ 39(4). -- mwc-random-0.13.3.2/System/Random/MWC/CondensedTable.hs0000644000000000000000000002426712506066656020557 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} -- | -- Module : System.Random.MWC.CondensedTable -- Copyright : (c) 2012 Aleksey Khudyakov -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Table-driven generation of random variates. This approach can -- generate random variates in /O(1)/ time for the supported -- distributions, at a modest cost in initialization time. module System.Random.MWC.CondensedTable ( -- * Condensed tables CondensedTable , CondensedTableV , CondensedTableU , genFromTable -- * Constructors for tables , tableFromProbabilities , tableFromWeights , tableFromIntWeights -- ** Disrete distributions , tablePoisson , tableBinomial -- * References -- $references ) where import Control.Arrow (second,(***)) import Control.Monad.Primitive (PrimMonad(..)) import Data.Word import Data.Int import Data.Bits import qualified Data.Vector.Generic as G import Data.Vector.Generic ((++)) import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Unboxed as U import qualified Data.Vector as V import Data.Vector.Generic (Vector) import Prelude hiding ((++)) import System.Random.MWC -- | A lookup table for arbitrary discrete distributions. It allows -- the generation of random variates in /O(1)/. Note that probability -- is quantized in units of @1/2^32@, and all distributions with -- infinite support (e.g. Poisson) should be truncated. data CondensedTable v a = CondensedTable {-# UNPACK #-} !Word64 !(v a) -- Lookup limit and first table {-# UNPACK #-} !Word64 !(v a) -- Second table {-# UNPACK #-} !Word64 !(v a) -- Third table !(v a) -- Last table -- Implementation note. We have to store lookup limit in Word64 since -- we need to accomodate two cases. First is when we have no values in -- lookup table, second is when all elements are there -- -- Both are pretty easy to realize. For first one probability of every -- outcome should be less then 1/256, latter arise when probabilities -- of two outcomes are [0.5,0.5] -- | A 'CondensedTable' that uses unboxed vectors. type CondensedTableU = CondensedTable U.Vector -- | A 'CondensedTable' that uses boxed vectors, and is able to hold -- any type of element. type CondensedTableV = CondensedTable V.Vector -- | Generate a random value using a condensed table. genFromTable :: (PrimMonad m, Vector v a) => CondensedTable v a -> Gen (PrimState m) -> m a {-# INLINE genFromTable #-} genFromTable table gen = do w <- uniform gen return $ lookupTable table $ fromIntegral (w :: Word32) lookupTable :: Vector v a => CondensedTable v a -> Word64 -> a {-# INLINE lookupTable #-} lookupTable (CondensedTable na aa nb bb nc cc dd) i | i < na = aa `at` ( i `shiftR` 24) | i < nb = bb `at` ((i - na) `shiftR` 16) | i < nc = cc `at` ((i - nb) `shiftR` 8 ) | otherwise = dd `at` ( i - nc) where at arr j = G.unsafeIndex arr (fromIntegral j) ---------------------------------------------------------------- -- Table generation ---------------------------------------------------------------- -- | Generate a condensed lookup table from a list of outcomes with -- given probabilities. The vector should be non-empty and the -- probabilites should be non-negative and sum to 1. If this is not -- the case, this algorithm will construct a table for some -- distribution that may bear no resemblance to what you intended. tableFromProbabilities :: (Vector v (a,Word32), Vector v (a,Double), Vector v a, Vector v Word32) => v (a, Double) -> CondensedTable v a {-# INLINE tableFromProbabilities #-} tableFromProbabilities v | G.null tbl = pkgError "tableFromProbabilities" "empty vector of outcomes" | otherwise = tableFromIntWeights $ G.map (second $ toWeight . (* mlt)) tbl where -- 2^32. N.B. This number is exatly representable. mlt = 4.294967296e9 -- Drop non-positive probabilities tbl = G.filter ((> 0) . snd) v -- Convert Double weight to Word32 and avoid overflow at the same -- time. It's especially dangerous if one probability is -- approximately 1 and others are 0. toWeight w | w > mlt - 1 = 2^(32::Int) - 1 | otherwise = round w -- | Same as 'tableFromProbabilities' but treats number as weights not -- probilities. Non-positive weights are discarded, and those -- remaining are normalized to 1. tableFromWeights :: (Vector v (a,Word32), Vector v (a,Double), Vector v a, Vector v Word32) => v (a, Double) -> CondensedTable v a {-# INLINE tableFromWeights #-} tableFromWeights = tableFromProbabilities . normalize . G.filter ((> 0) . snd) where normalize v | G.null v = pkgError "tableFromWeights" "no positive weights" | otherwise = G.map (second (/ s)) v where -- Explicit fold is to avoid 'Vector v Double' constraint s = G.foldl' (flip $ (+) . snd) 0 v -- | Generate a condensed lookup table from integer weights. Weights -- should sum to @2^32@. If they don't, the algorithm will alter the -- weights so that they do. This approach should work reasonably well -- for rounding errors. tableFromIntWeights :: (Vector v (a,Word32), Vector v a, Vector v Word32) => v (a, Word32) -> CondensedTable v a {-# INLINE tableFromIntWeights #-} tableFromIntWeights v | n == 0 = pkgError "tableFromIntWeights" "empty table" -- Single element tables should be treated sepately. Otherwise -- they will confuse correctWeights | n == 1 = let m = 2^(32::Int) - 1 -- Works for both Word32 & Word64 in CondensedTable m (G.replicate 256 $ fst $ G.head tbl) m G.empty m G.empty G.empty | otherwise = CondensedTable na aa nb bb nc cc dd where -- We must filter out zero-probability outcomes because they may -- confuse weight correction algorithm tbl = G.filter ((/=0) . snd) v n = G.length tbl -- Corrected table table = uncurry G.zip $ id *** correctWeights $ G.unzip tbl -- Make condensed table mkTable d = G.concatMap (\(x,w) -> G.replicate (fromIntegral $ digit d w) x) table len = fromIntegral . G.length -- Tables aa = mkTable 0 bb = mkTable 1 cc = mkTable 2 dd = mkTable 3 -- Offsets na = len aa `shiftL` 24 nb = na + (len bb `shiftL` 16) nc = nb + (len cc `shiftL` 8) -- Calculate N'th digit base 256 digit :: Int -> Word32 -> Word32 digit 0 x = x `shiftR` 24 digit 1 x = (x `shiftR` 16) .&. 0xff digit 2 x = (x `shiftR` 8 ) .&. 0xff digit 3 x = x .&. 0xff digit _ _ = pkgError "digit" "the impossible happened!?" {-# INLINE digit #-} -- Correct integer weights so they sum up to 2^32. Array of weight -- should contain at least 2 elements. correctWeights :: G.Vector v Word32 => v Word32 -> v Word32 {-# INLINE correctWeights #-} correctWeights v = G.create $ do let -- Sum of weights s = G.foldl' (flip $ (+) . fromIntegral) 0 v :: Int64 -- Array size n = G.length v arr <- G.thaw v -- On first pass over array adjust only entries which are larger -- than `lim'. On second and subsequent passes `lim' is set to 1. -- -- It's possibly to make this algorithm loop endlessly if all -- weights are 1 or 0. let loop lim i delta | delta == 0 = return () | i >= n = loop 1 0 delta | otherwise = do w <- M.read arr i case () of _| w < lim -> loop lim (i+1) delta | delta < 0 -> M.write arr i (w + 1) >> loop lim (i+1) (delta + 1) | otherwise -> M.write arr i (w - 1) >> loop lim (i+1) (delta - 1) loop 255 0 (s - 2^(32::Int)) return arr -- | Create a lookup table for the Poisson distibution. Note that -- table construction may have significant cost. For λ < 100 it -- takes as much time to build table as generation of 1000-30000 -- variates. tablePoisson :: Double -> CondensedTableU Int tablePoisson = tableFromProbabilities . make where make lam | lam < 0 = pkgError "tablePoisson" "negative lambda" | lam < 22.8 = U.unfoldr unfoldForward (exp (-lam), 0) | otherwise = U.unfoldr unfoldForward (pMax, nMax) ++ U.tail (U.unfoldr unfoldBackward (pMax, nMax)) where -- Number with highest probability and its probability nMax = floor lam :: Int pMax = let c = lam * exp( -lam / fromIntegral nMax ) in U.foldl' (\p i -> p * c / i) 1 (U.enumFromN 1 nMax) -- Build probability list unfoldForward (p,i) | p < minP = Nothing | otherwise = Just ( (i,p) , (p * lam / fromIntegral (i+1), i+1) ) -- Go down unfoldBackward (p,i) | p < minP = Nothing | otherwise = Just ( (i,p) , (p / lam * fromIntegral i, i-1) ) minP = 1.1641532182693481e-10 -- 2**(-33) -- | Create a lookup table for the binomial distribution. tableBinomial :: Int -- ^ Number of tries -> Double -- ^ Probability of success -> CondensedTableU Int tableBinomial n p = tableFromProbabilities makeBinom where makeBinom | n <= 0 = pkgError "tableBinomial" "non-positive number of tries" | p == 0 = U.singleton (0,1) | p == 1 = U.singleton (n,1) | p > 0 && p < 1 = U.unfoldrN (n + 1) unfolder ((1-p)^n, 0) | otherwise = pkgError "tableBinomial" "probability is out of range" where h = p / (1 - p) unfolder (t,i) = Just ( (i,t) , (t * (fromIntegral $ n + 1 - i1) * h / fromIntegral i1, i1) ) where i1 = i + 1 pkgError :: String -> String -> a pkgError func err = error . concat $ ["System.Random.MWC.CondensedTable.", func, ": ", err] -- $references -- -- * Wang, J.; Tsang, W. W.; G. Marsaglia (2004), Fast Generation of -- Discrete Random Variables, /Journal of Statistical Software, -- American Statistical Association/, vol. 11(i03). -- mwc-random-0.13.3.2/benchmarks/0000755000000000000000000000000012506066656014321 5ustar0000000000000000mwc-random-0.13.3.2/benchmarks/Benchmark.hs0000644000000000000000000001073412506066656016554 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} import Control.Exception import Control.Monad import Control.Monad.ST import Criterion.Main import Data.Int import Data.Word import qualified Data.Vector.Unboxed as U import qualified System.Random as R import System.Random.MWC import System.Random.MWC.Distributions import System.Random.MWC.CondensedTable import qualified System.Random.Mersenne as M makeTableUniform :: Int -> CondensedTable U.Vector Int makeTableUniform n = tableFromProbabilities $ U.zip (U.enumFromN 0 n) (U.replicate n (1 / fromIntegral n)) {-# INLINE makeTableUniform #-} main = do mwc <- create mtg <- M.newMTGen . Just =<< uniform mwc defaultMain [ bgroup "mwc" -- One letter group names are used so they will fit on the plot. -- -- U - uniform -- R - uniformR -- D - distribution [ bgroup "U" [ bench "Double" (uniform mwc :: IO Double) , bench "Int" (uniform mwc :: IO Int) , bench "Int8" (uniform mwc :: IO Int8) , bench "Int16" (uniform mwc :: IO Int16) , bench "Int32" (uniform mwc :: IO Int32) , bench "Int64" (uniform mwc :: IO Int64) , bench "Word" (uniform mwc :: IO Word) , bench "Word8" (uniform mwc :: IO Word8) , bench "Word16" (uniform mwc :: IO Word16) , bench "Word32" (uniform mwc :: IO Word32) , bench "Word64" (uniform mwc :: IO Word64) ] , bgroup "R" -- I'm not entirely convinced that this is right way to test -- uniformR. /A.Khudyakov/ [ bench "Double" (uniformR (-3.21,26) mwc :: IO Double) , bench "Int" (uniformR (-12,679) mwc :: IO Int) , bench "Int8" (uniformR (-12,4) mwc :: IO Int8) , bench "Int16" (uniformR (-12,679) mwc :: IO Int16) , bench "Int32" (uniformR (-12,679) mwc :: IO Int32) , bench "Int64" (uniformR (-12,679) mwc :: IO Int64) , bench "Word" (uniformR (34,633) mwc :: IO Word) , bench "Word8" (uniformR (34,63) mwc :: IO Word8) , bench "Word16" (uniformR (34,633) mwc :: IO Word16) , bench "Word32" (uniformR (34,633) mwc :: IO Word32) , bench "Word64" (uniformR (34,633) mwc :: IO Word64) ] , bgroup "D" [ bench "standard" (standard mwc :: IO Double) , bench "normal" (normal 1 3 mwc :: IO Double) -- Regression tests for #16. These functions should take 10x -- longer to execute. -- -- N.B. Bang patterns are necessary to trigger the bug with -- GHC 7.6 , bench "standard/N" (replicateM_ 10 $ do !_ <- standard mwc :: IO Double return () ) , bench "normal/N" (replicateM_ 10 $ do !_ <- normal 1 3 mwc :: IO Double return () ) , bench "exponential" (exponential 3 mwc :: IO Double) , bench "gamma,a<1" (gamma 0.5 1 mwc :: IO Double) , bench "gamma,a>1" (gamma 2 1 mwc :: IO Double) , bench "chiSquare" (chiSquare 4 mwc :: IO Double) ] , bgroup "CT/gen" $ concat [ [ bench ("uniform "++show i) (genFromTable (makeTableUniform i) mwc :: IO Int) | i <- [2..10] ] , [ bench ("poisson " ++ show l) (genFromTable (tablePoisson l) mwc :: IO Int) | l <- [0.01, 0.2, 0.8, 1.3, 2.4, 8, 12, 100, 1000] ] , [ bench ("binomial " ++ show p ++ " " ++ show n) (genFromTable (tableBinomial n p) mwc :: IO Int) | (n,p) <- [ (4, 0.5), (10,0.1), (10,0.6), (10, 0.8), (100,0.4)] ] ] , bgroup "CT/table" $ concat [ [ bench ("uniform " ++ show i) $ whnf makeTableUniform i | i <- [2..30] ] , [ bench ("poisson " ++ show l) $ whnf tablePoisson l | l <- [0.01, 0.2, 0.8, 1.3, 2.4, 8, 12, 100, 1000] ] , [ bench ("binomial " ++ show p ++ " " ++ show n) $ whnf (tableBinomial n) p | (n,p) <- [ (4, 0.5), (10,0.1), (10,0.6), (10, 0.8), (100,0.4)] ] ] ] , bgroup "random" [ bench "Double" (R.randomIO >>= evaluate :: IO Double) , bench "Int" (R.randomIO >>= evaluate :: IO Int) ] , bgroup "mersenne" [ bench "Double" (M.random mtg :: IO Double) , bench "Int" (M.random mtg :: IO Int) ] ] mwc-random-0.13.3.2/benchmarks/tsts.hs0000644000000000000000000000265212506066656015657 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} import Control.Monad import System.Random.MWC import System.Random.MWC.Distributions main = do withSystemRandom $ \g -> replicateM_ (300*1000) $ do -- !n <- normal 0 1 g !n <- normal 0 2 g !n <- normal 3 3 g !n <- normal 2 4 g !n <- normal 2 5 g !n <- normal 1 6 g !n <- normal 3 7 g !n <- normal 3 8 g !n <- normal 3 9 g !n <- normal 3 10 g -- !n <- normal 0 1 g !n <- normal 0 2 g !n <- normal 3 3 g !n <- normal 2 4 g !n <- normal 2 5 g !n <- normal 1 6 g !n <- normal 3 7 g !n <- normal 3 8 g !n <- normal 3 9 g !n <- normal 3 10 g -- !n <- normal 0 1 g !n <- normal 0 2 g !n <- normal 3 3 g !n <- normal 2 4 g !n <- normal 2 5 g !n <- normal 1 6 g !n <- normal 3 7 g !n <- normal 3 8 g !n <- normal 3 9 g !n <- normal 3 10 g -- !n <- normal 0 1 g !n <- normal 0 2 g !n <- normal 3 3 g !n <- normal 2 4 g !n <- normal 2 5 g !n <- normal 1 6 g !n <- normal 3 7 g !n <- normal 3 8 g !n <- normal 3 9 g !n <- normal 3 10 g -- !n <- normal 0 1 g !n <- normal 0 2 g !n <- normal 3 3 g !n <- normal 2 4 g !n <- normal 2 5 g !n <- normal 1 6 g !n <- normal 3 7 g !n <- normal 3 8 g !n <- normal 3 9 g !n <- normal 3 10 g -- return () :: IO () mwc-random-0.13.3.2/benchmarks/Quickie.hs0000644000000000000000000000046712506066656016256 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} import System.Random.MWC (create, uniform) import Control.Monad.ST (ST, runST) u :: ST s Double u = do let last = 1000000 :: Int gen <- create let loop !n !i | n == last = return i | otherwise = uniform gen >>= loop (n+1) loop 0 0 main = print (runST u) mwc-random-0.13.3.2/benchmarks/mwc-random-benchmarks.cabal0000644000000000000000000000061012506066656021461 0ustar0000000000000000name: mwc-random-benchmarks version: 0 synopsis: Benchmarks for the mwc-random package description: Benchmarks for the mwc-random package license: BSD3 license-file: ../LICENSE build-type: Simple cabal-version: >= 1.6 executable bm main-is: Benchmark.hs build-depends: base < 5, criterion, mersenne-random, mwc-random, random