diff --git a/System/Random/Mersenne/Pure64.hs b/System/Random/Mersenne/Pure64.hs --- a/System/Random/Mersenne/Pure64.hs +++ b/System/Random/Mersenne/Pure64.hs @@ -7,11 +7,11 @@ -- Maintainer : Don Stewart -- Stability : experimental -- Portability: CPP, FFI --- Tested with: GHC 6.8.2 +-- Tested with: GHC 6.8.3 -- -- A purely functional binding 64 bit binding to the classic mersenne --- twister random number generator. This is more flexible than the --- impure 'mersenne-random' library, at the cost of being much slower. +-- twister random number generator. This is more flexible than the +-- impure 'mersenne-random' library, at the cost of being a bit slower. -- This generator is however, many times faster than System.Random, -- and yields high quality randoms with a long period. -- @@ -79,24 +79,28 @@ -- generator and that 'Int'. The full 64 bits will be used on a 64 bit machine. randomInt :: PureMT -> (Int,PureMT) randomInt g = (fromIntegral i, g') - where (i,g') = randomWord64 g + where (i, g') = randomWord64 g +{-# INLINE randomInt #-} -- | Yield a new 'Word' value from the generator, returning a new -- generator and that 'Word'. randomWord :: PureMT -> (Word,PureMT) randomWord g = (fromIntegral i, g') - where (i,g') = randomWord64 g + where (i, g') = randomWord64 g +{-# INLINE randomWord #-} -- | Yield a new 'Int64' value from the generator, returning a new -- generator and that 'Int64'. randomInt64 :: PureMT -> (Int64,PureMT) randomInt64 g = (fromIntegral i, g') - where (i,g') = randomWord64 g + where (i, g') = randomWord64 g +{-# INLINE randomInt64 #-} -- | Efficiently yield a new 53-bit precise 'Double' value, and a new generator. randomDouble :: PureMT -> (Double,PureMT) randomDouble g = (fromIntegral (i `div` 2048) / 9007199254740992, g') - where (i,g') = randomWord64 g + where (i, g') = randomWord64 g +{-# INLINE randomDouble #-} -- | Yield a new 'Word64' value from the generator, returning a new -- generator and that 'Word64'. @@ -105,10 +109,11 @@ where mt | i < blockLen-1 = PureMT block (i+1) nxt | otherwise = mkPureMT nxt +{-# INLINE randomWord64 #-} -- | 'PureMT', a pure mersenne twister pseudo-random number generator -- -data PureMT = PureMT !MTBlock !Int MTBlock +data PureMT = PureMT {-# UNPACK #-} !MTBlock {-# UNPACK #-} !Int MTBlock instance Show PureMT where show _ = show "" diff --git a/System/Random/Mersenne/Pure64/Base.hsc b/System/Random/Mersenne/Pure64/Base.hsc --- a/System/Random/Mersenne/Pure64/Base.hsc +++ b/System/Random/Mersenne/Pure64/Base.hsc @@ -7,11 +7,11 @@ -- Maintainer : Don Stewart -- Stability : experimental -- Portability: CPP, FFI, EmptyDataDecls --- Tested with: GHC 6.8.2 +-- Tested with: GHC 6.8.3 -- -- A purely functional binding 64 bit binding to the classic mersenne --- twister random number generator. This is more flexible than the --- impure 'mersenne-random' library, at the cost of being much slower. +-- twister random number generator. This is more flexible than the +-- impure 'mersenne-random' library, at the cost of being a bit slower. -- This generator is however, many times faster than System.Random, -- and yields high quality randoms with a long period. -- @@ -41,7 +41,7 @@ c_genrand64_real2 :: Ptr MTState -> IO CDouble sizeof_MTState :: Int -sizeof_MTState = (#const (sizeof (struct mt_state_t))) -- 2504 bytes +sizeof_MTState = (# const sizeof (struct mt_state_t) ) -- 2504 bytes ------------------------------------------------------------------------ -- block based version: @@ -60,7 +60,7 @@ -- | size of an MT block, in bytes blockSize :: Int -blockSize = (# const sizeof(mt_block_struct) ) +blockSize = (# const sizeof (mt_block_struct) ) ------------------------------------------------------------------------ -- model: (for testing purposes) diff --git a/System/Random/Mersenne/Pure64/MTBlock.hs b/System/Random/Mersenne/Pure64/MTBlock.hs --- a/System/Random/Mersenne/Pure64/MTBlock.hs +++ b/System/Random/Mersenne/Pure64/MTBlock.hs @@ -2,13 +2,19 @@ -------------------------------------------------------------------- -- | -- Module : System.Random.Mersenne.Pure64 --- Copyright : Copyright (c) 2008, Bertram Felgenhauer +-- Copyright : Copyright (c) 2008, Bertram Felgenhauer -- License : BSD3 -- Maintainer : Don Stewart -- Stability : experimental --- Portability: --- Tested with: GHC 6.8.2 +-- Portability: +-- Tested with: GHC 6.8.3 -- +-- A purely functional binding 64 bit binding to the classic mersenne +-- twister random number generator. This is more flexible than the +-- impure 'mersenne-random' library, at the cost of being a bit slower. +-- This generator is however, many times faster than System.Random, +-- and yields high quality randoms with a long period. +-- module System.Random.Mersenne.Pure64.MTBlock ( -- * Block type MTBlock, @@ -49,6 +55,7 @@ c_next_genrand64_block (blockAsPtr b) (blockAsPtr b) touch b return b +{-# NOINLINE seedBlock #-} -- | step: create a new MTBlock buffer from the previous one nextBlock :: MTBlock -> MTBlock @@ -58,6 +65,7 @@ touch b touch new return new +{-# NOINLINE nextBlock #-} -- stolen from GHC.ForeignPtr - make sure the argument is still alive. touch :: a -> IO () diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -7,7 +7,11 @@ This is actually an error on 32 bit machines - the default return type int is not large enough to hold the 64 bit result. + + This is fixed in ghc 6.9; the compiler emits its own prototypes. Check sequences are repeatable -check behaviour on 32 bits +Investigate slow conversion to Double (x86 at least) + looking at the core, the conversion goes through toInteger and encodeFloat. + That's a pity, because the FPU has an instruction for this purpose. profile/benchmark tests driver diff --git a/mersenne-random-pure64.cabal b/mersenne-random-pure64.cabal --- a/mersenne-random-pure64.cabal +++ b/mersenne-random-pure64.cabal @@ -1,6 +1,6 @@ name: mersenne-random-pure64 -version: 0.2 -homepage: http://code.haskell.org/~dons/code/mt19937-random +version: 0.2.0.2 +homepage: http://code.haskell.org/~dons/code/mersenne-random-pure64/ synopsis: Generate high quality pseudorandom numbers purely using a Mersenne Twister description: The Mersenne twister is a pseudorandom number generator developed by @@ -14,7 +14,7 @@ This library provides a purely functional binding to the 64 bit classic mersenne twister, along with instances of RandomGen, so the generator can be used with System.Random. The generator should - typically be a few times faster than the default StdGen (but much + typically be a few times faster than the default StdGen (but a tad slower than the impure 'mersenne-random' library based on SIMD instructions and destructive state updates. . @@ -24,9 +24,9 @@ copyright: (c) 2008. Don Stewart author: Don Stewart maintainer: Don Stewart -cabal-version: >= 1.2.0 +cabal-version: >= 1.2.0 build-type: Simple -tested-with: GHC ==6.8.2 +tested-with: GHC == 6.8.3 flag small_base description: Build with new smaller base library diff --git a/tests/Unit.hs b/tests/Unit.hs --- a/tests/Unit.hs +++ b/tests/Unit.hs @@ -1,4 +1,7 @@ -{-# OPTIONS -fbang-patterns -fglasgow-exts #-} +{-# LANGUAGE BangPatterns #-} +-- A basic correctness and performance test for mersenne-random-pure64. +-- +-- Copyright (c) 2008, Don Stewart import Control.Exception import Control.Monad @@ -36,11 +39,11 @@ ------------------------------------------------------------------------ -- calibrate s <- newMVar 0 :: IO (MVar Int) - putStr "Callibrating ... " >> hFlush stdout + putStr "Calibrating ... " >> hFlush stdout tid <- forkIO $ do let go !i !g = do - let (!_,!g') = randomWord64 g + let (!_, !g') = randomWord64 g x <- swapMVar s i x `seq` go (i+1) g' go 0 g @@ -48,7 +51,7 @@ threadDelay (1000 * 1000) killThread tid lim <- readMVar s -- 1 sec worth of generation - putStrLn $ "done. Using N="++ show lim + putStrLn $ "done. Using N=" ++ show lim time $ do let m = 2*lim @@ -56,7 +59,7 @@ hFlush stdout equivalent g m - speed lim + speed lim return () @@ -67,8 +70,8 @@ i' <- c_genrand64_int64_unsafe d' <- c_genrand64_real2_unsafe - let (i,g') = randomWord64 g - (d,g'') = randomDouble g' + let (i, g') = randomWord64 g + (d, g'') = randomDouble g' if i == fromIntegral i' && d == realToFrac d' then do when (n `rem` 500000 == 0) $ putChar '.' >> hFlush stdout @@ -93,7 +96,7 @@ go !g !n !acc | n >= lim = acc | otherwise = - let (a,g') = Old.random g + let (a, g') = Old.random g in go g' (n+1) (if a > acc then a else acc) print (go g 0 0) @@ -121,6 +124,17 @@ print (go g 0 0) time $ do + putStrLn $ "System.Random.Mersenne.Pure generating Double" + let g = pureMT 5 + let go :: PureMT -> Int -> Double -> Double + go !g !n !acc + | n >= lim = acc + | otherwise = + let (a, g') = randomDouble g + in go g' (n+1) (if a > acc then a else acc) + print (go g 0 0) + + time $ do putStrLn $ "System.Random.Mersenne.Pure (unique state)" c_init_genrand64_unsafe 5 let go :: Int -> Int -> IO Int @@ -129,7 +143,7 @@ | otherwise = do a' <- c_genrand64_int64_unsafe let a = fromIntegral a' - go (n+1::Int) (if a > acc then a else acc) + go (n+1) (if a > acc then a else acc) print =<< go 0 0 time $ do @@ -141,7 +155,7 @@ | n >= lim = return acc | otherwise = do a <- Unsafe.random g - go (n+1::Int) (if a > acc then a else acc) + go (n+1) (if a > acc then a else acc) print =<< go 0 0