pcg-random 0.1.3.2 → 0.1.3.3
raw patch · 7 files changed
+341/−90 lines, 7 filesdep −time
Dependencies removed: time
Files
- CHANGELOG.md +4/−0
- README.md +1/−1
- pcg-random.cabal +5/−6
- src/System/Random/PCG/Class.hs +5/−6
- src/System/Random/PCG/Fast/Pure.hs +10/−77
- src/System/Random/PCG/Pure.hs +315/−0
- test/doctest.hs +1/−0
CHANGELOG.md view
@@ -1,3 +1,7 @@+### 0.1.3.3++* Added System.Random.PCG.Pure module.+ ### 0.1.3.2 * Added System.Random.PCG.Fast.Pure module.
README.md view
@@ -5,7 +5,7 @@ Haskell bindings to the PCG random number generator http://www.pcg-random.org. -> PCG is a family of simple fast space-efficient statistically good algorithms for random number generation with better-than-typical cryptographic security+> PCG is a family of simple fast space-efficient statistically good algorithms for random number generation. Unlike many general-purpose RNGs, they are also hard to predict. Implements the standard multiple stream generator as well as the fast, single and unique variants.
pcg-random.cabal view
@@ -1,11 +1,10 @@ name: pcg-random-version: 0.1.3.2+version: 0.1.3.3 synopsis: Haskell bindings to the PCG random number generator. description: PCG is a family of simple fast space-efficient statistically good- algorithms for random number generation with better-than-typical- cryptographic security. See http://http://www.pcg-random.org for more- information.+ algorithms for random number generation. Unlike many general-purpose+ RNGs, they are also hard to predict. . This library implements bindings to the standard C implementation. This includes the standard, unique, fast and single variants in the@@ -36,6 +35,7 @@ library exposed-modules: System.Random.PCG+ System.Random.PCG.Pure System.Random.PCG.Class System.Random.PCG.Fast System.Random.PCG.Fast.Pure@@ -49,8 +49,7 @@ primitive >=0.4 && < 0.7, random >=1.0 && < 2.0, bytestring,- entropy,- time+ entropy default-language: Haskell2010 cc-options: -DMEXP=19937
src/System/Random/PCG/Class.hs view
@@ -426,10 +426,10 @@ bs <- getEntropy 8 useAsCString bs $ peek . castPtr -uniformRange :: ( Generator g m- , Integral a, Bounded a, Variate a- , Integral (Unsigned a), Bounded (Unsigned a), Variate (Unsigned a))- => (a,a) -> g -> m a+uniformRange+ :: (Generator g m, Integral a, Variate a, Integral (Unsigned a),+ Bounded (Unsigned a), Variate (Unsigned a))+ => (a,a) -> g -> m a uniformRange (x1,x2) g | n == 0 = uniform g -- Abuse overflow in unsigned types | otherwise = loop@@ -437,8 +437,7 @@ -- Allow ranges where x2<x1 (i, j) | x1 < x2 = (x1, x2) | otherwise = (x2, x1)- -- (# i, j #) | x1 < x2 = (# x1, x2 #)- -- | otherwise = (# x2, x1 #)+ -- n = 1 + sub j i buckets = maxBound `div` n maxN = buckets * n
src/System/Random/PCG/Fast/Pure.hs view
@@ -13,22 +13,22 @@ {-# LANGUAGE RoleAnnotations #-} #endif -- |--- Module : System.Random.PCG.Fast+-- Module : System.Random.PCG.Fast.Pure -- Copyright : Copyright (c) 2015, Christopher Chalmers <c.chalmers@me.com> -- License : BSD3 -- Maintainer : Christopher Chalmers <c.chalmers@me.com> -- Stability : experimental--- Portability: CPP, FFI+-- Portability: CPP ----- Fast variant of the PCG random number generator. This module performs--- around 20% faster than the multiple streams version but produces slightly--- lower quality (still good) random numbers.+-- Experimental pure haskell version of the fast variant of the PCG+-- random number generator. This module can perform faster than the c+-- bindings version, especially for parallel code. -- -- See <http://www.pcg-random.org> for details. -- -- @ -- import Control.Monad.ST--- import System.Random.PCG.Fast+-- import System.Random.PCG.Fast.Pure -- -- three :: [Double] -- three = runST $ do@@ -47,8 +47,6 @@ , Variate (..) , advance, retract - , u1, u2, u3, Pair (..), pair, nxt, bounded, state, output- -- * Seeds , FrozenGen, save, restore, seed, initFrozen @@ -81,6 +79,7 @@ newtype FrozenGen = F Word64 deriving (Show, Eq, Ord, Prim) +-- | State of the random number generator. newtype Gen s = G (MutableByteArray s) type GenIO = Gen RealWorld@@ -121,7 +120,7 @@ go !s | r >= t = P s' (r `mod` b) | otherwise = go s' where P s' r = pair s-{- INLINE bounded #-}+{-# INLINE bounded #-} advancing :: Word64 -- amount to advance by@@ -143,37 +142,10 @@ advanceFast :: Word64 -> FrozenGen -> FrozenGen advanceFast d (F s) = F $ advancing d s fastMultiplier 0 -nxt :: FrozenGen -> (Word32, FrozenGen)-nxt (F s) = (w, F s')- where- P s' w = pair s---- uint64_t pcg_advance_lcg_64(uint64_t state, uint64_t delta, uint64_t cur_mult,--- uint64_t cur_plus)--- {--- uint64_t acc_mult = 1u;--- uint64_t acc_plus = 0u;--- while (delta > 0) {--- if (delta & 1) {--- acc_mult *= cur_mult;--- acc_plus = acc_plus * cur_mult + cur_plus;--- }--- cur_plus = (cur_mult + 1) * cur_plus;--- cur_mult *= cur_mult;--- delta /= 2;--- }--- return acc_mult * state + acc_plus;--- }- ------------------------------------------------------------------------ -- Seed ------------------------------------------------------------------------ --- | Immutable state of a random number generator. Suitable for storing--- for later use.--- newtype FrozenGen = FrozenGen Word64--- deriving (Show, Eq, Ord, Storable, Data, Typeable, Generic)- -- | Save the state of a 'Gen' in a 'Seed'. save :: PrimMonad m => Gen (PrimState m) -> m FrozenGen save (G a) = readByteArray a 0@@ -202,20 +174,6 @@ create :: PrimMonad m => m (Gen (PrimState m)) create = restore seed ---------------------------------------------------------------------------- Gen----------------------------------------------------------------------------- | State of the random number generator--- newtype Gen s = Gen (MutableByteArray s)--- deriving (Eq, Ord)--- #if __GLASGOW_HASKELL__ >= 707--- type role Gen representational--- #endif---- type GenIO = Gen RealWorld--- type GenST = Gen- -- | Initialize a generator a single word. -- -- >>> initialize 0 >>= save@@ -235,11 +193,6 @@ createSystemRandom :: IO GenIO createSystemRandom = withSystemRandom (return :: GenIO -> IO GenIO) --- -- | Generate a uniform 'Word32' bounded by the given bound.--- uniformB :: PrimMonad m => Word32 -> Gen (PrimState m) -> m Word32--- uniformB u (Gen p) = unsafePrimToPrim $ pcg32f_boundedrand_r p u--- {-# INLINE uniformB #-}- -- | Advance the given generator n steps in log(n) time. (Note that a -- \"step\" is a single random 32-bit (or less) 'Variate'. Data types -- such as 'Double' or 'Word64' require two \"steps\".)@@ -272,28 +225,6 @@ -- Instances ------------------------------------------------------------------------ -u1 :: GenIO -> IO Word32-u1 (G !a) = do- s <- readByteArray a 0- let P s' r = pair s- writeByteArray a 0 s'- return r-{-# INLINE u1 #-}--u2 :: GenIO -> IO Word32-u2 (G a) = do- s <- readByteArray a 0- let P s' r = pair s- writeByteArray a 0 s'- return r--u3 :: GenIO -> IO Word32-u3 (G a) = do- s <- readByteArray a 0- let P s' r = pair s- writeByteArray a 0 s'- return $! r- instance (PrimMonad m, s ~ PrimState m) => Generator (Gen s) m where uniform1 f (G a) = do s <- readByteArray a 0@@ -321,6 +252,7 @@ where P s' w1 = pair s P s'' w2 = pair s'+ {-# INLINE next #-} split (F s) = (mk w1 w2, mk w3 w4) where@@ -329,4 +261,5 @@ P s2 w2 = pair s1 P s3 w3 = pair s2 w4 = output s3 -- abandon old state+ {-# INLINE split #-}
+ src/System/Random/PCG/Pure.hs view
@@ -0,0 +1,315 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}+#if __GLASGOW_HASKELL__ >= 707+{-# LANGUAGE RoleAnnotations #-}+#endif+-- |+-- Module : System.Random.PCG.Pure+-- Copyright : Copyright (c) 2015, Christopher Chalmers <c.chalmers@me.com>+-- License : BSD3+-- Maintainer : Christopher Chalmers <c.chalmers@me.com>+-- Stability : experimental+-- Portability: CPP+--+-- Standard PCG Random Number Generator with chosen streams, written in+-- pure haskell. See <http://www.pcg-random.org> for details.+--+-- @+-- import Control.Monad.ST+-- import System.Random.PCG.Pure+--+-- three :: [Double]+-- three = runST $ do+-- g <- create+-- a <- uniform g+-- b <- uniform g+-- c <- uniform g+-- return [a,b,c]+-- @+module System.Random.PCG.Pure+ ( -- * Gen+ Gen, GenIO, GenST+ , create, createSystemRandom, initialize, withSystemRandom++ -- * Getting random numbers+ , Variate (..)+ , advance, retract++ -- * Seeds+ , FrozenGen, save, restore, seed, initFrozen++ -- * Type restricted versions+ -- ** uniform+ , uniformW8, uniformW16, uniformW32, uniformW64+ , uniformI8, uniformI16, uniformI32, uniformI64+ , uniformF, uniformD, uniformBool++ -- ** uniformR+ , uniformRW8, uniformRW16, uniformRW32, uniformRW64+ , uniformRI8, uniformRI16, uniformRI32, uniformRI64+ , uniformRF, uniformRD, uniformRBool++ -- ** uniformB+ , uniformBW8, uniformBW16, uniformBW32, uniformBW64+ , uniformBI8, uniformBI16, uniformBI32, uniformBI64+ , uniformBF, uniformBD, uniformBBool++ -- * Pure+ , SetSeq+ , next'+ , advanceSetSeq+ ) where+++import Control.Monad.Primitive+import Data.Bits+import Data.Data+import Data.Primitive.ByteArray+import Foreign+import GHC.Generics++import System.Random.PCG.Class+import System.Random++-- $setup+-- >>> import System.Random.PCG.Pure+-- >>> import System.Random.PCG.Class+-- >>> import Control.Monad++type GenIO = Gen RealWorld+type GenST = Gen++-- | State of the random number generator+newtype Gen s = G (MutableByteArray s)++type FrozenGen = SetSeq++-- | The multiple sequence varient of the pcg random number generator.+data SetSeq = SetSeq+ {-# UNPACK #-} !Word64 -- step+ {-# UNPACK #-} !Word64 -- sequence+ deriving (Show, Ord, Eq, Data, Typeable, Generic)++instance Storable SetSeq where+ sizeOf _ = 16+ {-# INLINE sizeOf #-}+ alignment _ = 8+ {-# INLINE alignment #-}+ poke ptr (SetSeq x y) = poke ptr' x >> pokeElemOff ptr' 1 y+ where ptr' = castPtr ptr+ {-# INLINE poke #-}+ peek ptr = SetSeq <$> peek ptr' <*> peekElemOff ptr' 1+ where ptr' = castPtr ptr+ {-# INLINE peek #-}++-- | Fixed seed.+seed :: SetSeq+seed = SetSeq 9600629759793949339 15726070495360670683++-- Internals -----------------------------------------------------------++-- All operations are done via Pair to ensure everything's strict. Ghc+-- is normally pretty good at inlining this, so Pair rarely exists in+-- core.+data Pair = Pair+ {-# UNPACK #-} !Word64 -- step+ {-# UNPACK #-} !Word32 -- output++multiplier :: Word64+multiplier = 6364136223846793005++-- A single step in the generator+state :: SetSeq -> Word64+state (SetSeq s inc) = s * multiplier + inc+{-# INLINE state #-}++-- The random number output+output :: Word64 -> Word32+output s =+ (shifted `unsafeShiftR` rot) .|. (shifted `unsafeShiftL` (negate rot .&. 31))+ where+ rot = fromIntegral $ s `shiftR` 59 :: Int+ shifted = fromIntegral $ ((s `shiftR` 18) `xor` s) `shiftR` 27 :: Word32+{-# INLINE output #-}++-- increment the sequence by one+pair :: SetSeq -> Pair+pair g@(SetSeq s _) = Pair (state g) (output s)+{-# INLINE pair #-}++-- Given some bound and the generator, compute the new step and bounded+-- random number.+bounded :: Word32 -> SetSeq -> Pair+bounded b (SetSeq s0 inc) = go s0+ where+ t = negate b `mod` b+ go !s | r >= t = Pair s' (r `mod` b)+ | otherwise = go s'+ where Pair s' r = pair (SetSeq s inc)+{-# INLINE bounded #-}++advancing+ :: Word64 -- amount to advance by+ -> Word64 -- state+ -> Word64 -- multiplier+ -> Word64 -- increment+ -> Word64 -- new state+advancing d0 s m0 p0 = go d0 m0 p0 1 0+ where+ go d cm cp am ap+ | d <= 0 = am * s + ap+ | odd d = go d' cm' cp' (am * cm) (ap * cm + cp)+ | otherwise = go d' cm' cp' am ap+ where+ cm' = cm * cm+ cp' = (cm + 1) * cp+ d' = d `div` 2++-- | Pure version of 'advance'.+advanceSetSeq :: Word64 -> FrozenGen -> FrozenGen+advanceSetSeq d (SetSeq s inc) = SetSeq (advancing d s multiplier inc) inc++advanceSetSeq' :: Word64 -> FrozenGen -> Word64+advanceSetSeq' d (SetSeq s inc) = advancing d s multiplier inc++-- | Create a new generator from two words.+start :: Word64 -> Word64 -> SetSeq+start a b = SetSeq s i+ where+ s = state (SetSeq (a + i) i)+ i = (b `shiftL` 1) .|. 1+{-# INLINE start #-}++-- | Version of 'next' that returns a 'Word32'.+next' :: SetSeq -> (Word32, SetSeq)+next' g@(SetSeq _ inc) = (r, SetSeq s' inc)+ where Pair s' r = pair g+{-# INLINE next' #-}++-- Multable ------------------------------------------------------------++-- | Save the state of a 'Gen' in a 'Seed'.+save :: PrimMonad m => Gen (PrimState m) -> m SetSeq+save (G a) = SetSeq <$> readByteArray a 0 <*> readByteArray a 8+{-# INLINE save #-}++-- | Restore a 'Gen' from a 'Seed'.+restore :: PrimMonad m => FrozenGen -> m (Gen (PrimState m))+restore (SetSeq s inc) = do+ a <- newByteArray 16+ writeByteArray a 0 s+ writeByteArray a 8 inc+ return $! G a+{-# INLINE restore #-}++-- | Create a new generator from two words.+--+-- >>> initFrozen 0 0+-- SetSeq 6364136223846793006 1+initFrozen :: Word64 -> Word64 -> SetSeq+initFrozen = start++-- | Create a 'Gen' from a fixed initial seed.+create :: PrimMonad m => m (Gen (PrimState m))+create = restore seed++-- | Initialize a generator a single word.+--+-- >>> initialize 0 0 >>= save+-- SetSeq 6364136223846793006 1+initialize :: PrimMonad m => Word64 -> Word64 -> m (Gen (PrimState m))+initialize a b = restore (initFrozen a b)++-- | Seed with system random number. (@\/dev\/urandom@ on Unix-like+-- systems and CryptAPI on Windows).+withSystemRandom :: (GenIO -> IO a) -> IO a+withSystemRandom f = do+ a <- sysRandom+ b <- sysRandom+ initialize a b >>= f++-- | Seed with system random number. (@\/dev\/urandom@ on Unix-like+-- systems and CryptAPI on Windows).+createSystemRandom :: IO GenIO+createSystemRandom = withSystemRandom return++-- | Advance the given generator n steps in log(n) time. (Note that a+-- \"step\" is a single random 32-bit (or less) 'Variate'. Data types+-- such as 'Double' or 'Word64' require two \"steps\".)+--+-- >>> create >>= \g -> replicateM_ 1000 (uniformW32 g) >> uniformW32 g+-- 3640764222+-- >>> create >>= \g -> replicateM_ 500 (uniformD g) >> uniformW32 g+-- 3640764222+-- >>> create >>= \g -> advance 1000 g >> uniformW32 g+-- 3640764222+advance :: PrimMonad m => Word64 -> Gen (PrimState m) -> m ()+advance u g@(G a) = do+ ss <- save g+ let s' = advanceSetSeq' u ss+ writeByteArray a 0 s'+{-# INLINE advance #-}++-- | Retract the given generator n steps in log(2^64-n) time. This+-- is just @advance (-n)@.+--+-- >>> create >>= \g -> replicateM 3 (uniformW32 g)+-- [355248013,41705475,3406281715]+-- >>> create >>= \g -> retract 1 g >> replicateM 3 (uniformW32 g)+-- [19683962,355248013,41705475]+retract :: PrimMonad m => Word64 -> Gen (PrimState m) -> m ()+retract u g = advance (-u) g+{-# INLINE retract #-}++------------------------------------------------------------------------+-- Instances+------------------------------------------------------------------------++instance (PrimMonad m, s ~ PrimState m) => Generator (Gen s) m where+ uniform1 f (G a) = do+ s <- readByteArray a 0+ inc <- readByteArray a 8+ writeByteArray a 0 $! s * multiplier + inc+ return $! f (output s)+ {-# INLINE uniform1 #-}++ uniform2 f (G a) = do+ s <- readByteArray a 0+ inc <- readByteArray a 8+ let !s' = s * multiplier + inc+ writeByteArray a 0 $! s' * multiplier + inc+ return $! f (output s) (output s')+ {-# INLINE uniform2 #-}++ uniform1B f b g@(G a) = do+ ss <- save g+ let Pair s' r = bounded b ss+ writeByteArray a 0 s'+ return $! f r+ {-# INLINE uniform1B #-}++instance RandomGen FrozenGen where+ next (SetSeq s inc) = (wordsTo64Bit w1 w2, SetSeq s'' inc)+ where+ Pair s' w1 = pair (SetSeq s inc)+ Pair s'' w2 = pair (SetSeq s' inc)+ {-# INLINE next #-}++ split (SetSeq s inc) = (SetSeq s4 inc, mk w1 w2 w3 w4)+ where+ mk a b c d = start (wordsTo64Bit a b) (wordsTo64Bit c d)+ Pair s1 w1 = pair (SetSeq s inc)+ Pair s2 w2 = pair (SetSeq s1 inc)+ Pair s3 w3 = pair (SetSeq s2 inc)+ Pair s4 w4 = pair (SetSeq s3 inc)+ {-# INLINE split #-}+
test/doctest.hs view
@@ -3,6 +3,7 @@ main = doctest [ "src/System/Random/PCG.hs" , "src/System/Random/PCG/Class.hs"+ , "src/System/Random/PCG/Pure.hs" , "src/System/Random/PCG/Fast.hs" , "src/System/Random/PCG/Single.hs" , "dist/build/c/pcg-advance-64.o"