mwc-random-0.13.6.0/0000755000000000000000000000000013100365031012161 5ustar0000000000000000mwc-random-0.13.6.0/changelog.md0000644000000000000000000000255113100365031014435 0ustar0000000000000000## Changes in 0.13.6.0 * `tablePoisson` now can handle λ>1923, see #59 for details. That required intoduction of dependency on math-functions. ## Changes in 0.13.5.0 * `logCategorical` added ## Changes in 0.13.4.0 * `withSystemRandom` uses RtlGenRandom for seeding generator on windows ## Changes 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.6.0/Setup.lhs0000644000000000000000000000011413100365031013765 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain mwc-random-0.13.6.0/README.markdown0000644000000000000000000000132713100365031014665 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.6.0/mwc-random.cabal0000644000000000000000000000447613100365031015224 0ustar0000000000000000name: mwc-random version: 0.13.6.0 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.0.4 extra-source-files: changelog.md 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, math-functions >= 0.2.1.0 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.6.0/LICENSE0000644000000000000000000000245413100365031013173 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.6.0/test/0000755000000000000000000000000013100365031013140 5ustar0000000000000000mwc-random-0.13.6.0/test/KS.hs0000644000000000000000000000433513100365031014016 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.6.0/test/visual.R0000644000000000000000000000577013100365031014577 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.6.0/test/QC.hs0000644000000000000000000000351613100365031014004 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.6.0/test/run-dieharder-test.sh0000644000000000000000000000154213100365031017204 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.6.0/test/visual.hs0000644000000000000000000000344113100365031015001 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.6.0/test/tests.hs0000644000000000000000000000045313100365031014640 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.6.0/System/0000755000000000000000000000000013100365031013445 5ustar0000000000000000mwc-random-0.13.6.0/System/Random/0000755000000000000000000000000013100365031014665 5ustar0000000000000000mwc-random-0.13.6.0/System/Random/MWC.hs0000644000000000000000000006505713100365031015664 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, FlexibleContexts, MagicHash, Rank2Types, ScopedTypeVariables, TypeFamilies, UnboxedTuples, ForeignFunctionInterface #-} -- | -- 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 ((.&.), (.|.), 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 (Word8, Word16, Word32, Word64) #if !MIN_VERSION_base(4,8,0) import Data.Word (Word) #endif 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 #if defined(mingw32_HOST_OS) import Foreign.Ptr import Foreign.C.Types #endif -- | 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. It uses mutable -- state so same generator shouldn't be used from the different -- threads simultaneously. 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 the system entropy source. On Unix machines, -- this will attempt to use @/dev/urandom@. On Windows, it will internally -- use @RtlGenRandom@. acquireSeedSystem :: IO [Word32] acquireSeedSystem = do #if !defined(mingw32_HOST_OS) -- Read 256 random Word32s from /dev/urandom let nbytes = 1024 random = "/dev/urandom" allocaBytes nbytes $ \buf -> do nread <- withBinaryFile random ReadMode $ \h -> hGetBuf h buf nbytes peekArray (nread `div` 4) buf #else let nbytes = 1024 -- Generate 256 random Word32s from RtlGenRandom allocaBytes nbytes $ \buf -> do ok <- c_RtlGenRandom buf (fromIntegral nbytes) if ok then return () else fail "Couldn't use RtlGenRandom" peekArray (nbytes `div` 4) buf -- Note: on 64-bit Windows, the 'stdcall' calling convention -- isn't supported, so we use 'ccall' instead. #if defined(i386_HOST_ARCH) # define WINDOWS_CCONV stdcall #elif defined(x86_64_HOST_ARCH) # define WINDOWS_CCONV ccall #else # error Unknown mingw32 architecture! #endif -- Note: On Windows, the typical convention would be to use -- the CryptoGenRandom API in order to generate random data. -- However, here we use 'SystemFunction036', AKA RtlGenRandom. -- -- This is a commonly used API for this purpose; one bonus is -- that it avoids having to bring in the CryptoAPI library, -- and completely sidesteps the initialization cost of CryptoAPI. -- -- While this function is technically "subject to change" that is -- extremely unlikely in practice: rand_s in the Microsoft CRT uses -- this, and they can't change it easily without also breaking -- backwards compatibility with e.g. statically linked applications. -- -- The name 'SystemFunction036' is the actual link-time name; the -- display name is just for giggles, I guess. -- -- See also: -- - http://blogs.msdn.com/b/michael_howard/archive/2005/01/14/353379.aspx -- - https://bugzilla.mozilla.org/show_bug.cgi?id=504270 -- foreign import WINDOWS_CCONV unsafe "SystemFunction036" c_RtlGenRandom :: Ptr a -> CULong -> IO Bool #endif -- | Seed a PRNG with data from the system's fast source of -- pseudo-random numbers (\"@\/dev\/urandom@\" on Unix-like systems or -- @RtlGenRandom@ on Windows), 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. 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 #if !defined(mingw32_HOST_OS) hPutStrLn stderr ("Warning: Couldn't open /dev/urandom") #else hPutStrLn stderr ("Warning: Couldn't use RtlGenRandom") #endif 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.6.0/System/Random/MWC/0000755000000000000000000000000013100365031015313 5ustar0000000000000000mwc-random-0.13.6.0/System/Random/MWC/Distributions.hs0000644000000000000000000002762613100365031020526 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, 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 , logCategorical , 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') #if !MIN_VERSION_base(4,8,0) import Data.Traversable (Traversable) #endif import Data.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 #-} 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 categorical distribution where the -- weights are in the log domain. It's implemented in terms of -- 'categorical'. logCategorical :: (PrimMonad m, G.Vector v Double) => v Double -- ^ List of logarithms of weights -> Gen (PrimState m) -- ^ Generator -> m Int {-# INLINE logCategorical #-} logCategorical v gen | G.null v = pkgError "logCategorical" "empty weights!" | otherwise = categorical (G.map (exp . subtract m) v) gen where m = G.maximum v -- | 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.6.0/System/Random/MWC/CondensedTable.hs0000644000000000000000000002467713100365031020541 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 Numeric.SpecFunctions (logFactorial) 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@ at least approximately. This function will -- correct small deviations from @2^32@ such as arising from rounding -- errors. But for large deviations it's likely to product incorrect -- result with terrible performance. 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 -- -- FIXME: this is not ideal precision-wise. Check if code -- from statistics gives better precision. nMax = floor lam :: Int pMax = exp $ fromIntegral nMax * log lam - lam - logFactorial 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) ) -- Minimal representable probability for condensed tables 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.6.0/benchmarks/0000755000000000000000000000000013100365031014276 5ustar0000000000000000mwc-random-0.13.6.0/benchmarks/Benchmark.hs0000644000000000000000000001073413100365031016531 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.6.0/benchmarks/Quickie.hs0000644000000000000000000000046713100365031016233 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.6.0/benchmarks/mwc-random-benchmarks.cabal0000644000000000000000000000061013100365031021436 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