diff --git a/System/Random/MWC.hs b/System/Random/MWC.hs --- a/System/Random/MWC.hs +++ b/System/Random/MWC.hs @@ -1,14 +1,8 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, FlexibleContexts, + MagicHash, Rank2Types, ScopedTypeVariables, TypeFamilies, UnboxedTuples #-} -- | -- Module : System.Random.MWC --- Copyright : (c) 2009, 2010 Bryan O'Sullivan +-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -392,9 +386,11 @@ nextIndex :: Integral a => a -> Int nextIndex i = fromIntegral j where j = fromIntegral (i+1) :: Word8 +{-# INLINE nextIndex #-} a :: Word64 a = 1540315826 +{-# INLINE a #-} uniformWord32 :: PrimMonad m => Gen (PrimState m) -> m Word32 uniformWord32 (Gen q) = do @@ -404,11 +400,8 @@ let t = a * qi + c c' = fromIntegral (t `shiftR` 32) x = fromIntegral t + c' - x_lt_c = x < c' - x' | x_lt_c = x + 1 - | otherwise = x - c'' | x_lt_c = c' + 1 - | otherwise = 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'') @@ -431,19 +424,13 @@ let t = a * qi + c c' = fromIntegral (t `shiftR` 32) x = fromIntegral t + c' - x_lt_c = x < c' - x' | x_lt_c = x + 1 - | otherwise = x - c'' | x_lt_c = c' + 1 - | otherwise = c' + (# x', c'' #) | x < c' = (# x + 1, c' + 1 #) + | otherwise = (# x, c' #) u = a * qj + fromIntegral c'' d' = fromIntegral (u `shiftR` 32) y = fromIntegral u + d' - y_lt_d = y < d' - y' | y_lt_d = y + 1 - | otherwise = y - d'' | y_lt_d = d' + 1 - | otherwise = 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) @@ -549,9 +536,11 @@ h = sqrt (-2 * log (v / b + g)) in Just (h, u) v = 9.91256303526217e-3 + {-# NOINLINE blocks #-} r = 3.442619855899 ratios = I.zipWith (/) (I.tail blocks) blocks - normalTail neg = tailing + {-# NOINLINE ratios #-} + normalTail neg = tailing where tailing = do x <- ((/r) . log) `liftM` uniform gen y <- log `liftM` uniform gen @@ -605,6 +594,7 @@ 0x4eb3782d, 0xc3f1e669, 0x61ff8d9e, 0x0909238d, 0xef406165, 0x09c1d762, 0x705d184f, 0x188f2cc4, 0x9c5aa12a, 0xc7a5d70e, 0xbc78cb1b, 0x1d26ae62, 0x23f96ae3, 0xd456bf32, 0xe4654f55, 0x31462bd8 ] +{-# NOINLINE defaultSeed #-} -- $references -- diff --git a/benchmarks/Benchmark.hs b/benchmarks/Benchmark.hs --- a/benchmarks/Benchmark.hs +++ b/benchmarks/Benchmark.hs @@ -1,25 +1,39 @@ +import Control.Exception import Control.Monad.ST - +import Criterion.Main import Data.Int import Data.Word - -import Criterion.Main +import qualified System.Random as R import System.Random.MWC +import qualified System.Random.Mersenne as M main = do - gen <- create + mwc <- create + mtg <- M.newMTGen . Just =<< uniform mwc defaultMain - [ bench "mwc-Double" (uniform gen :: IO Double) - , bench "mwc-Int" (uniform gen :: IO Int ) - , bench "mwc-Int8" (uniform gen :: IO Int8 ) - , bench "mwc-Int16" (uniform gen :: IO Int16 ) - , bench "mwc-Int32" (uniform gen :: IO Int32 ) - , bench "mwc-Int64" (uniform gen :: IO Int64 ) - , bench "mwc-Word" (uniform gen :: IO Word ) - , bench "mwc-Word8" (uniform gen :: IO Word8 ) - , bench "mwc-Word16" (uniform gen :: IO Word16) - , bench "mwc-Word32" (uniform gen :: IO Word32) - , bench "mwc-Word64" (uniform gen :: IO Word64) - , bench "mwc-Integer" (uniform gen :: IO Word64) - , bench "normal" (normal gen :: IO Double) + [ bgroup "mwc" + [ 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) + , bench "Integer" (uniform mwc :: IO Word64) + , bench "normal" (normal 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) + ] ] diff --git a/benchmarks/mwc-random-benchmarks.cabal b/benchmarks/mwc-random-benchmarks.cabal new file mode 100644 --- /dev/null +++ b/benchmarks/mwc-random-benchmarks.cabal @@ -0,0 +1,18 @@ +name: 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 diff --git a/mwc-random.cabal b/mwc-random.cabal --- a/mwc-random.cabal +++ b/mwc-random.cabal @@ -1,5 +1,5 @@ name: mwc-random -version: 0.8.0.3 +version: 0.8.0.5 synopsis: Fast, high quality pseudo random number generation description: This package contains code for generating high quality random @@ -16,18 +16,19 @@ distributions. license: BSD3 license-file: LICENSE -homepage: http://bitbucket.org/bos/mwc-random -bug-reports: http://bitbucket.org/bos/mwc-random/issues +homepage: https://bitbucket.org/bos/mwc-random +bug-reports: https://bitbucket.org/bos/mwc-random/issues author: Bryan O'Sullivan maintainer: Bryan O'Sullivan -copyright: 2009, 2010 Bryan O'Sullivan +copyright: 2009, 2010, 2011 Bryan O'Sullivan category: Math, Statistics build-type: Simple cabal-version: >= 1.6 extra-source-files: README.markdown - benchmarks/Benchmark.hs + benchmarks/*.hs benchmarks/Quickie.hs + benchmarks/mwc-random-benchmarks.cabal library exposed-modules: @@ -50,4 +51,8 @@ source-repository head type: mercurial - location: http://bitbucket.org/bos/mwc-random + location: https://bitbucket.org/bos/mwc-random + +source-repository head + type: git + location: git://github.com/bos/mwc-random