splitmix-0.0.2/0000755000000000000000000000000007346545000011553 5ustar0000000000000000splitmix-0.0.2/Changelog.md0000755000000000000000000000035007346545000013765 0ustar0000000000000000# 0.0.2 - Support back to GHC-7.0 - Add `Read SMGen` instance # 0.0.1 - Add `NFData SMGen` instance - Fix a bug. http://www.pcg-random.org/posts/bugs-in-splitmix.html The generated numbers will be different for the same seeds! splitmix-0.0.2/LICENSE0000644000000000000000000000276207346545000012567 0ustar0000000000000000Copyright (c) 2017, Oleg Grenrus 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. * Neither the name of Oleg Grenrus nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. 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. splitmix-0.0.2/README.md0000755000000000000000000000604107346545000013036 0ustar0000000000000000# splitmix Pure Haskell implementation of SplitMix pseudo-random number generator. ## dieharder > [Dieharder](http://webhome.phy.duke.edu/~rgb/General/dieharder.php) is a random number generator (rng) testing suite. It is intended to test generators, not files of possibly random numbers as the latter is a fallacious view of what it means to be random. Is the number 7 random? If it is generated by a random process, it might be. If it is made up to serve the purpose of some argument (like this one) it is not. Perfect random number generators produce "unlikely" sequences of random numbers – at exactly the right average rate. Testing a rng is therefore quite subtle. ``` time $(cabal-plan list-bin splitmix-dieharder) splitmix ``` The test-suite takes around half-an-hour to complete. From 30 runs, 2.49% were weak (3247 passed, 83 weak, 0 failed). In comparison, built-in [Marsenne Twister](https://en.wikipedia.org/wiki/Mersenne_Twister) test takes around 15min. ``` time dieharder -a ``` ## benchmarks ``` benchmarking list 64/random time 1.317 ms (1.303 ms .. 1.335 ms) 0.998 R² (0.998 R² .. 0.999 R²) mean 1.380 ms (1.365 ms .. 1.411 ms) std dev 70.83 μs (37.26 μs .. 131.8 μs) variance introduced by outliers: 39% (moderately inflated) benchmarking list 64/tf-random time 141.1 μs (140.4 μs .. 142.1 μs) 0.999 R² (0.998 R² .. 1.000 R²) mean 145.9 μs (144.6 μs .. 150.4 μs) std dev 7.131 μs (3.461 μs .. 14.75 μs) variance introduced by outliers: 49% (moderately inflated) benchmarking list 64/splitmix time 17.86 μs (17.72 μs .. 18.01 μs) 0.999 R² (0.998 R² .. 1.000 R²) mean 17.95 μs (17.75 μs .. 18.47 μs) std dev 1.000 μs (444.1 ns .. 1.887 μs) variance introduced by outliers: 64% (severely inflated) benchmarking tree 64/random time 800.3 μs (793.3 μs .. 806.5 μs) 0.999 R² (0.998 R² .. 0.999 R²) mean 803.2 μs (798.1 μs .. 811.2 μs) std dev 22.09 μs (14.69 μs .. 35.47 μs) variance introduced by outliers: 18% (moderately inflated) benchmarking tree 64/tf-random time 179.0 μs (176.6 μs .. 180.7 μs) 0.999 R² (0.998 R² .. 0.999 R²) mean 172.7 μs (171.3 μs .. 174.6 μs) std dev 5.590 μs (4.919 μs .. 6.382 μs) variance introduced by outliers: 29% (moderately inflated) benchmarking tree 64/splitmix time 51.54 μs (51.01 μs .. 52.15 μs) 0.999 R² (0.998 R² .. 0.999 R²) mean 52.50 μs (51.93 μs .. 53.55 μs) std dev 2.603 μs (1.659 μs .. 4.338 μs) variance introduced by outliers: 55% (severely inflated) ``` Note: the performance can be potentially further improved when GHC gets [SIMD Support](https://ghc.haskell.org/trac/ghc/wiki/SIMD/Implementation/Status). splitmix-0.0.2/Setup.hs0000644000000000000000000000005607346545000013210 0ustar0000000000000000import Distribution.Simple main = defaultMain splitmix-0.0.2/bench/0000755000000000000000000000000007346545000012632 5ustar0000000000000000splitmix-0.0.2/bench/Bench.hs0000644000000000000000000001034607346545000014211 0ustar0000000000000000module Main (main) where import Criterion.Main import Data.List (unfoldr) import Data.Word (Word64) import qualified Data.Tree as T import qualified System.Random as R import qualified System.Random.TF as TF import qualified System.Random.TF.Instances as TF import qualified System.Random.SplitMix as SM ------------------------------------------------------------------------------- -- List ------------------------------------------------------------------------------- -- infinite list genList :: R.RandomGen g => g -> [Int] genList = unfoldr (Just . R.next) -- truncated genListN :: R.RandomGen g => g -> [Int] genListN = take 2048 . genList randomList :: Int -> [Int] randomList = genListN . R.mkStdGen tfRandomList :: Word64 -> [Int] tfRandomList w64 = genListN $ TF.seedTFGen (w64, w64, w64, w64) splitMixList :: Word64 -> [Int] splitMixList w64 = genListN $ SM.mkSMGen w64 ------------------------------------------------------------------------------- -- Tree ------------------------------------------------------------------------------- genTree :: R.RandomGen g => g -> T.Tree Int genTree g = case R.next g of ~(i, g') -> T.Node i $ case R.split g' of (ga, gb) -> [genTree ga, genTree gb] genTreeN :: R.RandomGen g => g -> T.Tree Int genTreeN = cutTree 9 . genTree where cutTree :: Int -> T.Tree a -> T.Tree a cutTree n (T.Node x forest) | n <= 0 = T.Node x [] | otherwise = T.Node x (map (cutTree (n - 1)) forest) randomTree :: Int -> T.Tree Int randomTree = genTreeN . R.mkStdGen tfRandomTree :: Word64 -> T.Tree Int tfRandomTree w64 = genTreeN $ TF.seedTFGen (w64, w64, w64, w64) splitMixTree :: Word64 -> T.Tree Int splitMixTree w64 = genTreeN $ SM.mkSMGen w64 ------------------------------------------------------------------------------- -- List Word64 ------------------------------------------------------------------------------- -- infinite list genList64 :: (g -> (Word64, g)) -> g -> [Word64] genList64 r = unfoldr (Just . r) -- truncated genListN64 :: (g -> (Word64, g)) -> g -> [Word64] genListN64 r = take 2048 . genList64 r randomList64 :: Int -> [Word64] randomList64 = genListN64 R.random . R.mkStdGen tfRandomList64 :: Word64 -> [Word64] tfRandomList64 w64 = genListN64 TF.random $ TF.seedTFGen (w64, w64, w64, w64) splitMixList64 :: Word64 -> [Word64] splitMixList64 w64 = genListN64 SM.nextWord64 $ SM.mkSMGen w64 ------------------------------------------------------------------------------- -- Tree Word64 ------------------------------------------------------------------------------- genTree64 :: R.RandomGen g => (g -> (Word64, g)) -> g -> T.Tree Word64 genTree64 r = go where go g = case r g of ~(i, g') -> T.Node i $ case R.split g' of (ga, gb) -> [go ga, go gb] genTreeN64 :: R.RandomGen g => (g -> (Word64, g)) -> g -> T.Tree Word64 genTreeN64 r = cutTree 9 . genTree64 r where cutTree :: Word64 -> T.Tree a -> T.Tree a cutTree n (T.Node x forest) | n <= 0 = T.Node x [] | otherwise = T.Node x (map (cutTree (n - 1)) forest) randomTree64 :: Int -> T.Tree Word64 randomTree64 = genTreeN64 R.random . R.mkStdGen tfRandomTree64 :: Word64 -> T.Tree Word64 tfRandomTree64 w64 = genTreeN64 TF.random $ TF.seedTFGen (w64, w64, w64, w64) splitMixTree64 :: Word64 -> T.Tree Word64 splitMixTree64 w64 = genTreeN64 SM.nextWord64 $ SM.mkSMGen w64 ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- main :: IO () main = defaultMain [ bgroup "list" [ bench "random" $ nf randomList 42 , bench "tf-random" $ nf tfRandomList 42 , bench "splitmix" $ nf splitMixList 42 ] , bgroup "tree" [ bench "random" $ nf randomTree 42 , bench "tf-random" $ nf tfRandomTree 42 , bench "splitmix" $ nf splitMixTree 42 ] , bgroup "list 64" [ bench "random" $ nf randomList64 42 , bench "tf-random" $ nf tfRandomList64 42 , bench "splitmix" $ nf splitMixList64 42 ] , bgroup "tree 64" [ bench "random" $ nf randomTree64 42 , bench "tf-random" $ nf tfRandomTree64 42 , bench "splitmix" $ nf splitMixTree64 42 ] ] splitmix-0.0.2/splitmix.cabal0000644000000000000000000000634207346545000014415 0ustar0000000000000000cabal-version: >=1.10 name: splitmix version: 0.0.2 synopsis: Fast Splittable PRNG description: Pure Haskell implementation of SplitMix described in . Guy L. Steele, Jr., Doug Lea, and Christine H. Flood. 2014. Fast splittable pseudorandom number generators. In Proceedings of the 2014 ACM International Conference on Object Oriented Programming Systems Languages & Applications (OOPSLA '14). ACM, New York, NY, USA, 453-472. DOI: . The paper describes a new algorithm /SplitMix/ for /splittable/ pseudorandom number generator that is quite fast: 9 64 bit arithmetic/logical operations per 64 bits generated. . /SplitMix/ is tested with two standard statistical test suites (DieHarder and TestU01, this implementation only using the former) and it appears to be adequate for "everyday" use, such as Monte Carlo algorithms and randomized data structures where speed is important. . In particular, it __should not be used for cryptographic or security applications__, because generated sequences of pseudorandom values are too predictable (the mixing functions are easily inverted, and two successive outputs suffice to reconstruct the internal state). license: BSD3 license-file: LICENSE maintainer: Oleg Grenrus bug-reports: https://github.com/phadej/splitmix#issues category: System build-type: Simple tested-with: GHC ==8.6.4 || ==8.4.4 || ==8.2.2 || ==8.0.2 || ==7.10.3 || ==7.8.4 || ==7.6.3 || ==7.4.2 || ==7.2.2 || ==7.0.4 extra-source-files: README.md Changelog.md library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src exposed-modules: System.Random.SplitMix -- dump-core -- build-depends: dump-core -- ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html build-depends: base >=4.3 && <4.13 , deepseq >=1.3.0.0 && <1.5 , random >=1.0 && <1.2 , time >=1.2.0.3 && <1.9 source-repository head type: git location: https://github.com/phadej/splitmix.git benchmark comparison type: exitcode-stdio-1.0 default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: bench main-is: Bench.hs build-depends: base , containers >=0.4.2.1 && <0.7 , criterion >=1.1.0.0 && <1.6 , random , splitmix , tf-random >=0.5 && <0.6 test-suite montecarlo-pi type: exitcode-stdio-1.0 default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: tests main-is: SplitMixPi.hs build-depends: base , splitmix test-suite splitmix-dieharder type: exitcode-stdio-1.0 default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts hs-source-dirs: tests main-is: Dieharder.hs build-depends: async >=2.2.1 && <2.3 , base , base-compat-batteries >=0.10.5 && <0.11 , bytestring >=0.9.1.8 && <0.11 , deepseq , process >=1.0.1.5 && <1.7 , random , splitmix , tf-random >=0.5 && <0.6 , vector >=0.11.0.0 && <0.13 splitmix-0.0.2/src/System/Random/0000755000000000000000000000000007346545000015046 5ustar0000000000000000splitmix-0.0.2/src/System/Random/SplitMix.hs0000644000000000000000000002002607346545000017153 0ustar0000000000000000-- | -- /SplitMix/ is a splittable pseudorandom number generator (PRNG) that is quite fast. -- -- Guy L. Steele, Jr., Doug Lea, and Christine H. Flood. 2014. Fast splittable pseudorandom number generators. /In Proceedings of the 2014 ACM International Conference on Object Oriented Programming Systems Languages & Applications/ (OOPSLA '13). ACM, New York, NY, USA, 453-472. DOI: -- -- Guy L. Steele, Jr., Doug Lea, and Christine H. Flood. 2014. -- Fast splittable pseudorandom number generators. In Proceedings -- of the 2014 ACM International Conference on Object Oriented -- Programming Systems Languages & Applications (OOPSLA '14). ACM, -- New York, NY, USA, 453-472. DOI: -- -- -- The paper describes a new algorithm /SplitMix/ for /splittable/ -- pseudorandom number generator that is quite fast: 9 64 bit arithmetic/logical -- operations per 64 bits generated. -- -- /SplitMix/ is tested with two standard statistical test suites (DieHarder and -- TestU01, this implementation only using the former) and it appears to be -- adequate for "everyday" use, such as Monte Carlo algorithms and randomized -- data structures where speed is important. -- -- In particular, it __should not be used for cryptographic or security applications__, -- because generated sequences of pseudorandom values are too predictable -- (the mixing functions are easily inverted, and two successive outputs -- suffice to reconstruct the internal state). -- -- Note: This module supports all GHCs since GHC-7.0.4, -- but GHC-7.0 and GHC-7.2 have slow implementation, as there -- are no native 'popCount'. -- {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif module System.Random.SplitMix ( SMGen, nextWord64, nextInt, nextDouble, splitSMGen, -- * Initialisation mkSMGen, initSMGen, newSMGen, seedSMGen, seedSMGen', unseedSMGen, ) where import Control.DeepSeq (NFData (..)) import Data.Bits (shiftL, shiftR, xor, (.|.)) import Data.IORef (IORef, atomicModifyIORef, newIORef) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word32, Word64) import System.CPUTime (cpuTimePrecision, getCPUTime) import System.IO.Unsafe (unsafePerformIO) import qualified System.Random as R #if MIN_VERSION_base(4,5,0) import Data.Bits (popCount) #else import Data.Bits ((.&.)) popCount :: Word64 -> Int popCount = go 0 where go !c 0 = c go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant #endif -- $setup -- >>> import Text.Read (readMaybe) -- >>> import Data.List (unfoldr) -- >>> import Text.Printf (printf) ------------------------------------------------------------------------------- -- Generator ------------------------------------------------------------------------------- -- | SplitMix generator state. data SMGen = SMGen !Word64 !Word64 -- seed and gamma; gamma is odd deriving Show instance NFData SMGen where rnf (SMGen _ _) = () -- | -- -- >>> readMaybe "SMGen 1 1" :: Maybe SMGen -- Just (SMGen 1 1) -- -- >>> readMaybe "SMGen 1 2" :: Maybe SMGen -- Nothing -- -- >>> readMaybe (show (mkSMGen 42)) :: Maybe SMGen -- Just (SMGen 9297814886316923340 13679457532755275413) -- instance Read SMGen where readsPrec d r = readParen (d > 10) (\r0 -> [ (SMGen seed gamma, r3) | ("SMGen", r1) <- lex r0 , (seed, r2) <- readsPrec 11 r1 , (gamma, r3) <- readsPrec 11 r2 , odd gamma ]) r ------------------------------------------------------------------------------- -- Operations ------------------------------------------------------------------------------- -- | Generate a 'Word64'. -- -- >>> take 3 $ map (printf "%x") $ unfoldr (Just . nextWord64) (mkSMGen 1337) :: [String] -- ["b5c19e300e8b07b3","d600e0e216c0ac76","c54efc3b3cc5af29"] -- nextWord64 :: SMGen -> (Word64, SMGen) nextWord64 (SMGen seed gamma) = (mix64 seed', SMGen seed' gamma) where seed' = seed + gamma -- | Generate an 'Int'. nextInt :: SMGen -> (Int, SMGen) nextInt g = case nextWord64 g of (w64, g') -> (fromIntegral w64, g') -- | Generate a 'Double' in @[0, 1)@ range. -- -- >>> take 8 $ map (printf "%0.3f") $ unfoldr (Just . nextDouble) (mkSMGen 1337) :: [String] -- ["0.710","0.836","0.771","0.409","0.297","0.527","0.589","0.067"] -- nextDouble :: SMGen -> (Double, SMGen) nextDouble g = case nextWord64 g of (w64, g') -> (fromIntegral (w64 `shiftR` 11) * doubleUlp, g') -- | Split a generator into a two uncorrelated generators. splitSMGen :: SMGen -> (SMGen, SMGen) splitSMGen (SMGen seed gamma) = (SMGen seed'' gamma, SMGen (mix64 seed') (mixGamma seed'')) where seed' = seed + gamma seed'' = seed' + gamma ------------------------------------------------------------------------------- -- Algorithm ------------------------------------------------------------------------------- goldenGamma :: Word64 goldenGamma = 0x9e3779b97f4a7c15 doubleUlp :: Double doubleUlp = 1.0 / fromIntegral (1 `shiftL` 53 :: Word64) -- Note: in JDK implementations the mix64 and mix64variant13 -- (which is inlined into mixGamma) are swapped. -- -- I have no idea if swapping them affects statistical properties. mix64 :: Word64 -> Word64 mix64 z0 = -- MurmurHash3Mixer let z1 = shiftXorMultiply 33 0xff51afd7ed558ccd z0 z2 = shiftXorMultiply 33 0xc4ceb9fe1a85ec53 z1 z3 = shiftXor 33 z2 in z3 -- used only in mixGamma mix64variant13 :: Word64 -> Word64 mix64variant13 z0 = -- Better Bit Mixing - Improving on MurmurHash3's 64-bit Finalizer -- http://zimbry.blogspot.fi/2011/09/better-bit-mixing-improving-on.html let z1 = shiftXorMultiply 30 0xbf58476d1ce4e5b9 z0 -- MurmurHash3 mix constants z2 = shiftXorMultiply 27 0x94d049bb133111eb z1 z3 = shiftXor 31 z2 in z3 mixGamma :: Word64 -> Word64 mixGamma z0 = let z1 = mix64variant13 z0 .|. 1 -- force to be odd n = popCount (z1 `xor` (z1 `shiftR` 1)) -- see: http://www.pcg-random.org/posts/bugs-in-splitmix.html -- let's trust the text of the paper, not the code. in if n >= 24 then z1 else z1 `xor` 0xaaaaaaaaaaaaaaaa shiftXor :: Int -> Word64 -> Word64 shiftXor n w = w `xor` (w `shiftR` n) shiftXorMultiply :: Int -> Word64 -> Word64 -> Word64 shiftXorMultiply n k w = shiftXor n w * k ------------------------------------------------------------------------------- -- Initialisation ------------------------------------------------------------------------------- -- | Create 'SMGen' using seed and gamma. -- -- >>> seedSMGen 2 2 -- SMGen 2 3 -- seedSMGen :: Word64 -- ^ seed -> Word64 -- ^ gamma -> SMGen seedSMGen seed gamma = SMGen seed (gamma .|. 1) -- | Like 'seedSMGen' but takes a pair. seedSMGen' :: (Word64, Word64) -> SMGen seedSMGen' = uncurry seedSMGen -- | Extract current state of 'SMGen'. unseedSMGen :: SMGen -> (Word64, Word64) unseedSMGen (SMGen seed gamma) = (seed, gamma) -- | Preferred way to deterministically construct 'SMGen'. -- -- >>> mkSMGen 42 -- SMGen 9297814886316923340 13679457532755275413 -- mkSMGen :: Word64 -> SMGen mkSMGen s = SMGen (mix64 s) (mixGamma (s + goldenGamma)) -- | Initialize 'SMGen' using system time. initSMGen :: IO SMGen initSMGen = fmap mkSMGen mkSeedTime -- | Derive a new generator instance from the global 'SMGen' using 'splitSMGen'. newSMGen :: IO SMGen newSMGen = atomicModifyIORef theSMGen splitSMGen theSMGen :: IORef SMGen theSMGen = unsafePerformIO $ initSMGen >>= newIORef {-# NOINLINE theSMGen #-} mkSeedTime :: IO Word64 mkSeedTime = do now <- getPOSIXTime cpu <- getCPUTime let lo = truncate now :: Word32 hi = fromIntegral (cpu `div` cpuTimePrecision) :: Word32 return $ fromIntegral hi `shiftL` 32 .|. fromIntegral lo ------------------------------------------------------------------------------- -- System.Random ------------------------------------------------------------------------------- instance R.RandomGen SMGen where next = nextInt split = splitSMGen splitmix-0.0.2/tests/0000755000000000000000000000000007346545000012715 5ustar0000000000000000splitmix-0.0.2/tests/Dieharder.hs0000644000000000000000000002073607346545000015150 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module Main (main) where import Prelude () import Prelude.Compat import Control.Concurrent.QSem import Control.DeepSeq (force) import Data.Bits (shiftL, (.|.)) import Data.Char (isSpace) import Data.List (isInfixOf, unfoldr) import Data.Maybe (fromMaybe) import Data.Word (Word64) import Foreign.C (Errno (..), ePIPE) import Foreign.Ptr (castPtr) import GHC.IO.Exception (IOErrorType (..), IOException (..)) import System.Environment (getArgs) import System.IO (Handle, hGetContents) import Text.Printf (printf) import qualified Control.Concurrent.Async as A import qualified Control.Exception as E import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS (unsafePackCStringLen) import qualified Data.Vector.Storable.Mutable as MSV import qualified System.Process as Proc import qualified System.Random.SplitMix as SM import qualified System.Random.TF as TF import qualified System.Random.TF.Gen as TF import qualified System.Random.TF.Init as TF main :: IO () main = do args <- getArgs if null args then return () else do (cmd, runs, conc, seed, test, _help) <- parseArgsIO args $ (,,,,,) <$> arg <*> optDef "-n" 1 <*> optDef "-j" 1 <*> opt "-s" <*> opt "-d" <*> flag "-h" case cmd of "splitmix" -> do g <- maybe SM.initSMGen (return . SM.mkSMGen) seed run test runs conc SM.splitSMGen SM.nextWord64 g "tfrandom" -> do g <- TF.initTFGen run test runs conc TF.split tfNext64 g _ -> return () tfNext64 :: TF.TFGen -> (Word64, TF.TFGen) tfNext64 g = let (w, g') = TF.next g (w', g'') = TF.next g' in (fromIntegral w `shiftL` 32 .|. fromIntegral w', g'') ------------------------------------------------------------------------------- -- Dieharder ------------------------------------------------------------------------------- run :: Maybe Int -> Int -> Int -> (g -> (g, g)) -> (g -> (Word64, g)) -> g -> IO () run test runs conc split word gen = do qsem <- newQSem conc rs <- A.forConcurrently (take runs $ unfoldr (Just . split) gen) $ \g -> E.bracket_ (waitQSem qsem) (signalQSem qsem) $ dieharder test (generate word g) case mconcat rs of Result p w f -> do let total = fromIntegral (p + w + f) :: Double printf "PASSED %4d %6.02f%%\n" p (fromIntegral p / total * 100) printf "WEAK %4d %6.02f%%\n" w (fromIntegral w / total * 100) printf "FAILED %4d %6.02f%%\n" f (fromIntegral f / total * 100) {-# INLINE run #-} dieharder :: Maybe Int -> (Handle -> IO ()) -> IO Result dieharder test gen = do let proc = Proc.proc "dieharder" $ ["-g", "200"] ++ maybe ["-a"] (\t -> ["-d", show t]) test (Just hin, Just hout, _, ph) <- Proc.createProcess proc { Proc.std_in = Proc.CreatePipe , Proc.std_out = Proc.CreatePipe } out <- hGetContents hout waitOut <- A.async $ E.evaluate $ force out E.catch (gen hin) $ \e -> case e of IOError { ioe_type = ResourceVanished , ioe_errno = Just ioe } | Errno ioe == ePIPE -> return () _ -> E.throwIO e res <- A.wait waitOut _ <- Proc.waitForProcess ph return $ parseOutput res {-# INLINE dieharder #-} parseOutput :: String -> Result parseOutput = foldMap parseLine . lines where parseLine l | any (`isInfixOf` l) doNotUse = mempty | "PASSED" `isInfixOf` l = Result 1 0 0 | "WEAK" `isInfixOf` l = Result 0 1 0 | "FAILED" `isInfixOf` l = Result 0 1 0 | otherwise = mempty doNotUse = ["diehard_opso", "diehard_oqso", "diehard_dna", "diehard_weak"] ------------------------------------------------------------------------------- -- Results ------------------------------------------------------------------------------- data Result = Result { _passed :: Int , _weak :: Int , _failed :: Int } deriving Show instance Semigroup Result where Result p w f <> Result p' w' f' = Result (p + p') (w + w') (f + f') instance Monoid Result where mempty = Result 0 0 0 mappend = (<>) ------------------------------------------------------------------------------- -- Writer ------------------------------------------------------------------------------- size :: Int size = 512 generate :: forall g. (g -> (Word64, g)) -> g -> Handle -> IO () generate word gen0 h = do vec <- MSV.new size go gen0 vec where go :: g -> MSV.IOVector Word64 -> IO () go gen vec = do gen' <- write gen vec 0 MSV.unsafeWith vec $ \ptr -> do bs <- BS.unsafePackCStringLen (castPtr ptr, size * 8) BS.hPutStr h bs go gen' vec write :: g -> MSV.IOVector Word64 -> Int -> IO g write !gen !vec !i = do let (w64, gen') = word gen MSV.unsafeWrite vec i w64 if i < size then write gen' vec (i + 1) else return gen' {-# INLINE generate #-} ------------------------------------------------------------------------------- -- readMaybe ------------------------------------------------------------------------------- readEither :: Read a => String -> Either String a readEither s = case [ x | (x,rest) <- reads s, all isSpace rest ] of [x] -> Right x [] -> Left "Prelude.read: no parse" _ -> Left "Prelude.read: ambiguous parse" readMaybe :: Read a => String -> Maybe a readMaybe s = case readEither s of Left _ -> Nothing Right a -> Just a ------------------------------------------------------------------------------- -- Do it yourself command line parsing ------------------------------------------------------------------------------- -- | 'Parser' is not an 'Alternative', only a *commutative* 'Applicative'. -- -- Useful for quick cli parsers, like parametrising tests. data Parser a where Pure :: a -> Parser a Ap :: Arg b -> Parser (b -> a) -> Parser a instance Functor Parser where fmap f (Pure a) = Pure (f a) fmap f (Ap x y) = Ap x (fmap (f .) y) instance Applicative Parser where pure = Pure Pure f <*> z = fmap f z Ap x y <*> z = Ap x (flip <$> y <*> z) data Arg a where Flag :: String -> Arg Bool Opt :: String -> (String -> Maybe a) -> Arg (Maybe a) Arg :: Arg String arg :: Parser String arg = Ap Arg (Pure id) flag :: String -> Parser Bool flag n = Ap (Flag n) (Pure id) opt :: Read a => String -> Parser (Maybe a) opt n = Ap (Opt n readMaybe) (Pure id) optDef :: Read a => String -> a -> Parser a optDef n d = Ap (Opt n readMaybe) (Pure (fromMaybe d)) parseArgsIO :: [String] -> Parser a -> IO a parseArgsIO args p = either fail pure (parseArgs args p) parseArgs :: [String] -> Parser a -> Either String a parseArgs [] p = parserToEither p parseArgs (x : xs) p = do (xs', p') <- singleArg p x xs parseArgs xs' p' singleArg :: Parser a -> String -> [String] -> Either String ([String], Parser a) singleArg (Pure _) x _ = Left $ "Extra argument " ++ x singleArg (Ap Arg p) x xs | null x || head x /= '-' = Right (xs, fmap ($ x) p) | otherwise = fmap2 (Ap Arg) (singleArg p x xs) singleArg (Ap f@(Flag n) p) x xs | x == n = Right (xs, fmap ($ True) p) | otherwise = fmap2 (Ap f) (singleArg p x xs) singleArg (Ap o@(Opt n r) p) x xs | x == n = case xs of [] -> Left $ "Expected an argument for " ++ n (x' : xs') -> case r x' of Nothing -> Left $ "Cannot read an argument of " ++ n ++ ": " ++ x' Just y -> Right (xs', fmap ($ Just y) p) | otherwise = fmap2 (Ap o) (singleArg p x xs) fmap2 :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) fmap2 = fmap . fmap -- | Convert parser to 'Right' if there are only defaultable pieces left. parserToEither :: Parser a -> Either String a parserToEither (Pure x) = pure x parserToEither (Ap (Flag _) p) = parserToEither $ fmap ($ False) p parserToEither (Ap (Opt _ _) p) = parserToEither $ fmap ($ Nothing) p parserToEither (Ap Arg _) = Left "argument required" splitmix-0.0.2/tests/SplitMixPi.hs0000644000000000000000000000124207346545000015312 0ustar0000000000000000module Main (main) where import Data.List (unfoldr, foldl') import System.Random.SplitMix doubles :: SMGen -> [Double] doubles = unfoldr (Just . nextDouble) monteCarloPi :: SMGen -> Double monteCarloPi = (4 *) . calc . foldl' accum (P 0 0) . take 10000000 . pairs . doubles where calc (P n m) = fromIntegral n / fromIntegral m pairs (x : y : xs) = (x, y) : pairs xs pairs _ = [] accum (P n m) (x, y) | x * x + y * y >= 1 = P n (m + 1) | otherwise = P (n + 1) (m + 1) data P = P !Int !Int main :: IO () main = do pi' <- fmap monteCarloPi newSMGen print (pi :: Double) print pi' print (pi - pi')