splitmix 0.1.0.3 → 0.1.0.4
raw patch · 5 files changed
+355/−9 lines, 5 filesdep ~basedep ~base-compatdep ~base-compat-batteriesPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, base-compat, base-compat-batteries, bytestring, time
API changes (from Hackage documentation)
Files
- Changelog.md +4/−0
- splitmix.cabal +27/−9
- tests/Dieharder.hs +1/−0
- tests/TestU01.hs +185/−0
- tests/cbits/testu01.c +138/−0
Changelog.md view
@@ -1,3 +1,7 @@+# 0.1.0.4++- Add TestU01 test-suite+ # 0.1.0.3 - Fix oops bugs in 0.1.0.2
splitmix.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: splitmix-version: 0.1.0.3+version: 0.1.0.4 synopsis: Fast Splittable PRNG description: Pure Haskell implementation of SplitMix described in@@ -44,13 +44,15 @@ || ==8.4.4 || ==8.6.5 || ==8.8.4- || ==8.10.2+ || ==8.10.4+ || ==9.0.1+ || ==9.2.1 , GHCJS ==8.4 extra-source-files:- README.md Changelog.md make-hugs.sh+ README.md test-hugs.sh flag optimised-mixer@@ -75,7 +77,7 @@ -- ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html build-depends:- base >=4.3 && <4.16+ base >=4.3 && <4.17 , deepseq >=1.3.0.0 && <1.5 if flag(optimised-mixer)@@ -100,7 +102,7 @@ else cpp-options: -DSPLITMIX_INIT_COMPAT=1- build-depends: time >=1.2.0.3 && <1.11+ build-depends: time >=1.2.0.3 && <1.13 source-repository head type: git@@ -167,7 +169,7 @@ build-depends: base- , base-compat >=0.11.1 && <0.12+ , base-compat >=0.11.1 && <0.13 , containers >=0.4.0.0 && <0.7 , HUnit ==1.3.1.2 || >=1.6.0.0 && <1.7 , math-functions ==0.1.7.0 || >=0.3.3.0 && <0.4@@ -204,8 +206,8 @@ build-depends: async >=2.2.1 && <2.3 , base- , base-compat-batteries >=0.10.5 && <0.12- , bytestring >=0.9.1.8 && <0.11+ , base-compat-batteries >=0.10.5 && <0.13+ , bytestring >=0.9.1.8 && <0.12 , deepseq , process >=1.0.1.5 && <1.7 , random@@ -213,6 +215,22 @@ , tf-random >=0.5 && <0.6 , vector >=0.11.0.0 && <0.13 +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.13+ , splitmix+ test-suite initialization default-language: Haskell2010 type: exitcode-stdio-1.0@@ -221,5 +239,5 @@ main-is: Initialization.hs build-depends: base- , splitmix , HUnit ==1.3.1.2 || >=1.6.0.0 && <1.7+ , splitmix
tests/Dieharder.hs view
@@ -201,6 +201,7 @@ readMaybe s = case readEither s of Left _ -> Nothing Right a -> Just a+ ------------------------------------------------------------------------------- -- Do it yourself command line parsing -------------------------------------------------------------------------------
+ tests/TestU01.hs view
@@ -0,0 +1,185 @@+{-# 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/cbits/testu01.c view
@@ -0,0 +1,138 @@+#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;+}