splitmix 0.1.3.1 → 0.1.3.2
raw patch · 19 files changed
+24/−1500 lines, 19 filesdep −asyncdep −base-compat-batteriesdep −bytestringdep ~basedep ~deepseqdep ~time
Dependencies removed: async, base-compat-batteries, bytestring, containers, criterion, math-functions, process, random, test-framework, test-framework-hunit, tf-random, vector
Dependency ranges changed: base, deepseq, time
Files
- bench/Bench.hs +0/−152
- bench/Range.hs +0/−108
- bench/SimpleSum.hs +0/−57
- cbits-unix/init.c +0/−1
- splitmix.cabal +7/−127
- src-compat/Data/Bits/Compat.hs +0/−9
- src/System/Random/SplitMix.hs +1/−1
- src/System/Random/SplitMix32.hs +1/−1
- tests/Dieharder.hs +0/−273
- tests/Examples.hs +0/−15
- tests/Initialization.hs +0/−28
- tests/MiniQC.hs +0/−81
- tests/SplitMixPi.hs +0/−27
- tests/SplitMixPi32.hs +0/−27
- tests/TestU01.hs +0/−185
- tests/Tests.hs +0/−136
- tests/Uniformity.hs +0/−134
- tests/cbits/testu01.c +0/−138
- tests/splitmix-examples.hs +15/−0
− bench/Bench.hs
@@ -1,152 +0,0 @@-module 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-import qualified System.Random.SplitMix32 as SM32------------------------------------------------------------------------------------ List------------------------------------------------------------------------------------ infinite list-genList :: (g -> (Int, g)) -> g -> [Int]-genList next = unfoldr (Just . next)---- truncated-genListN :: (g -> (Int, g)) -> g -> [Int]-genListN next = take 2048 . genList next--randomList :: Int -> [Int]-randomList = genListN R.random . R.mkStdGen--tfRandomList :: Word64 -> [Int]-tfRandomList w64 = genListN R.random $ TF.seedTFGen (w64, w64, w64, w64)--splitMixList :: Word64 -> [Int]-splitMixList w64 = genListN SM.nextInt $ SM.mkSMGen w64--splitMix32List :: Word64 -> [Int]-splitMix32List w64 = genListN SM32.nextInt $ SM32.mkSMGen $ fromIntegral w64------------------------------------------------------------------------------------ Tree----------------------------------------------------------------------------------genTree :: (g -> (Int, g)) -> (g -> (g, g)) -> g -> T.Tree Int-genTree next split = go where- go g = case next g of- ~(i, g') -> T.Node i $ case split g' of- (ga, gb) -> [go ga, go gb]--genTreeN :: (g -> (Int, g)) -> (g -> (g, g)) -> g -> T.Tree Int-genTreeN next split = cutTree 9 . genTree next split- 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.next R.split . R.mkStdGen--tfRandomTree :: Word64 -> T.Tree Int-tfRandomTree w64 = genTreeN R.next R.split $ TF.seedTFGen (w64, w64, w64, w64)--splitMixTree :: Word64 -> T.Tree Int-splitMixTree w64 = genTreeN SM.nextInt SM.splitSMGen $ SM.mkSMGen w64--splitMix32Tree :: Word64 -> T.Tree Int-splitMix32Tree w64 = genTreeN SM32.nextInt SM32.splitSMGen $ SM32.mkSMGen $ fromIntegral 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--splitMix32List64 :: Word64 -> [Word64]-splitMix32List64 w64 = genListN64 SM32.nextWord64 $ SM32.mkSMGen $ fromIntegral w64------------------------------------------------------------------------------------ Tree Word64----------------------------------------------------------------------------------genTree64 ::(g -> (Word64, g)) -> (g -> (g, g)) -> g -> T.Tree Word64-genTree64 r split = go where- go g = case r g of- ~(i, g') -> T.Node i $ case split g' of- (ga, gb) -> [go ga, go gb]--genTreeN64 :: (g -> (Word64, g)) -> (g -> (g, g)) -> g -> T.Tree Word64-genTreeN64 r split = cutTree 9 . genTree64 r split- 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.split . R.mkStdGen--tfRandomTree64 :: Word64 -> T.Tree Word64-tfRandomTree64 w64 = genTreeN64 TF.random R.split $ TF.seedTFGen (w64, w64, w64, w64)--splitMixTree64 :: Word64 -> T.Tree Word64-splitMixTree64 w64 = genTreeN64 SM.nextWord64 SM.splitSMGen $ SM.mkSMGen w64--splitMix32Tree64 :: Word64 -> T.Tree Word64-splitMix32Tree64 w64 = genTreeN64 SM32.nextWord64 SM32.splitSMGen $ SM32.mkSMGen $ fromIntegral w64------------------------------------------------------------------------------------ Main----------------------------------------------------------------------------------main :: IO ()-main = defaultMain- [ bgroup "list"- [ bench "random" $ nf randomList 42- , bench "tf-random" $ nf tfRandomList 42- , bench "splitmix" $ nf splitMixList 42- , bench "splitmix32" $ nf splitMix32List 42- ]- , bgroup "tree"- [ bench "random" $ nf randomTree 42- , bench "tf-random" $ nf tfRandomTree 42- , bench "splitmix" $ nf splitMixTree 42- , bench "splitmix32" $ nf splitMix32Tree 42- ]- , bgroup "list 64"- [ bench "random" $ nf randomList64 42- , bench "tf-random" $ nf tfRandomList64 42- , bench "splitmix" $ nf splitMixList64 42- , bench "splitmix32" $ nf splitMix32List64 42- ]- , bgroup "tree 64"- [ bench "random" $ nf randomTree64 42- , bench "tf-random" $ nf tfRandomTree64 42- , bench "splitmix" $ nf splitMixTree64 42- , bench "splitmix32" $ nf splitMix32Tree64 42- ]- ]
− bench/Range.hs
@@ -1,108 +0,0 @@--- http://www.pcg-random.org/posts/bounded-rands.html-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-module Main where--import Data.Bits-import Data.Bits.Compat-import Data.List (unfoldr)-import Data.Word (Word32, Word64)--import qualified System.Random.SplitMix32 as SM--#if defined(__GHCJS__)-#else-import System.Clock (Clock (Monotonic), getTime, toNanoSecs)-import Text.Printf (printf)-#endif--main :: IO ()-main = do- gen <- SM.newSMGen-- -- bench gen (\g h -> R (0, pred h) g)- bench gen classicMod- bench gen intMult- bench gen bitmaskWithRejection--bench :: g -> (g -> Word32 -> (Word32, g)) -> IO ()-bench gen next = do- print $ take 70 $ unfoldr (\g -> Just (next g 10)) gen- clocked $ do- let x = sumOf next gen- print x--sumOf :: (g -> Word32 -> (Word32, g)) -> g -> Word32-sumOf next = go 0 2- where- go !acc !n g | n > 0xfffff = acc- | otherwise = let (w, g') = next g n in go (acc + w) (succ n) g'--classicMod :: SM.SMGen -> Word32 -> (Word32, SM.SMGen)-classicMod g h =- let (w32, g') = SM.nextWord32 g in (w32 `mod` h, g')----- @--- uint32_t bounded_rand(rng_t& rng, uint32_t range) {--- uint32_t x = rng();--- uint64_t m = uint64_t(x) * uint64_t(range);--- return m >> 32;--- }--- @----intMult :: SM.SMGen -> Word32 -> (Word32, SM.SMGen)-intMult g h =- (fromIntegral $ (fromIntegral w32 * fromIntegral h :: Word64) `shiftR` 32, g')- where- (w32, g') = SM.nextWord32 g---- @--- uint32_t bounded_rand(rng_t& rng, uint32_t range) {--- uint32_t mask = ~uint32_t(0);--- --range;--- mask >>= __builtin_clz(range|1);--- uint32_t x;--- do {--- x = rng() & mask;--- } while (x > range);--- return x;--- }--- @@-bitmaskWithRejection :: SM.SMGen -> Word32 -> (Word32, SM.SMGen)-bitmaskWithRejection g0 range = go g0- where- mask = complement zeroBits `shiftR` countLeadingZeros (range .|. 1)- go g = let (x, g') = SM.nextWord32 g- x' = x .&. mask- in if x' >= range- then go g'- else (x', g')------------------------------------------------------------------------------------ Poor man benchmarking with GHC and GHCJS----------------------------------------------------------------------------------clocked :: IO () -> IO ()-#if defined(__GHCJS__)-clocked action = do- start- action- stop--foreign import javascript unsafe- "console.time('loop');"- start :: IO ()--foreign import javascript unsafe- "console.timeEnd('loop');"- stop :: IO ()-#else-clocked action = do- start <- getTime Monotonic- action- end <- getTime Monotonic- printf "loop: %.03fms\n"- $ fromIntegral (toNanoSecs (end - start))- / (1e6 :: Double)-#endif
− bench/SimpleSum.hs
@@ -1,57 +0,0 @@-{-# LANGUAGE CPP #-}-module Main (main) where--import System.Environment (getArgs)-import Data.List (foldl')-import Data.Word (Word32)--import qualified System.Random as R-import qualified System.Random.SplitMix as SM-import qualified System.Random.SplitMix32 as SM32--newGen :: a -> (a -> g) -> IO g -> IO g-#if 0-newGen _ _ new = new-#else-newGen seed mk _ = return (mk seed)-#endif--main :: IO ()-main = do- putStrLn "Summing randoms..."- getArgs >>= \args -> case args of- "splitmix" : _ -> newGen 33 SM.mkSMGen SM.newSMGen >>= \g -> print $ benchSum g SM.nextTwoWord32- "splitmix32" : _ -> newGen 33 SM32.mkSMGen SM32.newSMGen >>= \g -> print $ benchSum g SM32.nextTwoWord32- "random" : _ -> R.newStdGen >>= \g -> print $ benchSum g randomNextTwoWord32-- "sm-integer" : _ -> SM.newSMGen >>= \g -> print $ benchSumInteger g (SM.nextInteger two64 (two64 * 5))- "r-integer" : _ -> R.newStdGen >>= \g -> print $ benchSumInteger g (R.randomR (two64, two64 * 5))-- -- after Closure Compiler getArgs return [] always?- -- _ -> newGen 33 SM.mkSMGen SM.newSMGen >>= \g -> print $ benchSum g SM.nextTwoWord32- _ -> newGen 33 SM32.mkSMGen SM32.newSMGen >>= \g -> print $ benchSum g SM32.nextTwoWord32---benchSum :: g -> (g -> (Word32, Word32, g)) -> Word32-benchSum g next = foldl' (+) 0 $ take 10000000 $ unfoldr2 next g--benchSumInteger :: g -> (g -> (Integer, g)) -> Integer-benchSumInteger g next = foldl' (+) 0 $ take 10000000 $ unfoldr next g---- | Infinite unfoldr with two element generator-unfoldr2 :: (s -> (a, a, s)) -> s -> [a]-unfoldr2 f = go where- go s = let (x, y, s') = f s in x : y : go s'---- | Infinite unfoldr with one element generator-unfoldr :: (s -> (a, s)) -> s -> [a]-unfoldr f = go where- go s = let (x, s') = f s in x : go s'--randomNextTwoWord32 :: R.StdGen -> (Word32, Word32, R.StdGen)-randomNextTwoWord32 s0 = (x, y, s2) where- (x, s1) = R.random s0- (y, s2) = R.random s1--two64 :: Integer-two64 = 2 ^ (64 :: Int)
cbits-unix/init.c view
@@ -1,6 +1,5 @@ #include <stdint.h> #include <unistd.h>-#include <sys/random.h> uint64_t splitmix_init() { uint64_t result;
splitmix.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: splitmix-version: 0.1.3.1+version: 0.1.3.2 synopsis: Fast Splittable PRNG description: Pure Haskell implementation of SplitMix described in@@ -43,6 +43,7 @@ || ==9.8.4 || ==9.10.2 || ==9.12.2+ || ==9.14.1 extra-doc-files: Changelog.md@@ -60,13 +61,12 @@ library default-language: Haskell2010 ghc-options: -Wall- hs-source-dirs: src src-compat+ hs-source-dirs: src exposed-modules: System.Random.SplitMix System.Random.SplitMix32 other-modules:- Data.Bits.Compat System.Random.SplitMix.Init -- dump-core@@ -74,7 +74,7 @@ -- ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html build-depends:- , base >=4.12.0.0 && <4.22+ , base >=4.12.0.0 && <4.23 , deepseq >=1.4.4.0 && <1.6 if flag(optimised-mixer)@@ -103,138 +103,18 @@ else cpp-options: -DSPLITMIX_INIT_COMPAT=1- build-depends: time >=1.2.0.3 && <1.15+ build-depends: time >=1.2.0.3 && <1.16 source-repository head type: git location: https://github.com/haskellari/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.6.0.1 && <0.8- , criterion >=1.6.0.0 && <1.7- , random- , splitmix- , tf-random >=0.5 && <0.6--benchmark simple-sum- type: exitcode-stdio-1.0- default-language: Haskell2010- ghc-options: -Wall- hs-source-dirs: bench- main-is: SimpleSum.hs- build-depends:- , base- , random- , splitmix--benchmark range- type: exitcode-stdio-1.0- default-language: Haskell2010- ghc-options: -Wall- hs-source-dirs: bench src-compat- main-is: Range.hs- other-modules: Data.Bits.Compat- build-depends:- , base- , random- , splitmix--test-suite examples- type: exitcode-stdio-1.0- default-language: Haskell2010- ghc-options: -Wall- hs-source-dirs: tests- main-is: Examples.hs- build-depends:- , base- , HUnit >=1.6.0.0 && <1.7- , splitmix--test-suite splitmix-tests- type: exitcode-stdio-1.0- default-language: Haskell2010- ghc-options: -Wall- hs-source-dirs: tests- main-is: Tests.hs- other-modules:- MiniQC- Uniformity-- build-depends:- , base- , containers >=0.4.0.0 && <0.8- , HUnit >=1.6.0.0 && <1.7- , math-functions >=0.3.3.0 && <0.4- , splitmix- , test-framework >=0.8.2.0 && <0.9- , test-framework-hunit >=0.3.0.2 && <0.4--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 montecarlo-pi-32+test-suite splitmix-examples type: exitcode-stdio-1.0 default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: tests- main-is: SplitMixPi32.hs- build-depends:- , base- , splitmix--test-suite splitmix-dieharder- default-language: Haskell2010- type: exitcode-stdio-1.0- ghc-options: -Wall -threaded -rtsopts- hs-source-dirs: tests- main-is: Dieharder.hs- build-depends:- , async >=2.2.1 && <2.3- , base- , bytestring >=0.10.8.2 && <0.13- , deepseq- , process >=1.6.0.0 && <1.7- , random- , splitmix- , tf-random >=0.5 && <0.6- , vector >=0.13.0.0 && <0.14--test-suite splitmix-testu01- if !os(linux)- buildable: False-- default-language: Haskell2010- type: exitcode-stdio-1.0- ghc-options: -Wall -threaded -rtsopts- hs-source-dirs: tests- main-is: TestU01.hs- c-sources: tests/cbits/testu01.c- extra-libraries: testu01- build-depends:- , base- , base-compat-batteries >=0.10.5 && <0.15- , splitmix--test-suite initialization- default-language: Haskell2010- type: exitcode-stdio-1.0- ghc-options: -Wall -threaded -rtsopts- hs-source-dirs: tests- main-is: Initialization.hs+ main-is: splitmix-examples.hs build-depends: , base , HUnit >=1.6.0.0 && <1.7
− src-compat/Data/Bits/Compat.hs
@@ -1,9 +0,0 @@-{-# LANGUAGE CPP #-}-module Data.Bits.Compat (- popCount,- zeroBits,- finiteBitSize,- countLeadingZeros,- ) where--import Data.Bits (popCount, zeroBits, finiteBitSize, countLeadingZeros)
src/System/Random/SplitMix.hs view
@@ -49,7 +49,7 @@ ) where import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.))-import Data.Bits.Compat (countLeadingZeros, popCount, zeroBits)+import Data.Bits (countLeadingZeros, popCount, zeroBits) import Data.IORef (IORef, atomicModifyIORef, newIORef) import Data.Word (Word32, Word64) import System.IO.Unsafe (unsafePerformIO)
src/System/Random/SplitMix32.hs view
@@ -32,7 +32,7 @@ ) where import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.))-import Data.Bits.Compat+import Data.Bits (countLeadingZeros, finiteBitSize, popCount, zeroBits) import Data.IORef (IORef, atomicModifyIORef, newIORef) import Data.Word (Word32, Word64)
− tests/Dieharder.hs
@@ -1,273 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Main (main) where--import Control.Concurrent.QSem-import Control.DeepSeq (force)-import Control.Monad (when)-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, stdout)-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.SplitMix32 as SM32-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, raw, _help) <- parseArgsIO args $ (,,,,,,)- <$> arg- <*> optDef "-n" 1- <*> optDef "-j" 1- <*> opt "-s"- <*> opt "-d"- <*> flag "-r"- <*> flag "-h"-- let run :: RunType g- run | raw = runRaw- | otherwise = runManaged-- case cmd of- "splitmix" -> do- g <- maybe SM.initSMGen (return . SM.mkSMGen) seed- run test runs conc SM.splitSMGen SM.nextWord64 g- "splitmix32" -> do- g <- maybe SM32.initSMGen (return . SM32.mkSMGen) (fmap fromIntegral seed)- run test runs conc SM32.splitSMGen SM32.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----------------------------------------------------------------------------------type RunType g =- Maybe Int- -> Int- -> Int- -> (g -> (g, g))- -> (g -> (Word64, g))- -> g- -> IO () --runRaw :: RunType g-runRaw _test _runs _conc split word gen =- generate word split gen stdout--runManaged :: RunType g-runManaged 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 split 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 runManaged #-}--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 -> (g, g))- -> g -> Handle -> IO ()-generate word split gen0 h = do- vec <- MSV.new size- go gen0 vec- where- go :: g -> MSV.IOVector Word64 -> IO ()- go gen vec = do- let (g1, g2) = split gen- write g1 vec 0- MSV.unsafeWith vec $ \ptr -> do- bs <- BS.unsafePackCStringLen (castPtr ptr, size * 8)- BS.hPutStr h bs- go g2 vec-- write :: g -> MSV.IOVector Word64 -> Int -> IO ()- write !gen !vec !i = do- let (w64, gen') = word gen- MSV.unsafeWrite vec i w64- when (i < size) $- write gen' vec (i + 1)-{-# 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"
− tests/Examples.hs
@@ -1,15 +0,0 @@-module Main (main) where--import Test.HUnit ((@?=))--import qualified System.Random.SplitMix32 as SM32--main :: IO ()-main = do- let g = SM32.mkSMGen 42- show g @?= "SMGen 142593372 1604540297"- print g-- let (w32, g') = SM32.nextWord32 g- w32 @?= 1296549791- show g' @?= "SMGen 1747133669 1604540297"
− tests/Initialization.hs
@@ -1,28 +0,0 @@-module Main (main) where--import Control.Monad (forM_, replicateM)-import Data.List (tails)-import Test.HUnit (assertFailure)--import qualified System.Random.SplitMix as SM-import qualified System.Random.SplitMix32 as SM32--main :: IO ()-main = do- g64 <- replicateM 10 (fmap show SM.initSMGen)- putStrLn $ unlines g64- forM_ (tails g64) $ \xs' -> case xs' of- [] -> return ()- (x:xs) ->- if all (x /=) xs- then return ()- else assertFailure "ERROR: duplicate"-- g32 <- replicateM 10 (fmap show SM32.initSMGen)- putStrLn $ unlines g32- forM_ (tails g32) $ \xs' -> case xs' of- [] -> return ()- (x:xs) ->- if all (x /=) xs- then return ()- else assertFailure "ERROR: duplicate"
− tests/MiniQC.hs
@@ -1,81 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}--- | This QC doesn't shrink :(-module MiniQC where--import Control.Monad (ap)-import Data.Int (Int32, Int64)-import Data.Word (Word32, Word64)-import Test.Framework.Providers.API (Test, TestName)-import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit (assertFailure)--import System.Random.SplitMix--newtype Gen a = Gen { unGen :: SMGen -> a }- deriving (Functor)--instance Applicative Gen where- pure x = Gen (const x)- (<*>) = ap--instance Monad Gen where- return = pure-- m >>= k = Gen $ \g ->- let (g1, g2) = splitSMGen g- in unGen (k (unGen m g1)) g2--class Arbitrary a where- arbitrary :: Gen a--instance Arbitrary Word32 where- arbitrary = Gen $ \g -> fst (nextWord32 g)-instance Arbitrary Word64 where- arbitrary = Gen $ \g -> fst (nextWord64 g)-instance Arbitrary Int32 where- arbitrary = Gen $ \g -> fromIntegral (fst (nextWord32 g))-instance Arbitrary Int64 where- arbitrary = Gen $ \g -> fromIntegral (fst (nextWord64 g))-instance Arbitrary Double where- arbitrary = Gen $ \g -> fst (nextDouble g)--newtype Property = Property { unProperty :: Gen ([String], Bool) }--class Testable a where- property :: a -> Property--instance Testable Property where- property = id--instance Testable Bool where- property b = Property $ pure ([show b], b)--instance (Arbitrary a, Show a, Testable b) => Testable (a -> b) where- property f = Property $ do- x <- arbitrary- (xs, b) <- unProperty (property (f x))- return (show x : xs, b)--forAllBlind :: Testable prop => Gen a -> (a -> prop) -> Property-forAllBlind g f = Property $ do- x <- g- (xs, b) <- unProperty (property (f x))- return ("<blind>" : xs, b)--counterexample :: Testable prop => String -> prop -> Property-counterexample msg prop = Property $ do- (xs, b) <- unProperty (property prop)- return (msg : xs, b)--testMiniProperty :: Testable prop => TestName -> prop -> Test-testMiniProperty name prop = testCase name $ do- g <- newSMGen- go (100 :: Int) g- where- go n _ | n <= 0 = return ()- go n g = do- let (g1, g2) = splitSMGen g- case unGen (unProperty (property prop)) g1 of- (_, True) -> return ()- (xs, False) -> assertFailure (unlines (reverse xs))- go (pred n) g2
− tests/SplitMixPi.hs
@@ -1,27 +0,0 @@-module 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 50000000 . 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')
− tests/SplitMixPi32.hs
@@ -1,27 +0,0 @@-module Main (main) where--import Data.List (unfoldr, foldl')-import System.Random.SplitMix32--doubles :: SMGen -> [Float]-doubles = unfoldr (Just . nextFloat)--monteCarloPi :: SMGen -> Float-monteCarloPi = (4 *) . calc . foldl' accum (P 0 0) . take 50000000 . 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 :: Float)- print pi'- print (pi - pi')
− tests/TestU01.hs
@@ -1,185 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Main (main) where--import Prelude ()-import Prelude.Compat--import Data.Char (isSpace)-import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Data.Maybe (fromMaybe)-import Data.Word (Word32)-import System.Environment (getArgs)-import System.IO.Unsafe (unsafePerformIO)--import qualified System.Random.SplitMix as SM64-import qualified System.Random.SplitMix32 as SM32------------------------------------------------------------------------------------ SplitMix32----------------------------------------------------------------------------------sm32ref :: IORef SM32.SMGen-sm32ref = unsafePerformIO $ newIORef $ SM32.mkSMGen 42-{-# NOINLINE sm32ref #-}--foreign export ccall haskell_splitmix32 :: IO Word32-foreign export ccall haskell_splitmix32_double :: IO Double--haskell_splitmix32 :: IO Word32-haskell_splitmix32 = do- g <- readIORef sm32ref- let !(w32, g') = SM32.nextWord32 g- writeIORef sm32ref g'- return w32--haskell_splitmix32_double :: IO Double-haskell_splitmix32_double = do- g <- readIORef sm32ref- let !(d, g') = SM32.nextDouble g- writeIORef sm32ref g'- return d------------------------------------------------------------------------------------ SplitMix64----------------------------------------------------------------------------------sm64ref :: IORef SM64.SMGen-sm64ref = unsafePerformIO $ newIORef $ SM64.mkSMGen 42-{-# NOINLINE sm64ref #-}--foreign export ccall haskell_splitmix64 :: IO Word32-foreign export ccall haskell_splitmix64_double :: IO Double--haskell_splitmix64 :: IO Word32-haskell_splitmix64 = do- g <- readIORef sm64ref- let !(w32, g') = SM64.nextWord32 g- writeIORef sm64ref g'- return w32--haskell_splitmix64_double :: IO Double-haskell_splitmix64_double = do- g <- readIORef sm64ref- let !(d, g') = SM64.nextDouble g- writeIORef sm64ref g'- return d------------------------------------------------------------------------------------ Main----------------------------------------------------------------------------------foreign import ccall "run_testu01" run_testu01_c :: Int -> Int -> IO ()--main :: IO ()-main = do- args <- getArgs- (gen, bat) <- parseArgsIO args $ (,)- <$> optDef "-g" SplitMix- <*> optDef "-b" SmallCrush- run_testu01_c (fromEnum gen) (fromEnum bat)--data Gen- = SplitMixDouble- | SplitMix- | SplitMix32Double- | SplitMix32- | SplitMix32Native- deriving (Read, Enum)--data Bat- = SmallCrush- | Crush- | BigCrush- | Sample- deriving (Read, Enum)------------------------------------------------------------------------------------ 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"
− tests/Tests.hs
@@ -1,136 +0,0 @@-module Main (main) where--import Data.Bits ((.&.))-import Data.Int (Int64)-import Data.Word (Word64)-import Test.Framework (defaultMain, testGroup)--import qualified System.Random.SplitMix as SM-import qualified System.Random.SplitMix32 as SM32--import MiniQC (Arbitrary (..), Gen (..), counterexample, testMiniProperty)-import Uniformity--main :: IO ()-main = defaultMain- [ testUniformity "SM64 uniformity" (arbitrary :: Gen Word64) (.&. 0xf) 16- , testUniformity "SM64 uniformity" (arbitrary :: Gen Word64) (.&. 0xf0) 16-- , testUniformity "bitmaskWithRejection uniformity" (arbitrary :: Gen Word64mod7) id 7-- , testGroup "nextInteger"- [ testMiniProperty "valid" $ \a b c d seed -> do- let lo' = fromIntegral (a :: Int64) * fromIntegral (b :: Int64)- hi' = fromIntegral (c :: Int64) * fromIntegral (d :: Int64)-- lo = min lo' hi'- hi = max lo' hi'-- let g = SM.mkSMGen seed- (x, _) = SM.nextInteger lo' hi' g-- counterexample (show x) $ lo <= x && x <= hi-- , testMiniProperty "valid small" $ \a b seed -> do- let lo' = fromIntegral (a :: Int64) `rem` 10- hi' = fromIntegral (b :: Int64) `rem` 10-- lo = min lo' hi'- hi = max lo' hi'-- let g = SM.mkSMGen seed- (x, _) = SM.nextInteger lo' hi' g-- counterexample (show x) $ lo <= x && x <= hi-- , testMiniProperty "I1 valid" i1valid- , testUniformity "I1 uniform" arbitrary (\(I1 w) -> w) 15-- , testMiniProperty "I7 valid" i7valid- , testUniformity "I7 uniform" arbitrary (\(I7 w) -> w `mod` 7) 7- ]-- , testGroup "SM bitmaskWithRejection"- [ testMiniProperty "64" $ \w' seed -> do- let w = w' .&. 0xff- let w1 = w + 1- let g = SM.mkSMGen seed- let (x, _) = SM.bitmaskWithRejection64 w1 g- counterexample ("64-64 " ++ show x ++ " <= " ++ show w) (x < w1)- , testMiniProperty "64'" $ \w' seed -> do- let w = w' .&. 0xff- let g = SM.mkSMGen seed- let (x, _) = SM.bitmaskWithRejection64' w g- counterexample ("64-64 " ++ show x ++ " < " ++ show w) (x <= w)- , testMiniProperty "32" $ \w' seed -> do- let w = w' .&. 0xff- let u1 = w'- let g = SM.mkSMGen seed- let (x, _) = SM.bitmaskWithRejection32 u1 g- counterexample ("64-32 " ++ show x ++ " <= " ++ show w) (x < u1)- , testMiniProperty "32'" $ \w' seed -> do- let w = w' .&. 0xff- let u = w- let g = SM.mkSMGen seed- let (x, _) = SM.bitmaskWithRejection32' u g- counterexample ("64-32 " ++ show x ++ " < " ++ show w) (x <= u)- ]- , testGroup "SM32 bitmaskWithRejection"- [ testMiniProperty "64" $ \w' seed -> do- let w = w' .&. 0xff- let w1 = w + 1- let g = SM32.mkSMGen seed- let (x, _) = SM32.bitmaskWithRejection64 w1 g- counterexample ("64-64 " ++ show x ++ " <= " ++ show w) (x < w1)- , testMiniProperty "64'" $ \w' seed -> do- let w = w' .&. 0xff- let g = SM32.mkSMGen seed- let (x, _) = SM32.bitmaskWithRejection64' w g- counterexample ("64-64 " ++ show x ++ " < " ++ show w) (x <= w)- , testMiniProperty "32" $ \w' seed -> do- let w = w' .&. 0xff- let u1 = w'- let g = SM32.mkSMGen seed- let (x, _) = SM32.bitmaskWithRejection32 u1 g- counterexample ("64-32 " ++ show x ++ " <= " ++ show w) (x < u1)- , testMiniProperty "32'" $ \w' seed -> do- let w = w' .&. 0xff- let u = w- let g = SM32.mkSMGen seed- let (x, _) = SM32.bitmaskWithRejection32' u g- counterexample ("64-32 " ++ show x ++ " < " ++ show w) (x <= u)- ]- ]--newtype Word64mod7 = W7 Word64 deriving (Eq, Ord, Show)-instance Arbitrary Word64mod7 where- arbitrary = Gen $ \g -> W7 $ fst $ SM.bitmaskWithRejection64' 6 g--newtype Integer1 = I1 Integer deriving (Eq, Ord, Show)-instance Arbitrary Integer1 where- arbitrary = Gen $ \g -> I1 $ fst $ SM.nextInteger i1min i1max g--i1min :: Integer-i1min = -7--i1max :: Integer-i1max = 7--i1valid :: Integer1 -> Bool-i1valid (I1 i) = i1min <= i && i <= i1max--newtype Integer7 = I7 Integer deriving (Eq, Ord, Show)-instance Arbitrary Integer7 where- arbitrary = Gen $ \g -> I7 $ fst $ SM.nextInteger i7min i7max g--i7min :: Integer-i7min = negate two64--i7max :: Integer-i7max = two64 * 6 + 7 * 1234567--i7valid :: Integer7 -> Bool-i7valid (I7 i) = i7min <= i && i <= i7max--two64 :: Integer-two64 = 2 ^ (64 :: Int)
− tests/Uniformity.hs
@@ -1,134 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE ScopedTypeVariables #-}--- | Chi-Squared test for uniformity.-module Uniformity (testUniformity) where--import Data.List (intercalate)-import Data.List (foldl')-import Numeric (showFFloat)-import Numeric.SpecFunctions (incompleteGamma)-import Test.Framework.Providers.API (Test, TestName)--import qualified Data.Map as Map--import MiniQC as QC---- | \( \lim_{n\to\infty} \mathrm{Pr}(V \le v) = \ldots \)-chiDist- :: Int -- ^ k, categories- -> Double -- ^ v, value- -> Double-chiDist k x = incompleteGamma (0.5 * v) (0.5 * x) where- v = fromIntegral (k - 1)---- | When the distribution is uniform,------ \[--- \frac{1}{n} \sum_{s = 1}^k \frac{Y_s^2}{p_s} - n--- \]------ simplifies to------ \[--- \frac{k}{n} \sum_{s=1}^k Y_s^2 - n--- \]------ when \(p_s = \frac{1}{k} \), i.e. \(k\) is the number of buckets.----calculateV :: Int -> Map.Map k Int -> Double-calculateV k data_ = chiDist k v- where- v = fromIntegral k * fromIntegral sumY2 / fromIntegral n - fromIntegral n- V2 n sumY2 = foldl' sumF (V2 0 0) (Map.elems data_) where- sumF (V2 m m2) x = V2 (m + x) (m2 + x * x)---- Strict pair of 'Int's, used as an accumulator.-data V2 = V2 !Int !Int--countStream :: Ord a => Stream a -> Int -> Map.Map a Int-countStream = go Map.empty where- go !acc s n- | n <= 0 = acc- | otherwise = case s of- x :> xs -> go (Map.insertWith (+) x 1 acc) xs (pred n)--testUniformityRaw :: forall a. (Ord a, Show a) => Int -> Stream a -> Either String Double-testUniformityRaw k s- | Map.size m > k = Left $ "Got more elements (" ++ show (Map.size m, take 5 $ Map.keys m) ++ " than expected (" ++ show k ++ ")"- | p > 0.999999 = Left $- "Too impropabable p-value: " ++ show p ++ "\n" ++ table- [ [ show x, showFFloat (Just 3) (fromIntegral y / fromIntegral n :: Double) "" ]- | (x, y) <- take 20 $ Map.toList m- ]- | otherwise = Right p- where- -- each bucket to have roughly 128 elements- n :: Int- n = k * 128-- -- buckets from the stream- m :: Map.Map a Int- m = countStream s n-- -- calculate chi-squared value- p :: Double- p = calculateV k m--testUniformityQC :: (Ord a, Show a) => Int -> Stream a -> QC.Property-testUniformityQC k s = case testUniformityRaw k s of- Left err -> QC.counterexample err False- Right _ -> QC.property True---- | Test that generator produces values uniformly.------ The size is scaled to be at least 20.----testUniformity- :: forall a b. (Ord b, Show b)- => TestName- -> QC.Gen a -- ^ Generator to test- -> (a -> b) -- ^ Partitioning function- -> Int -- ^ Number of partittions- -> Test-testUniformity name gen f k = QC.testMiniProperty name- $ QC.forAllBlind (streamGen gen)- $ testUniformityQC k . fmap f------------------------------------------------------------------------------------ Infinite stream----------------------------------------------------------------------------------data Stream a = a :> Stream a deriving (Functor)-infixr 5 :>--streamGen :: QC.Gen a -> QC.Gen (Stream a)-streamGen g = gs where- gs = do- x <- g- xs <- gs- return (x :> xs)------------------------------------------------------------------------------------ Table----------------------------------------------------------------------------------table :: [[String]] -> String-table cells = unlines rows- where- cols :: Int- rowWidths :: [Int]- rows :: [String]-- (cols, rowWidths, rows) = foldr go (0, repeat 0, []) cells-- go :: [String] -> (Int, [Int], [String]) -> (Int, [Int], [String])- go xs (c, w, yss) =- ( max c (length xs)- , zipWith max w (map length xs ++ repeat 0)- , intercalate " " (take cols (zipWith fill xs rowWidths))- : yss- )-- fill :: String -> Int -> String- fill s n = s ++ replicate (n - length s) ' '
− tests/cbits/testu01.c
@@ -1,138 +0,0 @@-#include "TestU01.h"--#include <stdint.h>--/* Utilities */--inline unsigned int popcount32(uint32_t i) {- i = i - ((i >> 1) & 0x55555555);- i = (i & 0x33333333) + ((i >> 2) & 0x33333333);- return (((i + (i >> 4)) & 0xF0F0F0F) * 0x1010101) >> 24;-}--inline uint64_t rotl64(uint64_t value, unsigned int count) {- return value << count | value >> (64 - count);-}--/* For comparison, SplitMix32 generator in C */-#define GOLDEN_GAMMA 0x9e3779b9U--static uint32_t seed = 0;-static uint32_t gamma = 0;--uint32_t mix32(uint32_t z) {- z = (z ^ (z >> 16)) * 0x85ebca6b;- z = (z ^ (z >> 13)) * 0xc2b2ae35;- z = (z ^ (z >> 16));- return z;-}--uint32_t mix32gamma(uint32_t z) {- z = (z ^ (z >> 16)) * 0x69ad6ccbU;- z = (z ^ (z >> 13)) * 0xcd9ab5b3U;- z = (z ^ (z >> 16));- return z;-}--void splitmix32_init(uint32_t s) {- seed = mix32(s);- gamma = mix32gamma(s + GOLDEN_GAMMA) | 0x1;- if (popcount32(gamma ^ (gamma >> 1)) < 12) {- gamma = gamma ^ 0xaaaaaaaa;- }-}--unsigned int splitmix32() {- seed = seed + gamma;- return mix32(seed);-}--/* Exported from Haskell */-uint32_t haskell_splitmix32();--unsigned int exported_splitmix32() {- return haskell_splitmix32();-}--uint32_t haskell_splitmix64();--unsigned int exported_splitmix64() {- return haskell_splitmix64();-}--double haskell_splitmix64_double();-double haskell_splitmix32_double();--/* Test suite */--int run_testu01(int gen_k, int bat_k) {- /* Create TestU01 PRNG object for our generator */- unsigned int (*funcBits)() = NULL;- double (*func01)() = NULL;- unif01_Gen* gen = NULL;-- switch (gen_k) {- case 0:- func01 = haskell_splitmix64_double;- gen = unif01_CreateExternGen01 ("SplitMix (Double)", haskell_splitmix64_double);- break;-- case 1:- funcBits = exported_splitmix64;- gen = unif01_CreateExternGenBits("SplitMix (low 32bit)", exported_splitmix64);- break;-- case 2:- func01 = haskell_splitmix32_double;- gen = unif01_CreateExternGen01("SplitMix32 (Double)", haskell_splitmix32_double);- break;-- case 3:- funcBits = exported_splitmix32;- gen = unif01_CreateExternGenBits("SplitMix32", exported_splitmix32);- break;-- default:- splitmix32_init(42);- printf("Initial state: %u %u\n", seed, gamma);-- funcBits = splitmix32;- gen = unif01_CreateExternGenBits("SplitMix32 (C implementation)", splitmix32);- }-- /* Run the tests. */- switch (bat_k) {- case 0:- bbattery_SmallCrush(gen);- break;-- case 1:- bbattery_Crush(gen);- break;-- case 2:- bbattery_BigCrush(gen);- break;-- default:- if (funcBits != NULL) {- for (int i = 0; i < 32; i++) {- printf("%x\n", funcBits());- }- }-- if (func01 != NULL) {- for (int i = 0; i < 32; i++) {- printf("%.09lf\n", func01());- }- }- }-- if (funcBits != NULL) {- unif01_DeleteExternGenBits(gen);- } else if (func01 != NULL) {- unif01_DeleteExternGen01(gen);- }-- return 0;-}
+ tests/splitmix-examples.hs view
@@ -0,0 +1,15 @@+module Main (main) where++import Test.HUnit ((@?=))++import qualified System.Random.SplitMix32 as SM32++main :: IO ()+main = do+ let g = SM32.mkSMGen 42+ show g @?= "SMGen 142593372 1604540297"+ print g++ let (w32, g') = SM32.nextWord32 g+ w32 @?= 1296549791+ show g' @?= "SMGen 1747133669 1604540297"