mwc-random-0.11.0.0/0000755000000000000000000000000011704126546012167 5ustar0000000000000000mwc-random-0.11.0.0/mwc-random.cabal0000644000000000000000000000434511704126546015225 0ustar0000000000000000name: mwc-random version: 0.11.0.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 extra-source-files: 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 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 Uniform ghc-options: -Wall -threaded -rtsopts build-depends: 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.11.0.0/Setup.lhs0000644000000000000000000000011411704126546013773 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain mwc-random-0.11.0.0/LICENSE0000644000000000000000000000245411704126546013201 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.11.0.0/README.markdown0000644000000000000000000000254211704126546014673 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. # Performance This library has been carefully optimised for high performance. To obtain the best runtime efficiency, it is imperative to compile libraries and applications that use this library using a high level of optimisation. Suggested GHC options: -O -fvia-C -funbox-strict-fields To illustrate, here are the times (in seconds) to generate and sum 250 million random Word32 values, on a laptop with a 2.4GHz Core2 Duo P8600 processor, running Fedora 11 and GHC 6.10.3: no flags 200+ -O 1.249 -O -fvia-C 0.991 As the numbers above suggest, compiling without optimisation will yield unacceptable performance. # 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.11.0.0/benchmarks/0000755000000000000000000000000011704126546014304 5ustar0000000000000000mwc-random-0.11.0.0/benchmarks/Quickie.hs0000644000000000000000000000046711704126546016241 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.11.0.0/benchmarks/Benchmark.hs0000644000000000000000000000514011704126546016532 0ustar0000000000000000import Control.Exception import Control.Monad.ST import Criterion.Main import Data.Int import Data.Word import qualified System.Random as R import System.Random.MWC import System.Random.MWC.Distributions import qualified System.Random.Mersenne as M 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) , 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 "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.11.0.0/benchmarks/mwc-random-benchmarks.cabal0000644000000000000000000000061011704126546021444 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 mwc-random-0.11.0.0/System/0000755000000000000000000000000011704126546013453 5ustar0000000000000000mwc-random-0.11.0.0/System/Random/0000755000000000000000000000000011704126546014673 5ustar0000000000000000mwc-random-0.11.0.0/System/Random/MWC.hs0000644000000000000000000005351011704126546015661 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 (uniformVector 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 -- @ -- -- Keep this generator and use it wherever random values are required. 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 , GenIO , GenST , create , initialize , withSystemRandom -- * 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.Exception (IOException, catch) import Control.Monad (ap, liftM, unless) import Control.Monad.Primitive (PrimMonad, PrimState, unsafePrimToIO) 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 Prelude hiding (catch) 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) -- | 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)) 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 (toList [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)] -- Aquire 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 heavyweight function, 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 :: PrimMonad m => (Gen (PrimState m) -> m a) -> IO a withSystemRandom act = do seed <- acquireSeedSystem `catch` \(_::IOException) -> do seen <- atomicModifyIORef warned ((,) True) unless seen $ 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 #-} -- | 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 Int = Word type instance Unsigned Word8 = Word8 type instance Unsigned Word16 = Word16 type instance Unsigned Word32 = Word32 type instance Unsigned Word64 = Word64 type instance Unsigned Word = Word -- 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. -- -- -- * 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.11.0.0/System/Random/MWC/0000755000000000000000000000000011704126546015321 5ustar0000000000000000mwc-random-0.11.0.0/System/Random/MWC/Distributions.hs0000644000000000000000000001262711704126546020527 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- | -- 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 normal , standard , exponential , gamma , chiSquare -- * References -- $references ) where import Control.Monad (liftM) import Control.Monad.Primitive (PrimMonad, PrimState) import Data.Bits ((.&.)) import Data.Word (Word32) import System.Random.MWC (Gen, uniform) import qualified Data.Vector.Unboxed as I -- 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 blocks = (`I.snoc` 0) . I.cons (v/f) . I.cons r . I.unfoldrN 126 go $! T r 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 * r * r) {-# NOINLINE blocks #-} r = 3.442619855899 ratios = I.zipWith (/) (I.tail blocks) blocks {-# NOINLINE ratios #-} normalTail neg = tailing where tailing = do x <- ((/r) . log) `liftM` uniform gen y <- log `liftM` uniform gen if y * (-2) < x * x then tailing else return $! if neg then x - r else r - x -- | Generate exponentially distributed random variate. exponential :: PrimMonad m => Double -- ^ Scale parameter -> Gen (PrimState m) -- ^ Generator -> m Double {-# INLINE exponential #-} exponential beta gen = do x <- uniform gen return $! - log x / beta -- | 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 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 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. -- -- * Doornik, J.A. (2007) Conversion of high-period random numbers to -- floating point. -- /ACM Transactions on Modeling and Computer Simulation/ 17(1). -- mwc-random-0.11.0.0/test/0000755000000000000000000000000011704126546013146 5ustar0000000000000000mwc-random-0.11.0.0/test/run-dieharder-test.sh0000644000000000000000000000154211704126546017212 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.11.0.0/test/visual.R0000644000000000000000000000320211704126546014571 0ustar0000000000000000# Ugly script for displaying distributions alogside with theoretical # distribution. view.dumps <- function() { load.d <- function(name) read.table(name)[,1] 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) } ################################################################ # 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() } mwc-random-0.11.0.0/test/visual.hs0000644000000000000000000000214311704126546015005 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 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 = 10000 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