random 1.1 → 1.2.0
raw patch · 27 files changed
+3822/−758 lines, 27 filesdep +bytestringdep +containersdep +deepseqdep ~basedep ~timesetup-changednew-uploader
Dependencies added: bytestring, containers, deepseq, doctest, gauge, mtl, mwc-random, primitive, rdtsc, smallcheck, split, splitmix, tasty, tasty-expected-failure, tasty-hunit, tasty-smallcheck, transformers, unliftio, vector
Dependency ranges changed: base, time
Files
- .darcs-boring +0/−5
- .gitignore +0/−12
- .travis.yml +0/−5
- CHANGELOG.md +81/−1
- README.md +27/−12
- Setup.hs +0/−2
- System/Random.hs +0/−609
- bench-legacy/BinSearch.hs +149/−0
- bench-legacy/SimpleRNGBench.hs +269/−0
- bench/Main.hs +309/−0
- random.cabal +179/−56
- src/System/Random.hs +500/−0
- src/System/Random/Internal.hs +1111/−0
- src/System/Random/Stateful.hs +721/−0
- test-legacy/Legacy.hs +15/−0
- test-legacy/Random1283.hs +48/−0
- test-legacy/RangeTest.hs +138/−0
- test-legacy/T7936.hs +15/−0
- test-legacy/TestRandomIOs.hs +21/−0
- test-legacy/TestRandomRs.hs +23/−0
- test/Spec.hs +143/−0
- test/Spec/Range.hs +42/−0
- test/Spec/Run.hs +14/−0
- test/doctests.hs +17/−0
- tests/T7936.hs +0/−14
- tests/TestRandomIOs.hs +0/−20
- tests/TestRandomRs.hs +0/−22
− .darcs-boring
@@ -1,5 +0,0 @@-^dist(/|$)-^setup(/|$)-^GNUmakefile$-^Makefile.local$-^.depend(.bak)?$
− .gitignore
@@ -1,12 +0,0 @@-*~--Thumbs.db-.DS_Store--GNUmakefile-dist-install/-ghc.mk--dist-.cabal-sandbox-cabal.sandbox.config
− .travis.yml
@@ -1,5 +0,0 @@-language: haskell-ghc:- - 7.4- - 7.6- - 7.8
CHANGELOG.md view
@@ -1,3 +1,84 @@+# 1.2.0++1. Breaking change which mostly maintains backwards compatibility, see+ "Breaking Changes" below.+2. Support for monadic generators e.g. [mwc-random](https://hackage.haskell.org/package/mwc-random).+3. Monadic adapters for pure generators (providing a uniform monadic+ interface to pure and monadic generators).+4. Faster in all cases except one by more than x18 (N.B. x18 not 18%) and+ some cases (depending on the type) faster by more than x1000 - see+ below for benchmarks.+5. Passes a large number of random number test suites:+ * [dieharder](http://webhome.phy.duke.edu/~rgb/General/dieharder.php "venerable")+ * [TestU01 (SmallCrush, Crush, BigCrush)](http://simul.iro.umontreal.ca/testu01/tu01.html "venerable")+ * [PractRand](http://pracrand.sourceforge.net/ "active")+ * [gjrand](http://gjrand.sourceforge.net/ "active")+ * See [random-quality](https://github.com/tweag/random-quality)+ for details on how to do this yourself.+6. Better quality split as judged by these+ [tests](https://www.cambridge.org/core/journals/journal-of-functional-programming/article/evaluation-of-splittable-pseudorandom-generators/3EBAA9F14939C5BB5560E32D1A132637). Again+ see [random-quality](https://github.com/tweag/random-quality) for+ details on how to do this yourself.+7. Unbiased generation of ranges.+8. Updated tests and benchmarks.+9. [Continuous integration](https://travis-ci.org/github/haskell/random).++### Breaking Changes++Version 1.2.0 introduces these breaking changes:++* requires `base >= 4.8` (GHC-7.10)+* `StdGen` is no longer an instance of `Read`+* `randomIO` and `randomRIO` were extracted from the `Random` class into+ separate functions++In addition, there may be import clashes with new functions, e.g. `uniform` and+`uniformR`.++### Deprecations++Version 1.2.0 introduces `genWord64`, `genWord32` and similar methods to the+`RandomGen` class. The significantly slower method `next` and its companion+`genRange` are now deprecated.++### Issues Addressed++ Issue Number | Description | Comment+--------------|-------------|--------+ [25](https://github.com/haskell/random/issues/25) | The seeds generated by split are not independent | Fixed: changed algorithm to SplitMix, which provides a robust split operation+ [26](https://github.com/haskell/random/issues/26) | Add Random instances for tuples | Addressed: added `Uniform` instances for up to 6-tuples+ [44](https://github.com/haskell/random/issues/44) | Add Random instance for Natural | Addressed: added UniformRange instance for Natural+ [51](https://github.com/haskell/random/issues/51) | Very low throughput | Fixed: see benchmarks below+ [53](https://github.com/haskell/random/issues/53) | incorrect distribution of randomR for floating-point numbers | (\*)+ [55](https://github.com/haskell/random/issues/55) | System/Random.hs:43:1: warning: [-Wtabs] | Fixed: No more tabs+ [58](https://github.com/haskell/random/issues/58) | Why does random for Float and Double produce exactly 24 or 53 bits? | (\*)+ [59](https://github.com/haskell/random/issues/59) | read :: StdGen fails for strings longer than 6 | Addressed: StdGen is no longer an instance of Read++#### Comments++(\*) 1.2 samples more bits but does not sample every `Float` or+`Double`. There are methods to do this but they have some downsides;+see [here](https://github.com/idontgetoutmuch/random/issues/105) for a+fuller discussion.++## Benchmarks++Here are some benchmarks run on a 3.1 GHz Intel Core i7. The full+benchmarks can be run using e.g. `stack bench`. The benchmarks are+measured in milliseconds per 100,000 generations. In some cases, the+performance is over x1000 times better; the minimum performance+increase for the types listed below is more than x36.++ Name | 1.1 Mean | 1.2 Mean+------------|----------|----------+ Float | 27.819 | 0.305+ Double | 50.644 | 0.328+ Integer | 42.332 | 0.332+ Word | 40.739 | 0.027+ Int | 43.847 | 0.028+ Char | 17.009 | 0.462+ Bool | 17.542 | 0.027+ # 1.1 * breaking change to `randomIValInteger` to improve RNG quality and performance see https://github.com/haskell/random/pull/4 and@@ -23,4 +104,3 @@ # 1.0.0.4 bumped version for float/double range bugfix-
README.md view
@@ -1,18 +1,33 @@-The Haskell Standard Library -- Random Number Generation-========================================================-[](http://travis-ci.org/haskell/random)+# The Haskell Standard Library -This library provides a basic interface for (splittable) random number generators.+## Random Number Generation +### Status++| Language | Travis | Coveralls |+|:--------:|:------:|:---------:|+|  | [](http://travis-ci.org/haskell/random) | [](https://coveralls.io/github/haskell/random?branch=master)++| Package | Hackage | Nightly | LTS |+|:-------------------|:-------:|:-------:|:---:|+| [`random`](https://github.com/haskell/random)| [](https://hackage.haskell.org/package/random)| [](https://www.stackage.org/nightly/package/random)| [](https://www.stackage.org/lts/package/random)++### Description++This library provides a basic interface for (splittable) pseudo-random number+generators.+ The API documentation can be found here: - http://hackage.haskell.org/package/random/docs/System-Random.html+> http://hackage.haskell.org/package/random/docs/System-Random.html -A module supplying this interface is required for Haskell 98 (but not Haskell-2010). An older [version]-(http://www.haskell.org/ghc/docs/latest/html/libraries/haskell98/Random.html)-of this library is included with GHC in the haskell98 package. This newer-version, with compatible api, is included in the [Haskell Platform]-(http://www.haskell.org/platform/contents.html).+An [older version][haskell98-version] of this library is included with GHC in+the `haskell98` package. This newer version is included in the [Haskell+Platform][haskell-platform]. -Please report bugs in the Github [issue tracker] (https://github.com/haskell/random/issues) (no longer in the GHC trac).+Please report bugs in the [GitHub issue tracker][issue-tracker] (no longer in+the GHC trac).++[haskell-platform]: http://www.haskell.org/platform/contents.html+[haskell98-version]: https://downloads.haskell.org/~ghc/7.6.3/docs/html/libraries/haskell98/Random.html+[issue-tracker]: https://github.com/haskell/random/issues
Setup.hs view
@@ -1,5 +1,3 @@-module Main (main) where- import Distribution.Simple main :: IO ()
− System/Random.hs
@@ -1,609 +0,0 @@-#if __GLASGOW_HASKELL__ >= 701-{-# LANGUAGE Trustworthy #-}-#endif---------------------------------------------------------------------------------- |--- Module : System.Random--- Copyright : (c) The University of Glasgow 2001--- License : BSD-style (see the file LICENSE in the 'random' repository)--- --- Maintainer : libraries@haskell.org--- Stability : stable--- Portability : portable------ This library deals with the common task of pseudo-random number--- generation. The library makes it possible to generate repeatable--- results, by starting with a specified initial random number generator,--- or to get different results on each run by using the system-initialised--- generator or by supplying a seed from some other source.------ The library is split into two layers: ------ * A core /random number generator/ provides a supply of bits.--- The class 'RandomGen' provides a common interface to such generators.--- The library provides one instance of 'RandomGen', the abstract--- data type 'StdGen'. Programmers may, of course, supply their own--- instances of 'RandomGen'.------ * The class 'Random' provides a way to extract values of a particular--- type from a random number generator. For example, the 'Float'--- instance of 'Random' allows one to generate random values of type--- 'Float'.------ This implementation uses the Portable Combined Generator of L'Ecuyer--- ["System.Random\#LEcuyer"] for 32-bit computers, transliterated by--- Lennart Augustsson. It has a period of roughly 2.30584e18.-----------------------------------------------------------------------------------#include "MachDeps.h"--module System.Random- (-- -- $intro-- -- * Random number generators--#ifdef ENABLE_SPLITTABLEGEN- RandomGen(next, genRange)- , SplittableGen(split)-#else- RandomGen(next, genRange, split)-#endif- -- ** Standard random number generators- , StdGen- , mkStdGen-- -- ** The global random number generator-- -- $globalrng-- , getStdRandom- , getStdGen- , setStdGen- , newStdGen-- -- * Random values of various types- , Random ( random, randomR,- randoms, randomRs,- randomIO, randomRIO )-- -- * References- -- $references-- ) where--import Prelude--import Data.Bits-import Data.Int-import Data.Word-import Foreign.C.Types--#ifdef __NHC__-import CPUTime ( getCPUTime )-import Foreign.Ptr ( Ptr, nullPtr )-import Foreign.C ( CTime, CUInt )-#else-import System.CPUTime ( getCPUTime )-import Data.Time ( getCurrentTime, UTCTime(..) )-import Data.Ratio ( numerator, denominator )-#endif-import Data.Char ( isSpace, chr, ord )-import System.IO.Unsafe ( unsafePerformIO )-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )-#if MIN_VERSION_base (4,6,0)-import Data.IORef ( atomicModifyIORef' )-#else-import Data.IORef ( atomicModifyIORef )-#endif-import Numeric ( readDec )--#ifdef __GLASGOW_HASKELL__-import GHC.Exts ( build )-#else--- | A dummy variant of build without fusion.-{-# INLINE build #-}-build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]-build g = g (:) []-#endif--#if !MIN_VERSION_base (4,6,0)-atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b-atomicModifyIORef' ref f = do- b <- atomicModifyIORef ref- (\x -> let (a, b) = f x- in (a, a `seq` b))- b `seq` return b-#endif---- The standard nhc98 implementation of Time.ClockTime does not match--- the extended one expected in this module, so we lash-up a quick--- replacement here.-#ifdef __NHC__-foreign import ccall "time.h time" readtime :: Ptr CTime -> IO CTime-getTime :: IO (Integer, Integer)-getTime = do CTime t <- readtime nullPtr; return (toInteger t, 0)-#else-getTime :: IO (Integer, Integer)-getTime = do- utc <- getCurrentTime- let daytime = toRational $ utctDayTime utc- return $ quotRem (numerator daytime) (denominator daytime)-#endif---- | The class 'RandomGen' provides a common interface to random number--- generators.----#ifdef ENABLE_SPLITTABLEGEN--- Minimal complete definition: 'next'.-#else--- Minimal complete definition: 'next' and 'split'.-#endif--class RandomGen g where-- -- |The 'next' operation returns an 'Int' that is uniformly distributed- -- in the range returned by 'genRange' (including both end points),- -- and a new generator.- next :: g -> (Int, g)-- -- |The 'genRange' operation yields the range of values returned by- -- the generator.- --- -- It is required that:- --- -- * If @(a,b) = 'genRange' g@, then @a < b@.- --- -- * 'genRange' always returns a pair of defined 'Int's.- --- -- The second condition ensures that 'genRange' cannot examine its- -- argument, and hence the value it returns can be determined only by the- -- instance of 'RandomGen'. That in turn allows an implementation to make- -- a single call to 'genRange' to establish a generator's range, without- -- being concerned that the generator returned by (say) 'next' might have- -- a different range to the generator passed to 'next'.- --- -- The default definition spans the full range of 'Int'.- genRange :: g -> (Int,Int)-- -- default method- genRange _ = (minBound, maxBound)--#ifdef ENABLE_SPLITTABLEGEN--- | The class 'SplittableGen' proivides a way to specify a random number--- generator that can be split into two new generators.-class SplittableGen g where-#endif- -- |The 'split' operation allows one to obtain two distinct random number- -- generators. This is very useful in functional programs (for example, when- -- passing a random number generator down to recursive calls), but very- -- little work has been done on statistically robust implementations of- -- 'split' (["System.Random\#Burton", "System.Random\#Hellekalek"]- -- are the only examples we know of).- split :: g -> (g, g)--{- |-The 'StdGen' instance of 'RandomGen' has a 'genRange' of at least 30 bits.--The result of repeatedly using 'next' should be at least as statistically-robust as the /Minimal Standard Random Number Generator/ described by-["System.Random\#Park", "System.Random\#Carta"].-Until more is known about implementations of 'split', all we require is-that 'split' deliver generators that are (a) not identical and-(b) independently robust in the sense just given.--The 'Show' and 'Read' instances of 'StdGen' provide a primitive way to save the-state of a random number generator.-It is required that @'read' ('show' g) == g@.--In addition, 'reads' may be used to map an arbitrary string (not necessarily one-produced by 'show') onto a value of type 'StdGen'. In general, the 'Read'-instance of 'StdGen' has the following properties: --* It guarantees to succeed on any string. --* It guarantees to consume only a finite portion of the string. --* Different argument strings are likely to result in different results.---}--data StdGen - = StdGen !Int32 !Int32--instance RandomGen StdGen where- next = stdNext- genRange _ = stdRange--#ifdef ENABLE_SPLITTABLEGEN-instance SplittableGen StdGen where-#endif- split = stdSplit--instance Show StdGen where- showsPrec p (StdGen s1 s2) = - showsPrec p s1 . - showChar ' ' .- showsPrec p s2--instance Read StdGen where- readsPrec _p = \ r ->- case try_read r of- r'@[_] -> r'- _ -> [stdFromString r] -- because it shouldn't ever fail.- where - try_read r = do- (s1, r1) <- readDec (dropWhile isSpace r)- (s2, r2) <- readDec (dropWhile isSpace r1)- return (StdGen s1 s2, r2)--{-- If we cannot unravel the StdGen from a string, create- one based on the string given.--}-stdFromString :: String -> (StdGen, String)-stdFromString s = (mkStdGen num, rest)- where (cs, rest) = splitAt 6 s- num = foldl (\a x -> x + 3 * a) 1 (map ord cs)---{- |-The function 'mkStdGen' provides an alternative way of producing an initial-generator, by mapping an 'Int' into a generator. Again, distinct arguments-should be likely to produce distinct generators.--}-mkStdGen :: Int -> StdGen -- why not Integer ?-mkStdGen s = mkStdGen32 $ fromIntegral s--{--From ["System.Random\#LEcuyer"]: "The integer variables s1 and s2 ... must be-initialized to values in the range [1, 2147483562] and [1, 2147483398]-respectively."--}-mkStdGen32 :: Int32 -> StdGen-mkStdGen32 sMaybeNegative = StdGen (s1+1) (s2+1)- where- -- We want a non-negative number, but we can't just take the abs- -- of sMaybeNegative as -minBound == minBound.- s = sMaybeNegative .&. maxBound- (q, s1) = s `divMod` 2147483562- s2 = q `mod` 2147483398--createStdGen :: Integer -> StdGen-createStdGen s = mkStdGen32 $ fromIntegral s--{- |-With a source of random number supply in hand, the 'Random' class allows the-programmer to extract random values of a variety of types.--Minimal complete definition: 'randomR' and 'random'.---}--class Random a where- -- | Takes a range /(lo,hi)/ and a random number generator- -- /g/, and returns a random value uniformly distributed in the closed- -- interval /[lo,hi]/, together with a new generator. It is unspecified- -- what happens if /lo>hi/. For continuous types there is no requirement- -- that the values /lo/ and /hi/ are ever produced, but they may be,- -- depending on the implementation and the interval.- randomR :: RandomGen g => (a,a) -> g -> (a,g)-- -- | The same as 'randomR', but using a default range determined by the type:- --- -- * For bounded types (instances of 'Bounded', such as 'Char'),- -- the range is normally the whole type.- --- -- * For fractional types, the range is normally the semi-closed interval- -- @[0,1)@.- --- -- * For 'Integer', the range is (arbitrarily) the range of 'Int'.- random :: RandomGen g => g -> (a, g)-- -- | Plural variant of 'randomR', producing an infinite list of- -- random values instead of returning a new generator.- {-# INLINE randomRs #-}- randomRs :: RandomGen g => (a,a) -> g -> [a]- randomRs ival g = build (\cons _nil -> buildRandoms cons (randomR ival) g)-- -- | Plural variant of 'random', producing an infinite list of- -- random values instead of returning a new generator.- {-# INLINE randoms #-}- randoms :: RandomGen g => g -> [a]- randoms g = build (\cons _nil -> buildRandoms cons random g)-- -- | A variant of 'randomR' that uses the global random number generator- -- (see "System.Random#globalrng").- randomRIO :: (a,a) -> IO a- randomRIO range = getStdRandom (randomR range)-- -- | A variant of 'random' that uses the global random number generator- -- (see "System.Random#globalrng").- randomIO :: IO a- randomIO = getStdRandom random---- | Produce an infinite list-equivalent of random values.-{-# INLINE buildRandoms #-}-buildRandoms :: RandomGen g- => (a -> as -> as) -- ^ E.g. '(:)' but subject to fusion- -> (g -> (a,g)) -- ^ E.g. 'random'- -> g -- ^ A 'RandomGen' instance- -> as-buildRandoms cons rand = go- where- -- The seq fixes part of #4218 and also makes fused Core simpler.- go g = x `seq` (x `cons` go g') where (x,g') = rand g---instance Random Integer where- randomR ival g = randomIvalInteger ival g- random g = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g--instance Random Int where randomR = randomIvalIntegral; random = randomBounded-instance Random Int8 where randomR = randomIvalIntegral; random = randomBounded-instance Random Int16 where randomR = randomIvalIntegral; random = randomBounded-instance Random Int32 where randomR = randomIvalIntegral; random = randomBounded-instance Random Int64 where randomR = randomIvalIntegral; random = randomBounded--#ifndef __NHC__--- Word is a type synonym in nhc98.-instance Random Word where randomR = randomIvalIntegral; random = randomBounded-#endif-instance Random Word8 where randomR = randomIvalIntegral; random = randomBounded-instance Random Word16 where randomR = randomIvalIntegral; random = randomBounded-instance Random Word32 where randomR = randomIvalIntegral; random = randomBounded-instance Random Word64 where randomR = randomIvalIntegral; random = randomBounded--instance Random CChar where randomR = randomIvalIntegral; random = randomBounded-instance Random CSChar where randomR = randomIvalIntegral; random = randomBounded-instance Random CUChar where randomR = randomIvalIntegral; random = randomBounded-instance Random CShort where randomR = randomIvalIntegral; random = randomBounded-instance Random CUShort where randomR = randomIvalIntegral; random = randomBounded-instance Random CInt where randomR = randomIvalIntegral; random = randomBounded-instance Random CUInt where randomR = randomIvalIntegral; random = randomBounded-instance Random CLong where randomR = randomIvalIntegral; random = randomBounded-instance Random CULong where randomR = randomIvalIntegral; random = randomBounded-instance Random CPtrdiff where randomR = randomIvalIntegral; random = randomBounded-instance Random CSize where randomR = randomIvalIntegral; random = randomBounded-instance Random CWchar where randomR = randomIvalIntegral; random = randomBounded-instance Random CSigAtomic where randomR = randomIvalIntegral; random = randomBounded-instance Random CLLong where randomR = randomIvalIntegral; random = randomBounded-instance Random CULLong where randomR = randomIvalIntegral; random = randomBounded-instance Random CIntPtr where randomR = randomIvalIntegral; random = randomBounded-instance Random CUIntPtr where randomR = randomIvalIntegral; random = randomBounded-instance Random CIntMax where randomR = randomIvalIntegral; random = randomBounded-instance Random CUIntMax where randomR = randomIvalIntegral; random = randomBounded--instance Random Char where- randomR (a,b) g = - case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of- (x,g') -> (chr x, g')- random g = randomR (minBound,maxBound) g--instance Random Bool where- randomR (a,b) g = - case (randomIvalInteger (bool2Int a, bool2Int b) g) of- (x, g') -> (int2Bool x, g')- where- bool2Int :: Bool -> Integer- bool2Int False = 0- bool2Int True = 1-- int2Bool :: Int -> Bool- int2Bool 0 = False- int2Bool _ = True-- random g = randomR (minBound,maxBound) g--{-# INLINE randomRFloating #-}-randomRFloating :: (Fractional a, Num a, Ord a, Random a, RandomGen g) => (a, a) -> g -> (a, g)-randomRFloating (l,h) g - | l>h = randomRFloating (h,l) g- | otherwise = let (coef,g') = random g in - (2.0 * (0.5*l + coef * (0.5*h - 0.5*l)), g') -- avoid overflow--instance Random Double where- randomR = randomRFloating- random rng = - case random rng of - (x,rng') -> - -- We use 53 bits of randomness corresponding to the 53 bit significand:- ((fromIntegral (mask53 .&. (x::Int64)) :: Double) - / fromIntegral twoto53, rng')- where - twoto53 = (2::Int64) ^ (53::Int64)- mask53 = twoto53 - 1- -instance Random Float where- randomR = randomRFloating- random rng = - -- TODO: Faster to just use 'next' IF it generates enough bits of randomness. - case random rng of - (x,rng') -> - -- We use 24 bits of randomness corresponding to the 24 bit significand:- ((fromIntegral (mask24 .&. (x::Int32)) :: Float) - / fromIntegral twoto24, rng')- -- Note, encodeFloat is another option, but I'm not seeing slightly- -- worse performance with the following [2011.06.25]:--- (encodeFloat rand (-24), rng')- where- mask24 = twoto24 - 1- twoto24 = (2::Int32) ^ (24::Int32)---- CFloat/CDouble are basically the same as a Float/Double:-instance Random CFloat where- randomR = randomRFloating- random rng = case random rng of - (x,rng') -> (realToFrac (x::Float), rng')--instance Random CDouble where- randomR = randomRFloating- -- A MYSTERY:- -- Presently, this is showing better performance than the Double instance:- -- (And yet, if the Double instance uses randomFrac then its performance is much worse!)- random = randomFrac- -- random rng = case random rng of - -- (x,rng') -> (realToFrac (x::Double), rng')--mkStdRNG :: Integer -> IO StdGen-mkStdRNG o = do- ct <- getCPUTime- (sec, psec) <- getTime- return (createStdGen (sec * 12345 + psec + ct + o))--randomBounded :: (RandomGen g, Random a, Bounded a) => g -> (a, g)-randomBounded = randomR (minBound, maxBound)---- The two integer functions below take an [inclusive,inclusive] range.-randomIvalIntegral :: (RandomGen g, Integral a) => (a, a) -> g -> (a, g)-randomIvalIntegral (l,h) = randomIvalInteger (toInteger l, toInteger h)--{-# SPECIALIZE randomIvalInteger :: (Num a) =>- (Integer, Integer) -> StdGen -> (a, StdGen) #-}- -randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)-randomIvalInteger (l,h) rng- | l > h = randomIvalInteger (h,l) rng- | otherwise = case (f 1 0 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng')- where- (genlo, genhi) = genRange rng- b = fromIntegral genhi - fromIntegral genlo + 1-- -- Probabilities of the most likely and least likely result- -- will differ at most by a factor of (1 +- 1/q). Assuming the RandomGen- -- is uniform, of course-- -- On average, log q / log b more random values will be generated- -- than the minimum- q = 1000- k = h - l + 1- magtgt = k * q-- -- generate random values until we exceed the target magnitude - f mag v g | mag >= magtgt = (v, g)- | otherwise = v' `seq`f (mag*b) v' g' where- (x,g') = next g- v' = (v * b + (fromIntegral x - fromIntegral genlo))----- The continuous functions on the other hand take an [inclusive,exclusive) range.-randomFrac :: (RandomGen g, Fractional a) => g -> (a, g)-randomFrac = randomIvalDouble (0::Double,1) realToFrac--randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g)-randomIvalDouble (l,h) fromDouble rng - | l > h = randomIvalDouble (h,l) fromDouble rng- | otherwise = - case (randomIvalInteger (toInteger (minBound::Int32), toInteger (maxBound::Int32)) rng) of- (x, rng') -> - let- scaled_x = - fromDouble (0.5*l + 0.5*h) + -- previously (l+h)/2, overflowed- fromDouble ((0.5*h - 0.5*l) / (0.5 * realToFrac int32Count)) * -- avoid overflow- fromIntegral (x::Int32)- in- (scaled_x, rng')--int32Count :: Integer-int32Count = toInteger (maxBound::Int32) - toInteger (minBound::Int32) + 1 -- GHC ticket #3982--stdRange :: (Int,Int)-stdRange = (1, 2147483562)--stdNext :: StdGen -> (Int, StdGen)--- Returns values in the range stdRange-stdNext (StdGen s1 s2) = (fromIntegral z', StdGen s1'' s2'')- where z' = if z < 1 then z + 2147483562 else z- z = s1'' - s2''-- k = s1 `quot` 53668- s1' = 40014 * (s1 - k * 53668) - k * 12211- s1'' = if s1' < 0 then s1' + 2147483563 else s1'- - k' = s2 `quot` 52774- s2' = 40692 * (s2 - k' * 52774) - k' * 3791- s2'' = if s2' < 0 then s2' + 2147483399 else s2'--stdSplit :: StdGen -> (StdGen, StdGen)-stdSplit std@(StdGen s1 s2)- = (left, right)- where- -- no statistical foundation for this!- left = StdGen new_s1 t2- right = StdGen t1 new_s2-- new_s1 | s1 == 2147483562 = 1- | otherwise = s1 + 1-- new_s2 | s2 == 1 = 2147483398- | otherwise = s2 - 1-- StdGen t1 t2 = snd (next std)---- The global random number generator--{- $globalrng #globalrng#--There is a single, implicit, global random number generator of type-'StdGen', held in some global variable maintained by the 'IO' monad. It is-initialised automatically in some system-dependent fashion, for example, by-using the time of day, or Linux's kernel random number generator. To get-deterministic behaviour, use 'setStdGen'.--}---- |Sets the global random number generator.-setStdGen :: StdGen -> IO ()-setStdGen sgen = writeIORef theStdGen sgen---- |Gets the global random number generator.-getStdGen :: IO StdGen-getStdGen = readIORef theStdGen--theStdGen :: IORef StdGen-theStdGen = unsafePerformIO $ do- rng <- mkStdRNG 0- newIORef rng---- |Applies 'split' to the current global random generator,--- updates it with one of the results, and returns the other.-newStdGen :: IO StdGen-newStdGen = atomicModifyIORef' theStdGen split--{- |Uses the supplied function to get a value from the current global-random generator, and updates the global generator with the new generator-returned by the function. For example, @rollDice@ gets a random integer-between 1 and 6:--> rollDice :: IO Int-> rollDice = getStdRandom (randomR (1,6))---}--getStdRandom :: (StdGen -> (a,StdGen)) -> IO a-getStdRandom f = atomicModifyIORef' theStdGen (swap . f)- where swap (v,g) = (g,v)--{- $references--1. FW #Burton# Burton and RL Page, /Distributed random number generation/,-Journal of Functional Programming, 2(2):203-212, April 1992.--2. SK #Park# Park, and KW Miller, /Random number generators --good ones are hard to find/, Comm ACM 31(10), Oct 1988, pp1192-1201.--3. DG #Carta# Carta, /Two fast implementations of the minimal standard-random number generator/, Comm ACM, 33(1), Jan 1990, pp87-88.--4. P #Hellekalek# Hellekalek, /Don\'t trust parallel Monte Carlo/,-Department of Mathematics, University of Salzburg,-<http://random.mat.sbg.ac.at/~peter/pads98.ps>, 1998.--5. Pierre #LEcuyer# L'Ecuyer, /Efficient and portable combined random-number generators/, Comm ACM, 31(6), Jun 1988, pp742-749.--The Web site <http://random.mat.sbg.ac.at/> is a great source of information.---}
+ bench-legacy/BinSearch.hs view
@@ -0,0 +1,149 @@++{-+ Binary search over benchmark input sizes.++ There are many good ways to measure the time it takes to perform a+ certain computation on a certain input. However, frequently, it's+ challenging to pick the right input size for all platforms and all+ compilataion modes.++ Sometimes for linear-complexity benchmarks it is better to measure+ /throughput/, i.e. elements processed per second. That is, fixing+ the time of execution and measuring the amount of work done (rather+ than the reverse). This library provides a simple way to search for+ an appropriate input size that results in the desired execution time.++ An alternative approach is to kill the computation after a certain+ amount of time and observe how much work it has completed.+ -}+module BinSearch+ (+ binSearch+ )+where++import Control.Monad+import Data.Time.Clock -- Not in 6.10+import Data.List+import System.IO+import Prelude hiding (min,max,log)++++-- | Binary search for the number of inputs to a computation that+-- results in a specified amount of execution time in seconds. For example:+--+-- > binSearch verbose N (min,max) kernel+--+-- ... will find the right input size that results in a time+-- between min and max, then it will then run for N trials and+-- return the median (input,time-in-seconds) pair.+binSearch :: Bool -> Integer -> (Double,Double) -> (Integer -> IO ()) -> IO (Integer, Double)+binSearch verbose trials (min, max) kernel = do+ when verbose $+ putStrLn $+ "[binsearch] Binary search for input size resulting in time in range " +++ show (min, max)+ let desired_exec_length = 1.0+ good_trial t =+ (toRational t <= toRational max) && (toRational t >= toRational min)+ -- At some point we must give up...+ loop n+ | n > ((2 :: Integer) ^ (100 :: Integer)) =+ error+ "ERROR binSearch: This function doesn't seem to scale in proportion to its last argument."+ -- Not allowed to have "0" size input, bump it back to one:+ loop 0 = loop 1+ loop n = do+ when verbose $ putStr $ "[binsearch:" ++ show n ++ "] "+ time <- timeit $ kernel n+ when verbose $ putStrLn $ "Time consumed: " ++ show time+ let rate = fromIntegral n / time+ -- [2010.06.09] Introducing a small fudge factor to help our guess get over the line:+ let initial_fudge_factor = 1.10+ fudge_factor = 1.01 -- Even in the steady state we fudge a little+ guess = desired_exec_length * rate+ -- TODO: We should keep more history here so that we don't re-explore input space we+ -- have already explored. This is a balancing act because of randomness in+ -- execution time.+ if good_trial time+ then do+ when verbose $+ putStrLn+ "[binsearch] Time in range. LOCKING input size and performing remaining trials."+ print_trial 1 n time+ lockin (trials - 1) n [time]+ else if time < 0.100+ then loop (2 * n)+ else do+ when verbose $+ putStrLn $+ "[binsearch] Estimated rate to be " +++ show (round rate :: Integer) +++ " per second. Trying to scale up..."+ -- Here we've exited the doubling phase, but we're making our+ -- first guess as to how big a real execution should be:+ if time > 0.100 && time < 0.33 * desired_exec_length+ then do+ when verbose $+ putStrLn+ "[binsearch] (Fudging first guess a little bit extra)"+ loop (round $ guess * initial_fudge_factor)+ else loop (round $ guess * fudge_factor)+ -- Termination condition: Done with all trials.+ lockin 0 n log = do+ when verbose $+ putStrLn $+ "[binsearch] Time-per-unit for all trials: " +++ concat+ (intersperse " " (map (show . (/ toDouble n) . toDouble) $ sort log))+ return (n, log !! (length log `quot` 2)) -- Take the median+ lockin trials_left n log = do+ when verbose $+ putStrLn+ "[binsearch]------------------------------------------------------------"+ time <- timeit $ kernel n+ -- hFlush stdout+ print_trial (trials - trials_left + 1) n time+ -- whenverbose$ hFlush stdout+ lockin (trials_left - 1) n (time : log)+ print_trial :: Integer -> Integer -> NominalDiffTime -> IO ()+ print_trial trialnum n time =+ let rate = fromIntegral n / time+ timeperunit = time / fromIntegral n+ in when verbose $+ putStrLn $+ "[binsearch] TRIAL: " +++ show trialnum +++ " secPerUnit: " +++ showTime timeperunit +++ " ratePerSec: " ++ show rate ++ " seconds: " ++ showTime time+ (n, t) <- loop 1+ return (n, fromRational $ toRational t)+++showTime :: NominalDiffTime -> String+showTime t = show ((fromRational $ toRational t) :: Double)++toDouble :: Real a => a -> Double+toDouble = fromRational . toRational+++-- Could use cycle counters here.... but the point of this is to time+-- things on the order of a second.+timeit :: IO () -> IO NominalDiffTime+timeit io = do+ strt <- getCurrentTime+ io+ end <- getCurrentTime+ return (diffUTCTime end strt)+{-+test :: IO (Integer,Double)+test =+ binSearch True 3 (1.0, 1.05)+ (\n ->+ do v <- newIORef 0+ forM_ [1..n] $ \i -> do+ old <- readIORef v+ writeIORef v (old+i))+-}
+ bench-legacy/SimpleRNGBench.hs view
@@ -0,0 +1,269 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables, ForeignFunctionInterface #-}+{-# OPTIONS_GHC -fwarn-unused-imports #-}++-- | A simple script to do some very basic timing of the RNGs.++module Main where++import System.Exit (exitSuccess, exitFailure)+import System.Environment+import System.Random+import System.CPUTime (getCPUTime)+import System.CPUTime.Rdtsc+import System.Console.GetOpt++import GHC.Conc+import Control.Concurrent+import Control.Monad+import Control.Exception++import Data.IORef+import Data.Word+import Data.List hiding (last,sum)+import Data.Int+import Data.List.Split hiding (split)+import Text.Printf++import Foreign.Ptr+import Foreign.C.Types+import Foreign.ForeignPtr+import Foreign.Storable (peek,poke)++import Prelude hiding (last,sum)+import BinSearch++----------------------------------------------------------------------------------------------------+-- Miscellaneous helpers:++-- Readable large integer printing:+commaint :: Show a => a -> String+commaint n = reverse $ concat $ intersperse "," $ chunk 3 $ reverse (show n)++padleft :: Int -> String -> String+padleft n str | length str >= n = str+padleft n str | otherwise = take (n - length str) (repeat ' ') ++ str++padright :: Int -> String -> String+padright n str | length str >= n = str+padright n str | otherwise = str ++ take (n - length str) (repeat ' ')++fmt_num :: (RealFrac a, PrintfArg a) => a -> String+fmt_num n =+ if n < 100+ then printf "%.2f" n+ else commaint (round n :: Integer)+++-- Measure clock frequency, spinning rather than sleeping to try to+-- stay on the same core.+measureFreq :: IO Int64+measureFreq = do+ let second = 1000 * 1000 * 1000 * 1000 -- picoseconds are annoying+ t1 <- rdtsc+ start <- getCPUTime+ let loop !n !last = do+ t2 <- rdtsc+ when (t2 < last) $ putStrLn $ "COUNTERS WRAPPED " ++ show (last, t2)+ cput <- getCPUTime+ if cput - start < second+ then loop (n + 1) t2+ else return (n, t2)+ (n, t2) <- loop 0 t1+ putStrLn $ " Approx getCPUTime calls per second: " ++ commaint (n :: Int64)+ when (t2 < t1) $+ putStrLn $+ "WARNING: rdtsc not monotonically increasing, first " +++ show t1 ++ " then " ++ show t2 ++ " on the same OS thread"+ return $ fromIntegral (t2 - t1)++----------------------------------------------------------------------------------------------------++-- Test overheads without actually generating any random numbers:+data NoopRNG = NoopRNG+instance RandomGen NoopRNG where+ next g = (0, g)+ genRange _ = (0, 0)+ split g = (g, g)++-- An RNG generating only 0 or 1:+data BinRNG = BinRNG StdGen+instance RandomGen BinRNG where+ next (BinRNG g) = (x `mod` 2, BinRNG g')+ where+ (x, g') = next g+ genRange _ = (0, 1)+ split (BinRNG g) = (BinRNG g1, BinRNG g2)+ where+ (g1, g2) = split g+++----------------------------------------------------------------------------------------------------+-- Drivers to get random numbers repeatedly.++type Kern = Int -> Ptr Int -> IO ()++-- [2011.01.28] Changing this to take "count" and "accumulator ptr" as arguments:+-- foreign import ccall "cbits/c_test.c" blast_rands :: Kern+-- foreign import ccall "cbits/c_test.c" store_loop :: Kern+-- foreign import ccall unsafe "stdlib.hs" rand :: IO Int++{-# INLINE timeit #-}+timeit :: (Random a, RandomGen g) => Int -> Int64 -> String -> g -> (g -> (a,g)) -> IO ()+timeit numthreads freq msg gen nxt = do+ counters <- forM [1 .. numthreads] (const $ newIORef (1 :: Int64))+ tids <- forM counters $ \counter -> forkIO $ infloop counter (nxt gen)+ threadDelay (1000 * 1000) -- One second+ mapM_ killThread tids+ finals <- mapM readIORef counters+ let mean :: Double =+ fromIntegral (foldl1 (+) finals) / fromIntegral numthreads+ cycles_per :: Double = fromIntegral freq / mean+ printResult (round mean :: Int64) msg cycles_per+ where+ infloop !counter (!_, !g) = do+ incr counter+ infloop counter (nxt g)+ incr !counter+ -- modifyIORef counter (+1) -- Not strict enough!+ = do+ c <- readIORef counter+ let c' = c + 1+ _ <- evaluate c'+ writeIORef counter c'+++-- This function times an IO function on one or more threads. Rather+-- than running a fixed number of iterations, it uses a binary search+-- to find out how many iterations can be completed in a second.+timeit_foreign :: Int -> Int64 -> String -> (Int -> Ptr Int -> IO ()) -> IO Int64+timeit_foreign numthreads freq msg ffn = do+ ptr :: ForeignPtr Int <- mallocForeignPtr+ let kern =+ if numthreads == 1+ then ffn+ else replicate_kernel numthreads ffn+ wrapped n = withForeignPtr ptr (kern $ fromIntegral n)+ (n, t) <- binSearch False 1 (1.0, 1.05) wrapped+ let total_per_second = round $ fromIntegral n * (1 / t)+ cycles_per = fromIntegral freq * t / fromIntegral n+ printResult total_per_second msg cycles_per+ return total_per_second+ -- This lifts a C kernel to operate simultaneously on N threads.+ where+ replicate_kernel :: Int -> Kern -> Kern+ replicate_kernel nthreads kern n ptr = do+ ptrs <- forM [1 .. nthreads] (const mallocForeignPtr)+ tmpchan <- newChan+ -- let childwork = ceiling$ fromIntegral n / fromIntegral nthreads+ let childwork = n -- Keep it the same.. interested in per-thread throughput.+ -- Fork/join pattern:+ forM_ ptrs $ \pt ->+ forkIO $+ withForeignPtr pt $ \p -> do+ kern (fromIntegral childwork) p+ result <- peek p+ writeChan tmpchan result+ results <- forM [1 .. nthreads] $ \_ -> readChan tmpchan+ -- Meaningless semantics here... sum the child ptrs and write to the input one:+ poke ptr (foldl1 (+) results)+++printResult :: Int64 -> String -> Double -> IO ()+printResult total msg cycles_per =+ putStrLn $+ " " +++ padleft 11 (commaint total) +++ " randoms generated " +++ padright 27 ("[" ++ msg ++ "]") +++ " ~ " ++ fmt_num cycles_per ++ " cycles/int"++----------------------------------------------------------------------------------------------------+-- Main Script++data Flag = NoC | Help+ deriving (Show, Eq)++options :: [OptDescr Flag]+options =+ [ Option ['h'] ["help"] (NoArg Help) "print program help"+ , Option [] ["noC"] (NoArg NoC) "omit C benchmarks, haskell only"+ ]++main :: IO ()+main = do+ argv <- getArgs+ let (opts,_,other) = getOpt Permute options argv++ unless (null other) $ do+ putStrLn "ERROR: Unrecognized options: "+ mapM_ putStr other+ exitFailure++ when (Help `elem` opts) $ do+ putStr $ usageInfo "Benchmark random number generation" options+ exitSuccess++ putStrLn "\nHow many random numbers can we generate in a second on one thread?"++ t1 <- rdtsc+ t2 <- rdtsc+ putStrLn (" Cost of rdtsc (ffi call): " ++ show (t2 - t1))++ freq <- measureFreq+ putStrLn $ " Approx clock frequency: " ++ commaint freq++ let randInt = random :: RandomGen g => g -> (Int,g)+ randWord16 = random :: RandomGen g => g -> (Word16,g)+ randFloat = random :: RandomGen g => g -> (Float,g)+ randCFloat = random :: RandomGen g => g -> (CFloat,g)+ randDouble = random :: RandomGen g => g -> (Double,g)+ randCDouble = random :: RandomGen g => g -> (CDouble,g)+ randInteger = random :: RandomGen g => g -> (Integer,g)+ randBool = random :: RandomGen g => g -> (Bool,g)+ randChar = random :: RandomGen g => g -> (Char,g)++ gen = mkStdGen 23852358661234+ gamut th = do+ putStrLn " First, timing System.Random.next:"+ timeit th freq "constant zero gen" NoopRNG next+ timeit th freq "System.Random stdGen/next" gen next++ putStrLn "\n Second, timing System.Random.random at different types:"+ timeit th freq "System.Random Ints" gen randInt+ timeit th freq "System.Random Word16" gen randWord16+ timeit th freq "System.Random Floats" gen randFloat+ timeit th freq "System.Random CFloats" gen randCFloat+ timeit th freq "System.Random Doubles" gen randDouble+ timeit th freq "System.Random CDoubles" gen randCDouble+ timeit th freq "System.Random Integers" gen randInteger+ timeit th freq "System.Random Bools" gen randBool+ timeit th freq "System.Random Chars" gen randChar++ putStrLn "\n Next timing range-restricted System.Random.randomR:"+ timeit th freq "System.Random Ints" gen (randomR (-100, 100::Int))+ timeit th freq "System.Random Word16s" gen (randomR ( 100, 300::Word16))+ timeit th freq "System.Random Floats" gen (randomR (-100, 100::Float))+ timeit th freq "System.Random CFloats" gen (randomR (-100, 100::CFloat))+ timeit th freq "System.Random Doubles" gen (randomR (-100, 100::Double))+ timeit th freq "System.Random CDoubles" gen (randomR (-100, 100::CDouble))+ timeit th freq "System.Random Integers" gen (randomR (-100, 100::Integer))+ timeit th freq "System.Random Bools" gen (randomR (False, True::Bool))+ timeit th freq "System.Random Chars" gen (randomR ('a', 'z'))+ timeit th freq "System.Random BIG Integers" gen (randomR (0, (2::Integer) ^ (5000::Int)))++ -- when (not$ NoC `elem` opts) $ do+ -- putStrLn$ " Comparison to C's rand():"+ -- timeit_foreign th freq "ptr store in C loop" store_loop+ -- timeit_foreign th freq "rand/store in C loop" blast_rands+ -- timeit_foreign th freq "rand in Haskell loop" (\n ptr -> forM_ [1..n]$ \_ -> rand )+ -- timeit_foreign th freq "rand/store in Haskell loop" (\n ptr -> forM_ [1..n]$ \_ -> do n <- rand; poke ptr n )+ -- return ()++ -- Test with 1 thread and numCapabilities threads:+ gamut 1+ when (numCapabilities > 1) $ do+ putStrLn $ "\nNow "++ show numCapabilities ++" threads, reporting mean randoms-per-second-per-thread:"+ void $ gamut numCapabilities++ putStrLn "Finished."+
+ bench/Main.hs view
@@ -0,0 +1,309 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main (main) where++import Control.Monad+import Control.Monad.State.Strict+import Data.Int+import Data.Proxy+import Data.Typeable+import Data.Word+import Foreign.C.Types+import Gauge.Main+import Numeric.Natural (Natural)+import System.Random.SplitMix as SM++import System.Random.Stateful++main :: IO ()+main = do+ let !sz = 100000+ genLengths =+ -- create 5000 small lengths that are needed for ShortByteString generation+ runStateGen (mkStdGen 2020) $ \g -> replicateM 5000 (uniformRM (16 + 1, 16 + 7) g)+ defaultMain+ [ bgroup "baseline"+ [ let !smGen = SM.mkSMGen 1337 in bench "nextWord32" $ nf (genMany SM.nextWord32 smGen) sz+ , let !smGen = SM.mkSMGen 1337 in bench "nextWord64" $ nf (genMany SM.nextWord64 smGen) sz+ , let !smGen = SM.mkSMGen 1337 in bench "nextInt" $ nf (genMany SM.nextInt smGen) sz+ , let !smGen = SM.mkSMGen 1337 in bench "split" $ nf (genMany SM.splitSMGen smGen) sz+ ]+ , bgroup "pure"+ [ bgroup "random"+ [ pureRandomBench (Proxy :: Proxy Float) sz+ , pureRandomBench (Proxy :: Proxy Double) sz+ , pureRandomBench (Proxy :: Proxy Integer) sz+ ]+ , bgroup "uniform"+ [ pureUniformBench (Proxy :: Proxy Word8) sz+ , pureUniformBench (Proxy :: Proxy Word16) sz+ , pureUniformBench (Proxy :: Proxy Word32) sz+ , pureUniformBench (Proxy :: Proxy Word64) sz+ , pureUniformBench (Proxy :: Proxy Word) sz+ , pureUniformBench (Proxy :: Proxy Int8) sz+ , pureUniformBench (Proxy :: Proxy Int16) sz+ , pureUniformBench (Proxy :: Proxy Int32) sz+ , pureUniformBench (Proxy :: Proxy Int64) sz+ , pureUniformBench (Proxy :: Proxy Int) sz+ , pureUniformBench (Proxy :: Proxy Char) sz+ , pureUniformBench (Proxy :: Proxy Bool) sz+ , pureUniformBench (Proxy :: Proxy CChar) sz+ , pureUniformBench (Proxy :: Proxy CSChar) sz+ , pureUniformBench (Proxy :: Proxy CUChar) sz+ , pureUniformBench (Proxy :: Proxy CShort) sz+ , pureUniformBench (Proxy :: Proxy CUShort) sz+ , pureUniformBench (Proxy :: Proxy CInt) sz+ , pureUniformBench (Proxy :: Proxy CUInt) sz+ , pureUniformBench (Proxy :: Proxy CLong) sz+ , pureUniformBench (Proxy :: Proxy CULong) sz+ , pureUniformBench (Proxy :: Proxy CPtrdiff) sz+ , pureUniformBench (Proxy :: Proxy CSize) sz+ , pureUniformBench (Proxy :: Proxy CWchar) sz+ , pureUniformBench (Proxy :: Proxy CSigAtomic) sz+ , pureUniformBench (Proxy :: Proxy CLLong) sz+ , pureUniformBench (Proxy :: Proxy CULLong) sz+ , pureUniformBench (Proxy :: Proxy CIntPtr) sz+ , pureUniformBench (Proxy :: Proxy CUIntPtr) sz+ , pureUniformBench (Proxy :: Proxy CIntMax) sz+ , pureUniformBench (Proxy :: Proxy CUIntMax) sz+ ]+ , bgroup "uniformR"+ [ bgroup "full"+ [ pureUniformRFullBench (Proxy :: Proxy Word8) sz+ , pureUniformRFullBench (Proxy :: Proxy Word16) sz+ , pureUniformRFullBench (Proxy :: Proxy Word32) sz+ , pureUniformRFullBench (Proxy :: Proxy Word64) sz+ , pureUniformRFullBench (Proxy :: Proxy Word) sz+ , pureUniformRFullBench (Proxy :: Proxy Int8) sz+ , pureUniformRFullBench (Proxy :: Proxy Int16) sz+ , pureUniformRFullBench (Proxy :: Proxy Int32) sz+ , pureUniformRFullBench (Proxy :: Proxy Int64) sz+ , pureUniformRFullBench (Proxy :: Proxy Int) sz+ , pureUniformRFullBench (Proxy :: Proxy Char) sz+ , pureUniformRFullBench (Proxy :: Proxy Bool) sz+ , pureUniformRFullBench (Proxy :: Proxy CChar) sz+ , pureUniformRFullBench (Proxy :: Proxy CSChar) sz+ , pureUniformRFullBench (Proxy :: Proxy CUChar) sz+ , pureUniformRFullBench (Proxy :: Proxy CShort) sz+ , pureUniformRFullBench (Proxy :: Proxy CUShort) sz+ , pureUniformRFullBench (Proxy :: Proxy CInt) sz+ , pureUniformRFullBench (Proxy :: Proxy CUInt) sz+ , pureUniformRFullBench (Proxy :: Proxy CLong) sz+ , pureUniformRFullBench (Proxy :: Proxy CULong) sz+ , pureUniformRFullBench (Proxy :: Proxy CPtrdiff) sz+ , pureUniformRFullBench (Proxy :: Proxy CSize) sz+ , pureUniformRFullBench (Proxy :: Proxy CWchar) sz+ , pureUniformRFullBench (Proxy :: Proxy CSigAtomic) sz+ , pureUniformRFullBench (Proxy :: Proxy CLLong) sz+ , pureUniformRFullBench (Proxy :: Proxy CULLong) sz+ , pureUniformRFullBench (Proxy :: Proxy CIntPtr) sz+ , pureUniformRFullBench (Proxy :: Proxy CUIntPtr) sz+ , pureUniformRFullBench (Proxy :: Proxy CIntMax) sz+ , pureUniformRFullBench (Proxy :: Proxy CUIntMax) sz+ ]+ , bgroup "excludeMax"+ [ pureUniformRExcludeMaxBench (Proxy :: Proxy Word8) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Word16) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Word32) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Word64) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Word) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Int8) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Int16) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Int32) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Int64) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Int) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Char) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy Bool) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CChar) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CSChar) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CUChar) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CShort) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CUShort) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CInt) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CUInt) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CLong) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CULong) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CPtrdiff) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CSize) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CWchar) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CSigAtomic) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CLLong) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CULLong) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CIntPtr) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CUIntPtr) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CIntMax) sz+ , pureUniformRExcludeMaxBench (Proxy :: Proxy CUIntMax) sz+ ]+ , bgroup "includeHalf"+ [ pureUniformRIncludeHalfBench (Proxy :: Proxy Word8) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy Word16) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy Word32) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy Word64) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy Word) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy Int8) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy Int16) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy Int32) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy Int64) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy Int) sz+ , pureUniformRIncludeHalfEnumBench (Proxy :: Proxy Char) sz+ , pureUniformRIncludeHalfEnumBench (Proxy :: Proxy Bool) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CChar) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CSChar) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CUChar) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CShort) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CUShort) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CInt) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CUInt) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CLong) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CULong) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CPtrdiff) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CSize) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CWchar) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CSigAtomic) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CLLong) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CULLong) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CIntPtr) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CUIntPtr) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CIntMax) sz+ , pureUniformRIncludeHalfBench (Proxy :: Proxy CUIntMax) sz+ ]+ , bgroup "unbounded"+ [ pureUniformRBench (Proxy :: Proxy Float) (1.23e-4, 5.67e8) sz+ , pureUniformRBench (Proxy :: Proxy Double) (1.23e-4, 5.67e8) sz+ , let !i = (10 :: Integer) ^ (100 :: Integer)+ !range = (-i - 1, i + 1)+ in pureUniformRBench (Proxy :: Proxy Integer) range sz+ , let !n = (10 :: Natural) ^ (100 :: Natural)+ !range = (1, n - 1)+ in pureUniformRBench (Proxy :: Proxy Natural) range sz+ ]+ , bgroup "floating"+ [ bgroup "IO"+ [ bench "uniformFloat01M" $ nfIO $ runStateGenT_ (mkStdGen 1337) $ \g ->+ replicateM_ sz $ do !_ <- uniformFloat01M g+ return ()+ , bench "uniformFloatPositive01M" $ nfIO $ runStateGenT_ (mkStdGen 1337) $ \g ->+ replicateM_ sz $ do !_ <- uniformFloatPositive01M g+ return ()+ , bench "uniformDouble01M" $ nfIO $ runStateGenT_ (mkStdGen 1337) $ \g ->+ replicateM_ sz $ do !_ <- uniformDouble01M g+ return ()+ , bench "uniformDoublePositive01M" $ nfIO $ runStateGenT_ (mkStdGen 1337) $ \g ->+ replicateM_ sz $ do !_ <- uniformDoublePositive01M g+ return ()+ ]+ --+ , bgroup "St"+ [ bench "uniformFloat01M" $ nf+ (\n -> runStateGen_ (mkStdGen 1337) $ \g -> replicateM_ n $ do !_ <- uniformFloat01M g+ return ()+ ) sz+ , bench "uniformFloatPositive01M" $ nf+ (\n -> runStateGen_ (mkStdGen 1337) $ \g -> replicateM_ n $ do !_ <- uniformFloatPositive01M g+ return ()+ ) sz+ , bench "uniformDouble01M" $ nf+ (\n -> runStateGen_ (mkStdGen 1337) $ \g -> replicateM_ n $ do !_ <- uniformDouble01M g+ return ()+ ) sz+ , bench "uniformDoublePositive01M" $ nf+ (\n -> runStateGen_ (mkStdGen 1337) $ \g -> replicateM_ n $ do !_ <- uniformDoublePositive01M g+ return ()+ ) sz+ ]+ , bgroup "pure"+ [ let !stdGen = mkStdGen 1337+ in bench "uniformFloat01M" $ nf+ (genMany (runState $ uniformFloat01M (StateGenM :: StateGenM StdGen)) stdGen)+ sz+ , let !stdGen = mkStdGen 1337+ in bench "uniformFloatPositive01M" $ nf+ (genMany (runState $ uniformFloatPositive01M (StateGenM :: StateGenM StdGen)) stdGen)+ sz+ , let !stdGen = mkStdGen 1337+ in bench "uniformDouble01M" $ nf+ (genMany (runState $ uniformDouble01M (StateGenM :: StateGenM StdGen)) stdGen)+ sz+ , let !stdGen = mkStdGen 1337+ in bench "uniformDoublePositive01M" $ nf+ (genMany (runState $ uniformDoublePositive01M (StateGenM :: StateGenM StdGen)) stdGen)+ sz+ ]+ ]+ , bgroup "ShortByteString"+ [ env (pure genLengths) $ \ ~(ns, gen) ->+ bench "genShortByteString" $+ nfIO $ runStateGenT_ gen $ \g -> mapM (`uniformShortByteString` g) ns+ ]+ ]+ ]+ ]++pureRandomBench :: forall a. (Typeable a, Random a) => Proxy a -> Int -> Benchmark+pureRandomBench px =+ let !stdGen = mkStdGen 1337+ in pureBench px (genMany (random :: StdGen -> (a, StdGen)) stdGen)++pureUniformBench :: forall a. (Typeable a, Uniform a) => Proxy a -> Int -> Benchmark+pureUniformBench px =+ let !stdGen = mkStdGen 1337+ in pureBench px (genMany (uniform :: StdGen -> (a, StdGen)) stdGen)++pureUniformRFullBench ::+ forall a. (Typeable a, UniformRange a, Bounded a)+ => Proxy a+ -> Int+ -> Benchmark+pureUniformRFullBench px =+ let range = (minBound :: a, maxBound :: a)+ in pureUniformRBench px range++pureUniformRExcludeMaxBench ::+ forall a. (Typeable a, UniformRange a, Bounded a, Enum a)+ => Proxy a+ -> Int+ -> Benchmark+pureUniformRExcludeMaxBench px =+ let range = (minBound :: a, pred (maxBound :: a))+ in pureUniformRBench px range++pureUniformRIncludeHalfBench ::+ forall a. (Typeable a, UniformRange a, Bounded a, Integral a)+ => Proxy a+ -> Int+ -> Benchmark+pureUniformRIncludeHalfBench px =+ let range = ((minBound :: a) + 1, ((maxBound :: a) `div` 2) + 1)+ in pureUniformRBench px range++pureUniformRIncludeHalfEnumBench ::+ forall a. (Typeable a, UniformRange a, Bounded a, Enum a)+ => Proxy a+ -> Int+ -> Benchmark+pureUniformRIncludeHalfEnumBench px =+ let range = (succ (minBound :: a), toEnum ((fromEnum (maxBound :: a) `div` 2) + 1))+ in pureUniformRBench px range++pureUniformRBench ::+ forall a. (Typeable a, UniformRange a)+ => Proxy a+ -> (a, a)+ -> Int+ -> Benchmark+pureUniformRBench px range@(!_, !_) =+ let !stdGen = mkStdGen 1337+ in pureBench px (genMany (uniformR range) stdGen)++pureBench :: forall a. (Typeable a) => Proxy a -> (Int -> ()) -> Int -> Benchmark+pureBench px f sz = bench (showsTypeRep (typeRep px) "") $ nf f sz++genMany :: (g -> (a, g)) -> g -> Int -> ()+genMany f g0 n = go g0 0+ where+ go g i+ | i < n =+ case f g of+ (x, g') -> x `seq` go g' (i + 1)+ | otherwise = g `seq` ()
random.cabal view
@@ -1,70 +1,193 @@-name: random-version: 1.1-----license: BSD3-license-file: LICENSE-maintainer: core-libraries-committee@haskell.org-bug-reports: https://github.com/haskell/random/issues-synopsis: random number library-category: System+cabal-version: >=1.10+name: random+version: 1.2.0+license: BSD3+license-file: LICENSE+maintainer: core-libraries-committee@haskell.org+bug-reports: https://github.com/haskell/random/issues+synopsis: Pseudo-random number generation description:- This package provides a basic random number generation- library, including the ability to split random number- generators.+ This package provides basic pseudo-random number generation, including the+ ability to split random number generators.+ .+ == "System.Random": pure pseudo-random number interface+ .+ In pure code, use 'System.Random.uniform' and 'System.Random.uniformR' from+ "System.Random" to generate pseudo-random numbers with a pure pseudo-random+ number generator like 'System.Random.StdGen'.+ .+ As an example, here is how you can simulate rolls of a six-sided die using+ 'System.Random.uniformR':+ .+ >>> let roll = uniformR (1, 6) :: RandomGen g => g -> (Word, g)+ >>> let rolls = unfoldr (Just . roll) :: RandomGen g => g -> [Word]+ >>> let pureGen = mkStdGen 42+ >>> take 10 (rolls pureGen) :: [Word]+ [1,1,3,2,4,5,3,4,6,2]+ .+ See "System.Random" for more details.+ .+ == "System.Random.Stateful": monadic pseudo-random number interface+ .+ In monadic code, use 'System.Random.Stateful.uniformM' and+ 'System.Random.Stateful.uniformRM' from "System.Random.Stateful" to generate+ pseudo-random numbers with a monadic pseudo-random number generator, or+ using a monadic adapter.+ .+ As an example, here is how you can simulate rolls of a six-sided die using+ 'System.Random.Stateful.uniformRM':+ .+ >>> let rollM = uniformRM (1, 6) :: StatefulGen g m => g -> m Word+ >>> let pureGen = mkStdGen 42+ >>> runStateGen_ pureGen (replicateM 10 . rollM) :: [Word]+ [1,1,3,2,4,5,3,4,6,2]+ .+ The monadic adapter 'System.Random.Stateful.runGenState_' is used here to lift+ the pure pseudo-random number generator @pureGen@ into the+ 'System.Random.Stateful.StatefulGen' context.+ .+ The monadic interface can also be used with existing monadic pseudo-random+ number generators. In this example, we use the one provided in the+ <https://hackage.haskell.org/package/mwc-random mwc-random> package:+ .+ >>> import System.Random.MWC as MWC+ >>> let rollM = uniformRM (1, 6) :: StatefulGen g m => g -> m Word+ >>> monadicGen <- MWC.create+ >>> replicateM 10 (rollM monadicGen) :: IO [Word]+ [2,3,6,6,4,4,3,1,5,4]+ .+ See "System.Random.Stateful" for more details. +category: System+build-type: Simple extra-source-files:- .travis.yml- README.md- CHANGELOG.md- .gitignore- .darcs-boring+ README.md+ CHANGELOG.md+tested-with: GHC == 7.10.2+ , GHC == 7.10.3+ , GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.3+ , GHC == 8.4.4+ , GHC == 8.6.3+ , GHC == 8.6.4+ , GHC == 8.6.5+ , GHC == 8.8.1+ , GHC == 8.8.2+ , GHC == 8.10.1 +source-repository head+ type: git+ location: https://github.com/haskell/random.git -build-type: Simple--- cabal-version 1.8 needed because "the field 'build-depends: random' refers--- to a library which is defined within the same package"-cabal-version: >= 1.8+library+ exposed-modules:+ System.Random+ System.Random.Internal+ System.Random.Stateful + hs-source-dirs: src+ default-language: Haskell2010+ ghc-options:+ -Wall+ if impl(ghc >= 8.0)+ ghc-options:+ -Wincomplete-record-updates -Wincomplete-uni-patterns + build-depends:+ base >=4.8 && <5,+ bytestring >=0.10.4 && <0.11,+ deepseq >=1.1 && <2,+ mtl >=2.2 && <2.3,+ splitmix >=0.1 && <0.2+ if impl(ghc < 8.0)+ build-depends:+ transformers -Library- exposed-modules:- System.Random- extensions: CPP- GHC-Options: -O2- build-depends: base >= 3 && < 5, time+test-suite legacy-test+ type: exitcode-stdio-1.0+ main-is: Legacy.hs+ hs-source-dirs: test-legacy+ other-modules:+ T7936+ TestRandomIOs+ TestRandomRs+ Random1283+ RangeTest -source-repository head- type: git- location: http://git.haskell.org/packages/random.git+ default-language: Haskell2010+ ghc-options: -with-rtsopts=-M4M+ if impl(ghc >= 8.0)+ ghc-options:+ -Wno-deprecations+ build-depends:+ base -any,+ containers >=0.5 && <0.7,+ random -any --- To run the Test-Suite:--- $ cabal configure --enable-tests--- $ cabal test --show-details=always --test-options="+RTS -M1M -RTS"+test-suite doctests+ type: exitcode-stdio-1.0+ main-is: doctests.hs+ hs-source-dirs: test+ default-language: Haskell2010+ build-depends:+ base -any,+ doctest >=0.15 && <0.18,+ mwc-random >=0.13 && <0.15,+ primitive >=0.6 && <0.8,+ random -any,+ unliftio >=0.2 && <0.3,+ vector >= 0.10 && <0.14 -Test-Suite T7936- type: exitcode-stdio-1.0- main-is: T7936.hs- hs-source-dirs: tests- build-depends: base >= 3 && < 5, random- ghc-options: -rtsopts -O2+test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ other-modules:+ Spec.Range+ Spec.Run -Test-Suite TestRandomRs- type: exitcode-stdio-1.0- main-is: TestRandomRs.hs- hs-source-dirs: tests- build-depends: base >= 3 && < 5, random- ghc-options: -rtsopts -O2- -- TODO. Why does the following not work?- --test-options: +RTS -M1M -RTS+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base -any,+ bytestring -any,+ random -any,+ smallcheck >=1.2 && <1.3,+ tasty >=1.0 && <1.4,+ tasty-smallcheck >=0.8 && <0.9,+ tasty-expected-failure >=0.11 && <0.12,+ tasty-hunit >=0.10 && <0.11 -Test-Suite TestRandomIOs- type: exitcode-stdio-1.0- main-is: TestRandomIOs.hs- hs-source-dirs: tests- build-depends: base >= 3 && < 5, random- ghc-options: -rtsopts -O2+benchmark legacy-bench+ type: exitcode-stdio-1.0+ main-is: SimpleRNGBench.hs+ hs-source-dirs: bench-legacy+ other-modules: BinSearch+ default-language: Haskell2010+ ghc-options:+ -Wall -O2 -threaded -rtsopts -with-rtsopts=-N+ if impl(ghc >= 8.0)+ ghc-options:+ -Wno-deprecations++ build-depends:+ base -any,+ random -any,+ rdtsc -any,+ split >=0.2 && <0.3,+ time >=1.4 && <1.11++benchmark bench+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: bench+ default-language: Haskell2010+ ghc-options: -Wall -O2+ build-depends:+ base -any,+ gauge >=0.2.3 && <0.3,+ mtl,+ random -any,+ splitmix >=0.1 && <0.2
+ src/System/Random.hs view
@@ -0,0 +1,500 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Trustworthy #-}++-- |+-- Module : System.Random+-- Copyright : (c) The University of Glasgow 2001+-- License : BSD-style (see the file LICENSE in the 'random' repository)+-- Maintainer : libraries@haskell.org+-- Stability : stable+--+-- This library deals with the common task of pseudo-random number generation.+module System.Random+ (+ -- * Introduction+ -- $introduction++ -- * Usage+ -- $usagepure++ -- * Pure number generator interface+ -- $interfaces+ RandomGen(..)+ , uniform+ , uniformR+ , genByteString+ , Random(..)+ , Uniform+ , UniformRange+ -- ** Standard pseudo-random number generator+ , StdGen+ , mkStdGen++ -- ** Global standard pseudo-random number generator+ -- $globalstdgen+ , getStdRandom+ , getStdGen+ , setStdGen+ , newStdGen+ , randomIO+ , randomRIO++ -- * Compatibility and reproducibility+ -- ** Backwards compatibility and deprecations+ -- $deprecations++ -- ** Reproducibility+ -- $reproducibility++ -- * Notes for pseudo-random number generator implementors+ -- ** How to implement 'RandomGen'+ -- $implementrandomgen++ -- * References+ -- $references+ ) where++import Control.Arrow+import Control.Monad.IO.Class+import Data.ByteString (ByteString)+import Data.Int+import Data.IORef+import Data.Word+import Foreign.C.Types+import GHC.Exts+import System.IO.Unsafe (unsafePerformIO)+import System.Random.Internal+import qualified System.Random.SplitMix as SM++-- $introduction+--+-- This module provides type classes and instances for the following concepts:+--+-- [Pure pseudo-random number generators] 'RandomGen' is an interface to pure+-- pseudo-random number generators.+--+-- 'StdGen', the standard pseudo-random number generator provided in this+-- library, is an instance of 'RandomGen'. It uses the SplitMix+-- implementation provided by the+-- <https://hackage.haskell.org/package/splitmix splitmix> package.+-- Programmers may, of course, supply their own instances of 'RandomGen'.+--+-- $usagepure+--+-- In pure code, use 'uniform' and 'uniformR' to generate pseudo-random values+-- with a pure pseudo-random number generator like 'StdGen'.+--+-- >>> :{+-- let rolls :: RandomGen g => Int -> g -> [Word]+-- rolls n = take n . unfoldr (Just . uniformR (1, 6))+-- pureGen = mkStdGen 137+-- in+-- rolls 10 pureGen :: [Word]+-- :}+-- [4,2,6,1,6,6,5,1,1,5]+--+-- To run use a /monadic/ pseudo-random computation in pure code with a pure+-- pseudo-random number generator, use 'runGenState' and its variants.+--+-- >>> :{+-- let rollsM :: StatefulGen g m => Int -> g -> m [Word]+-- rollsM n = replicateM n . uniformRM (1, 6)+-- pureGen = mkStdGen 137+-- in+-- runStateGen_ pureGen (rollsM 10) :: [Word]+-- :}+-- [4,2,6,1,6,6,5,1,1,5]++-------------------------------------------------------------------------------+-- Pseudo-random number generator interfaces+-------------------------------------------------------------------------------++-- $interfaces+--+-- Pseudo-random number generators come in two flavours: /pure/ and /monadic/.+--+-- ['RandomGen': pure pseudo-random number generators] These generators produce+-- a new pseudo-random value together with a new instance of the+-- pseudo-random number generator.+--+-- Pure pseudo-random number generators should implement 'split' if they+-- are /splittable/, that is, if there is an efficient method to turn one+-- generator into two. The pseudo-random numbers produced by the two+-- resulting generators should not be correlated. See [1] for some+-- background on splittable pseudo-random generators.+--+-- ['System.Random.Stateful.StatefulGen': monadic pseudo-random number generators]+-- See "System.Random.Stateful" module+--++-- | Generates a value uniformly distributed over all possible values of that+-- type.+--+-- This is a pure version of 'System.Random.Stateful.uniformM'.+--+-- ====__Examples__+--+-- >>> import System.Random+-- >>> let pureGen = mkStdGen 137+-- >>> uniform pureGen :: (Bool, StdGen)+-- (True,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627})+--+-- @since 1.2.0+uniform :: (RandomGen g, Uniform a) => g -> (a, g)+uniform g = runStateGen g uniformM++-- | Generates a value uniformly distributed over the provided range, which+-- is interpreted as inclusive in the lower and upper bound.+--+-- * @uniformR (1 :: Int, 4 :: Int)@ generates values uniformly from the set+-- \(\{1,2,3,4\}\)+--+-- * @uniformR (1 :: Float, 4 :: Float)@ generates values uniformly from the+-- set \(\{x\;|\;1 \le x \le 4\}\)+--+-- The following law should hold to make the function always defined:+--+-- > uniformR (a, b) = uniformR (b, a)+--+-- This is a pure version of 'System.Random.Stateful.uniformRM'.+--+-- ====__Examples__+--+-- >>> import System.Random+-- >>> let pureGen = mkStdGen 137+-- >>> uniformR (1 :: Int, 4 :: Int) pureGen+-- (4,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627})+--+-- @since 1.2.0+uniformR :: (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)+uniformR r g = runStateGen g (uniformRM r)++-- | Generates a 'ByteString' of the specified size using a pure pseudo-random+-- number generator. See 'uniformByteString' for the monadic version.+--+-- ====__Examples__+--+-- >>> import System.Random+-- >>> import Data.ByteString+-- >>> let pureGen = mkStdGen 137+-- >>> unpack . fst . genByteString 10 $ pureGen+-- [51,123,251,37,49,167,90,109,1,4]+--+-- @since 1.2.0+genByteString :: RandomGen g => Int -> g -> (ByteString, g)+genByteString n g = runStateGenST g (uniformByteStringM n)+{-# INLINE genByteString #-}++-- | The class of types for which uniformly distributed values can be+-- generated.+--+-- 'Random' exists primarily for backwards compatibility with version 1.1 of+-- this library. In new code, use the better specified 'Uniform' and+-- 'UniformRange' instead.+class Random a where++ -- | Takes a range /(lo,hi)/ and a pseudo-random number generator+ -- /g/, and returns a pseudo-random value uniformly distributed over the+ -- closed interval /[lo,hi]/, together with a new generator. It is unspecified+ -- what happens if /lo>hi/. For continuous types there is no requirement+ -- that the values /lo/ and /hi/ are ever produced, but they may be,+ -- depending on the implementation and the interval.+ {-# INLINE randomR #-}+ randomR :: RandomGen g => (a, a) -> g -> (a, g)+ default randomR :: (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)+ randomR r g = runStateGen g (uniformRM r)++ -- | The same as 'randomR', but using a default range determined by the type:+ --+ -- * For bounded types (instances of 'Bounded', such as 'Char'),+ -- the range is normally the whole type.+ --+ -- * For fractional types, the range is normally the semi-closed interval+ -- @[0,1)@.+ --+ -- * For 'Integer', the range is (arbitrarily) the range of 'Int'.+ {-# INLINE random #-}+ random :: RandomGen g => g -> (a, g)+ default random :: (RandomGen g, Uniform a) => g -> (a, g)+ random g = runStateGen g uniformM++ -- | Plural variant of 'randomR', producing an infinite list of+ -- pseudo-random values instead of returning a new generator.+ {-# INLINE randomRs #-}+ randomRs :: RandomGen g => (a,a) -> g -> [a]+ randomRs ival g = build (\cons _nil -> buildRandoms cons (randomR ival) g)++ -- | Plural variant of 'random', producing an infinite list of+ -- pseudo-random values instead of returning a new generator.+ {-# INLINE randoms #-}+ randoms :: RandomGen g => g -> [a]+ randoms g = build (\cons _nil -> buildRandoms cons random g)+++-- | Produce an infinite list-equivalent of pseudo-random values.+--+-- ====__Examples__+--+-- >>> import System.Random+-- >>> let pureGen = mkStdGen 137+-- >>> (take 4 . buildRandoms (:) random $ pureGen) :: [Int]+-- [7879794327570578227,6883935014316540929,-1519291874655152001,2353271688382626589]+--+{-# INLINE buildRandoms #-}+buildRandoms :: RandomGen g+ => (a -> as -> as) -- ^ E.g. '(:)' but subject to fusion+ -> (g -> (a,g)) -- ^ E.g. 'random'+ -> g -- ^ A 'RandomGen' instance+ -> as+buildRandoms cons rand = go+ where+ -- The seq fixes part of #4218 and also makes fused Core simpler.+ go g = x `seq` (x `cons` go g') where (x,g') = rand g++-- Generate values in the Int range+instance Random Integer where+ random = first (toInteger :: Int -> Integer) . random+instance Random Int8+instance Random Int16+instance Random Int32+instance Random Int64+instance Random Int+instance Random Word+instance Random Word8+instance Random Word16+instance Random Word32+instance Random Word64+#if __GLASGOW_HASKELL >= 802+instance Random CBool+#endif+instance Random CChar+instance Random CSChar+instance Random CUChar+instance Random CShort+instance Random CUShort+instance Random CInt+instance Random CUInt+instance Random CLong+instance Random CULong+instance Random CPtrdiff+instance Random CSize+instance Random CWchar+instance Random CSigAtomic+instance Random CLLong+instance Random CULLong+instance Random CIntPtr+instance Random CUIntPtr+instance Random CIntMax+instance Random CUIntMax+instance Random CFloat where+ randomR (CFloat l, CFloat h) = first CFloat . randomR (l, h)+ random = first CFloat . random+instance Random CDouble where+ randomR (CDouble l, CDouble h) = first CDouble . randomR (l, h)+ random = first CDouble . random++instance Random Char+instance Random Bool+instance Random Double where+ randomR r g = runStateGen g (uniformRM r)+ random g = runStateGen g (uniformRM (0, 1))+instance Random Float where+ randomR r g = runStateGen g (uniformRM r)+ random g = runStateGen g (uniformRM (0, 1))++-------------------------------------------------------------------------------+-- Global pseudo-random number generator+-------------------------------------------------------------------------------++-- $globalstdgen+--+-- There is a single, implicit, global pseudo-random number generator of type+-- 'StdGen', held in a global variable maintained by the 'IO' monad. It is+-- initialised automatically in some system-dependent fashion. To get+-- deterministic behaviour, use 'setStdGen'.+--+-- Note that 'mkStdGen' also gives deterministic behaviour without requiring an+-- 'IO' context.++-- |Sets the global pseudo-random number generator.+setStdGen :: MonadIO m => StdGen -> m ()+setStdGen = liftIO . writeIORef theStdGen++-- |Gets the global pseudo-random number generator.+getStdGen :: MonadIO m => m StdGen+getStdGen = liftIO $ readIORef theStdGen++theStdGen :: IORef StdGen+theStdGen = unsafePerformIO $ SM.initSMGen >>= newIORef . StdGen+{-# NOINLINE theStdGen #-}++-- |Applies 'split' to the current global pseudo-random generator,+-- updates it with one of the results, and returns the other.+newStdGen :: MonadIO m => m StdGen+newStdGen = liftIO $ atomicModifyIORef' theStdGen split++{- |Uses the supplied function to get a value from the current global+random generator, and updates the global generator with the new generator+returned by the function. For example, @rollDice@ gets a pseudo-random integer+between 1 and 6:++> rollDice :: IO Int+> rollDice = getStdRandom (randomR (1,6))++-}+getStdRandom :: MonadIO m => (StdGen -> (a, StdGen)) -> m a+getStdRandom f = liftIO $ atomicModifyIORef' theStdGen (swap . f)+ where swap (v, g) = (g, v)+++-- | A variant of 'randomR' that uses the global pseudo-random number+-- generator.+randomRIO :: (Random a, MonadIO m) => (a, a) -> m a+randomRIO range = liftIO $ getStdRandom (randomR range)++-- | A variant of 'random' that uses the global pseudo-random number+-- generator.+randomIO :: (Random a, MonadIO m) => m a+randomIO = liftIO $ getStdRandom random++-------------------------------------------------------------------------------+-- Notes+-------------------------------------------------------------------------------++-- $implementrandomgen+--+-- Consider these points when writing a 'RandomGen' instance for a given pure+-- pseudo-random number generator:+--+-- * If the pseudo-random number generator has a power-of-2 modulus, that is,+-- it natively outputs @2^n@ bits of randomness for some @n@, implement+-- 'genWord8', 'genWord16', 'genWord32' and 'genWord64'. See below for more+-- details.+--+-- * If the pseudo-random number generator does not have a power-of-2+-- modulus, implement 'next' and 'genRange'. See below for more details.+--+-- * If the pseudo-random number generator is splittable, implement 'split'.+-- If there is no suitable implementation, 'split' should fail with a+-- helpful error message.+--+-- === How to implement 'RandomGen' for a pseudo-random number generator with power-of-2 modulus+--+-- Suppose you want to implement a [permuted congruential+-- generator](https://en.wikipedia.org/wiki/Permuted_congruential_generator).+--+-- >>> data PCGen = PCGen !Word64 !Word64+--+-- It produces a full 'Word32' of randomness per iteration.+--+-- >>> import Data.Bits+-- >>> :{+-- let stepGen :: PCGen -> (Word32, PCGen)+-- stepGen (PCGen state inc) = let+-- newState = state * 6364136223846793005 + (inc .|. 1)+-- xorShifted = fromIntegral (((state `shiftR` 18) `xor` state) `shiftR` 27) :: Word32+-- rot = fromIntegral (state `shiftR` 59) :: Word32+-- out = (xorShifted `shiftR` (fromIntegral rot)) .|. (xorShifted `shiftL` fromIntegral ((-rot) .&. 31))+-- in (out, PCGen newState inc)+-- :}+--+-- >>> fst $ stepGen $ snd $ stepGen (PCGen 17 29)+-- 3288430965+--+-- You can make it an instance of 'RandomGen' as follows:+--+-- >>> :{+-- instance RandomGen PCGen where+-- genWord32 = stepGen+-- split _ = error "PCG is not splittable"+-- :}+--+--+-- === How to implement 'RandomGen' for a pseudo-random number generator without a power-of-2 modulus+--+-- __We do not recommend you implement any new pseudo-random number generators without a power-of-2 modulus.__+--+-- Pseudo-random number generators without a power-of-2 modulus perform+-- /significantly worse/ than pseudo-random number generators with a power-of-2+-- modulus with this library. This is because most functionality in this+-- library is based on generating and transforming uniformly pseudo-random+-- machine words, and generating uniformly pseudo-random machine words using a+-- pseudo-random number generator without a power-of-2 modulus is expensive.+--+-- The pseudo-random number generator from+-- <https://dl.acm.org/doi/abs/10.1145/62959.62969 L’Ecuyer (1988)> natively+-- generates an integer value in the range @[1, 2147483562]@. This is the+-- generator used by this library before it was replaced by SplitMix in version+-- 1.2.+--+-- >>> data LegacyGen = LegacyGen !Int32 !Int32+-- >>> :{+-- let legacyNext :: LegacyGen -> (Int, LegacyGen)+-- legacyNext (LegacyGen s1 s2) = (fromIntegral z', LegacyGen s1'' s2'') where+-- z' = if z < 1 then z + 2147483562 else z+-- z = s1'' - s2''+-- k = s1 `quot` 53668+-- s1' = 40014 * (s1 - k * 53668) - k * 12211+-- s1'' = if s1' < 0 then s1' + 2147483563 else s1'+-- k' = s2 `quot` 52774+-- s2' = 40692 * (s2 - k' * 52774) - k' * 3791+-- s2'' = if s2' < 0 then s2' + 2147483399 else s2'+-- :}+--+-- You can make it an instance of 'RandomGen' as follows:+--+-- >>> :{+-- instance RandomGen LegacyGen where+-- next = legacyNext+-- genRange _ = (1, 2147483562)+-- split _ = error "Not implemented"+-- :}+--+-- $deprecations+--+-- Version 1.2 mostly maintains backwards compatibility with version 1.1. This+-- has a few consequences users should be aware of:+--+-- * The type class 'Random' is only provided for backwards compatibility.+-- New code should use 'Uniform' and 'UniformRange' instead.+--+-- * The methods 'next' and 'genRange' in 'RandomGen' are deprecated and only+-- provided for backwards compatibility. New instances of 'RandomGen' should+-- implement word-based methods instead. See below for more information+-- about how to write a 'RandomGen' instance.+--+-- * This library provides instances for 'Random' for some unbounded types+-- for backwards compatibility. For an unbounded type, there is no way+-- to generate a value with uniform probability out of its entire domain, so+-- the 'random' implementation for unbounded types actually generates a+-- value based on some fixed range.+--+-- For 'Integer', 'random' generates a value in the 'Int' range. For 'Float'+-- and 'Double', 'random' generates a floating point value in the range @[0,+-- 1)@.+--+-- This library does not provide 'Uniform' instances for any unbounded+-- types.+--+-- $reproducibility+--+-- If you have two builds of a particular piece of code against this library,+-- any deterministic function call should give the same result in the two+-- builds if the builds are+--+-- * compiled against the same major version of this library+-- * on the same architecture (32-bit or 64-bit)+--+-- $references+--+-- 1. 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:+-- <https://doi.org/10.1145/2660193.2660195>++-- $setup+--+-- >>> import Control.Monad (replicateM)+-- >>> import Data.List (unfoldr)
+ src/System/Random/Internal.hs view
@@ -0,0 +1,1111 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GHCForeignImportPrim #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UnliftedFFITypes #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TypeFamilyDependencies #-}+#else+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE KindSignatures #-}+#endif+{-# OPTIONS_HADDOCK hide, not-home #-}++-- |+-- Module : System.Random.Internal+-- Copyright : (c) The University of Glasgow 2001+-- License : BSD-style (see the file LICENSE in the 'random' repository)+-- Maintainer : libraries@haskell.org+-- Stability : stable+--+-- This library deals with the common task of pseudo-random number generation.+module System.Random.Internal+ (-- * Pure and monadic pseudo-random number generator interfaces+ RandomGen(..)+ , StatefulGen(..)+ , FrozenGen(..)++ -- ** Standard pseudo-random number generator+ , StdGen(..)+ , mkStdGen++ -- * Monadic adapters for pure pseudo-random number generators+ -- ** Pure adapter+ , StateGen(..)+ , StateGenM(..)+ , splitGen+ , runStateGen+ , runStateGen_+ , runStateGenT+ , runStateGenT_+ , runStateGenST++ -- * Pseudo-random values of various types+ , Uniform(..)+ , UniformRange(..)+ , uniformByteStringM+ , uniformDouble01M+ , uniformDoublePositive01M+ , uniformFloat01M+ , uniformFloatPositive01M++ -- * Generators for sequences of pseudo-random bytes+ , genShortByteStringIO+ , genShortByteStringST+ ) where++import Control.Arrow+import Control.DeepSeq (NFData)+import Control.Monad.IO.Class+import Control.Monad.ST+import Control.Monad.ST.Unsafe+import Control.Monad.State.Strict+import Data.Bits+import Data.ByteString.Builder.Prim (word64LE)+import Data.ByteString.Builder.Prim.Internal (runF)+import Data.ByteString.Short.Internal (ShortByteString(SBS), fromShort)+import Data.Int+import Data.Word+import Foreign.C.Types+import Foreign.Ptr (plusPtr)+import Foreign.Storable (Storable(pokeByteOff))+import GHC.Exts+import GHC.IO (IO(..))+import GHC.Word+import Numeric.Natural (Natural)+import System.IO.Unsafe (unsafePerformIO)+import qualified System.Random.SplitMix as SM+import qualified System.Random.SplitMix32 as SM32+#if __GLASGOW_HASKELL__ >= 800+import Data.Kind+#endif+#if __GLASGOW_HASKELL__ >= 802+import Data.ByteString.Internal (ByteString(PS))+import GHC.ForeignPtr+#else+import Data.ByteString (ByteString)+#endif++-- | 'RandomGen' is an interface to pure pseudo-random number generators.+--+-- 'StdGen' is the standard 'RandomGen' instance provided by this library.+{-# DEPRECATED next "No longer used" #-}+{-# DEPRECATED genRange "No longer used" #-}+class RandomGen g where+ {-# MINIMAL split,(genWord32|genWord64|(next,genRange)) #-}+ -- | Returns an 'Int' that is uniformly distributed over the range returned by+ -- 'genRange' (including both end points), and a new generator. Using 'next'+ -- is inefficient as all operations go via 'Integer'. See+ -- [here](https://alexey.kuleshevi.ch/blog/2019/12/21/random-benchmarks) for+ -- more details. It is thus deprecated.+ next :: g -> (Int, g)+ next g = runStateGen g (uniformRM (genRange g))++ -- | Returns a 'Word8' that is uniformly distributed over the entire 'Word8'+ -- range.+ --+ -- @since 1.2.0+ genWord8 :: g -> (Word8, g)+ genWord8 = first fromIntegral . genWord32++ -- | Returns a 'Word16' that is uniformly distributed over the entire 'Word16'+ -- range.+ --+ -- @since 1.2.0+ genWord16 :: g -> (Word16, g)+ genWord16 = first fromIntegral . genWord32++ -- | Returns a 'Word32' that is uniformly distributed over the entire 'Word32'+ -- range.+ --+ -- @since 1.2.0+ genWord32 :: g -> (Word32, g)+ genWord32 = randomIvalIntegral (minBound, maxBound)+ -- Once `next` is removed, this implementation should be used instead:+ -- first fromIntegral . genWord64++ -- | Returns a 'Word64' that is uniformly distributed over the entire 'Word64'+ -- range.+ --+ -- @since 1.2.0+ genWord64 :: g -> (Word64, g)+ genWord64 g =+ case genWord32 g of+ (l32, g') ->+ case genWord32 g' of+ (h32, g'') ->+ ((fromIntegral h32 `shiftL` 32) .|. fromIntegral l32, g'')++ -- | @genWord32R upperBound g@ returns a 'Word32' that is uniformly+ -- distributed over the range @[0, upperBound]@.+ --+ -- @since 1.2.0+ genWord32R :: Word32 -> g -> (Word32, g)+ genWord32R m g = runStateGen g (unbiasedWordMult32 m)++ -- | @genWord64R upperBound g@ returns a 'Word64' that is uniformly+ -- distributed over the range @[0, upperBound]@.+ --+ -- @since 1.2.0+ genWord64R :: Word64 -> g -> (Word64, g)+ genWord64R m g = runStateGen g (unsignedBitmaskWithRejectionM uniformWord64 m)++ -- | @genShortByteString n g@ returns a 'ShortByteString' of length @n@+ -- filled with pseudo-random bytes.+ --+ -- @since 1.2.0+ genShortByteString :: Int -> g -> (ShortByteString, g)+ genShortByteString n g =+ unsafePerformIO $ runStateGenT g (genShortByteStringIO n . uniformWord64)+ {-# INLINE genShortByteString #-}++ -- | Yields the range of values returned by 'next'.+ --+ -- It is required that:+ --+ -- * If @(a, b) = 'genRange' g@, then @a < b@.+ -- * 'genRange' must not examine its argument so the value it returns is+ -- determined only by the instance of 'RandomGen'.+ --+ -- The default definition spans the full range of 'Int'.+ genRange :: g -> (Int, Int)+ genRange _ = (minBound, maxBound)++ -- | Returns two distinct pseudo-random number generators.+ --+ -- Implementations should take care to ensure that the resulting generators+ -- are not correlated. Some pseudo-random number generators are not+ -- splittable. In that case, the 'split' implementation should fail with a+ -- descriptive 'error' message.+ split :: g -> (g, g)+++-- | 'StatefulGen' is an interface to monadic pseudo-random number generators.+class Monad m => StatefulGen g m where+ {-# MINIMAL (uniformWord32|uniformWord64) #-}+ -- | @uniformWord32R upperBound g@ generates a 'Word32' that is uniformly+ -- distributed over the range @[0, upperBound]@.+ --+ -- @since 1.2.0+ uniformWord32R :: Word32 -> g -> m Word32+ uniformWord32R = unsignedBitmaskWithRejectionM uniformWord32++ -- | @uniformWord64R upperBound g@ generates a 'Word64' that is uniformly+ -- distributed over the range @[0, upperBound]@.+ --+ -- @since 1.2.0+ uniformWord64R :: Word64 -> g -> m Word64+ uniformWord64R = unsignedBitmaskWithRejectionM uniformWord64++ -- | Generates a 'Word8' that is uniformly distributed over the entire 'Word8'+ -- range.+ --+ -- The default implementation extracts a 'Word8' from 'uniformWord32'.+ --+ -- @since 1.2.0+ uniformWord8 :: g -> m Word8+ uniformWord8 = fmap fromIntegral . uniformWord32++ -- | Generates a 'Word16' that is uniformly distributed over the entire+ -- 'Word16' range.+ --+ -- The default implementation extracts a 'Word16' from 'uniformWord32'.+ --+ -- @since 1.2.0+ uniformWord16 :: g -> m Word16+ uniformWord16 = fmap fromIntegral . uniformWord32++ -- | Generates a 'Word32' that is uniformly distributed over the entire+ -- 'Word32' range.+ --+ -- The default implementation extracts a 'Word32' from 'uniformWord64'.+ --+ -- @since 1.2.0+ uniformWord32 :: g -> m Word32+ uniformWord32 = fmap fromIntegral . uniformWord64++ -- | Generates a 'Word64' that is uniformly distributed over the entire+ -- 'Word64' range.+ --+ -- The default implementation combines two 'Word32' from 'uniformWord32' into+ -- one 'Word64'.+ --+ -- @since 1.2.0+ uniformWord64 :: g -> m Word64+ uniformWord64 g = do+ l32 <- uniformWord32 g+ h32 <- uniformWord32 g+ pure (shiftL (fromIntegral h32) 32 .|. fromIntegral l32)++ -- | @uniformShortByteString n g@ generates a 'ShortByteString' of length @n@+ -- filled with pseudo-random bytes.+ --+ -- @since 1.2.0+ uniformShortByteString :: Int -> g -> m ShortByteString+ default uniformShortByteString :: MonadIO m => Int -> g -> m ShortByteString+ uniformShortByteString n = genShortByteStringIO n . uniformWord64+ {-# INLINE uniformShortByteString #-}++++-- | This class is designed for stateful pseudo-random number generators that+-- can be saved as and restored from an immutable data type.+--+-- @since 1.2.0+class StatefulGen (MutableGen f m) m => FrozenGen f m where+ -- | Represents the state of the pseudo-random number generator for use with+ -- 'thawGen' and 'freezeGen'.+ --+ -- @since 1.2.0+#if __GLASGOW_HASKELL__ >= 800+ type MutableGen f m = (g :: Type) | g -> f+#else+ type MutableGen f m :: *+#endif+ -- | Saves the state of the pseudo-random number generator as a frozen seed.+ --+ -- @since 1.2.0+ freezeGen :: MutableGen f m -> m f+ -- | Restores the pseudo-random number generator from its frozen seed.+ --+ -- @since 1.2.0+ thawGen :: f -> m (MutableGen f m)+++data MBA s = MBA (MutableByteArray# s)+++-- | Efficiently generates a sequence of pseudo-random bytes in a platform+-- independent manner.+--+-- @since 1.2.0+genShortByteStringIO ::+ MonadIO m+ => Int -- ^ Number of bytes to generate+ -> m Word64 -- ^ IO action that can generate 8 random bytes at a time+ -> m ShortByteString+genShortByteStringIO n0 gen64 = do+ let !n@(I# n#) = max 0 n0+ !n64 = n `quot` 8+ !nrem64 = n `rem` 8+ MBA mba# <-+ liftIO $+ IO $ \s# ->+ case newPinnedByteArray# n# s# of+ (# s'#, mba# #) -> (# s'#, MBA mba# #)+ let go i ptr+ | i < n64 = do+ w64 <- gen64+ -- Writing 8 bytes at a time in a Little-endian order gives us+ -- platform portability+ liftIO $ runF word64LE w64 ptr+ go (i + 1) (ptr `plusPtr` 8)+ | otherwise = return ptr+ ptr <- go 0 (Ptr (byteArrayContents# (unsafeCoerce# mba#)))+ when (nrem64 > 0) $ do+ w64 <- gen64+ -- In order to not mess up the byte order we write generated Word64 into a+ -- temporary pointer and then copy only the missing bytes over to the array.+ -- It is tempting to simply generate as many bytes as we still need using+ -- smaller generators (eg. uniformWord8), but that would result in+ -- inconsistent tail when total length is slightly varied.+ liftIO $ do+ let goRem64 z i =+ when (i < nrem64) $ do+ pokeByteOff ptr i (fromIntegral z :: Word8)+ goRem64 (z `shiftR` 8) (i + 1)+ goRem64 w64 0+ liftIO $+ IO $ \s# ->+ case unsafeFreezeByteArray# mba# s# of+ (# s'#, ba# #) -> (# s'#, SBS ba# #)+{-# INLINE genShortByteStringIO #-}++-- | Same as 'genShortByteStringIO', but runs in 'ST'.+--+-- @since 1.2.0+genShortByteStringST :: Int -> ST s Word64 -> ST s ShortByteString+genShortByteStringST n action =+ unsafeIOToST (genShortByteStringIO n (unsafeSTToIO action))+++-- | Generates a pseudo-random 'ByteString' of the specified size.+--+-- @since 1.2.0+{-# INLINE uniformByteStringM #-}+uniformByteStringM :: StatefulGen g m => Int -> g -> m ByteString+uniformByteStringM n g = do+ ba <- uniformShortByteString n g+ pure $+#if __GLASGOW_HASKELL__ < 802+ fromShort ba+#else+ let !(SBS ba#) = ba in+ if isTrue# (isByteArrayPinned# ba#)+ then pinnedByteArrayToByteString ba#+ else fromShort ba++pinnedByteArrayToByteString :: ByteArray# -> ByteString+pinnedByteArrayToByteString ba# =+ PS (pinnedByteArrayToForeignPtr ba#) 0 (I# (sizeofByteArray# ba#))+{-# INLINE pinnedByteArrayToByteString #-}++pinnedByteArrayToForeignPtr :: ByteArray# -> ForeignPtr a+pinnedByteArrayToForeignPtr ba# =+ ForeignPtr (byteArrayContents# ba#) (PlainPtr (unsafeCoerce# ba#))+{-# INLINE pinnedByteArrayToForeignPtr #-}+#endif+++-- | Opaque data type that carries the type of a pure pseudo-random number+-- generator.+--+-- @since 1.2.0+data StateGenM g = StateGenM++-- | Wrapper for pure state gen, which acts as an immutable seed for the corresponding+-- stateful generator `StateGenM`+--+-- @since 1.2.0+newtype StateGen g = StateGen { unStateGen :: g }+ deriving (Eq, Ord, Show, RandomGen, Storable, NFData)++instance (RandomGen g, MonadState g m) => StatefulGen (StateGenM g) m where+ uniformWord32R r _ = state (genWord32R r)+ uniformWord64R r _ = state (genWord64R r)+ uniformWord8 _ = state genWord8+ uniformWord16 _ = state genWord16+ uniformWord32 _ = state genWord32+ uniformWord64 _ = state genWord64+ uniformShortByteString n _ = state (genShortByteString n)++instance (RandomGen g, MonadState g m) => FrozenGen (StateGen g) m where+ type MutableGen (StateGen g) m = StateGenM g+ freezeGen _ = fmap StateGen get+ thawGen (StateGen g) = StateGenM <$ put g++-- | Splits a pseudo-random number generator into two. Updates the state with+-- one of the resulting generators and returns the other.+--+-- @since 1.2.0+splitGen :: (MonadState g m, RandomGen g) => m g+splitGen = state split++-- | Runs a monadic generating action in the `State` monad using a pure+-- pseudo-random number generator.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> runStateGen pureGen randomM :: (Int, StdGen)+-- (7879794327570578227,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627})+--+-- @since 1.2.0+runStateGen :: RandomGen g => g -> (StateGenM g -> State g a) -> (a, g)+runStateGen g f = runState (f StateGenM) g++-- | Runs a monadic generating action in the `State` monad using a pure+-- pseudo-random number generator. Returns only the resulting pseudo-random+-- value.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> runStateGen_ pureGen randomM :: Int+-- 7879794327570578227+--+-- @since 1.2.0+runStateGen_ :: RandomGen g => g -> (StateGenM g -> State g a) -> a+runStateGen_ g = fst . runStateGen g++-- | Runs a monadic generating action in the `StateT` monad using a pure+-- pseudo-random number generator.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> runStateGenT pureGen randomM :: IO (Int, StdGen)+-- (7879794327570578227,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627})+--+-- @since 1.2.0+runStateGenT :: RandomGen g => g -> (StateGenM g -> StateT g m a) -> m (a, g)+runStateGenT g f = runStateT (f StateGenM) g++-- | Runs a monadic generating action in the `StateT` monad using a pure+-- pseudo-random number generator. Returns only the resulting pseudo-random+-- value.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> runStateGenT_ pureGen randomM :: IO Int+-- 7879794327570578227+--+-- @since 1.2.0+runStateGenT_ :: (RandomGen g, Functor f) => g -> (StateGenM g -> StateT g f a) -> f a+runStateGenT_ g = fmap fst . runStateGenT g++-- | Runs a monadic generating action in the `ST` monad using a pure+-- pseudo-random number generator.+--+-- @since 1.2.0+runStateGenST :: RandomGen g => g -> (forall s . StateGenM g -> StateT g (ST s) a) -> (a, g)+runStateGenST g action = runST $ runStateGenT g action+{-# INLINE runStateGenST #-}+++-- | The standard pseudo-random number generator.+newtype StdGen = StdGen { unStdGen :: SM.SMGen }+ deriving (Show, RandomGen, NFData)++instance Eq StdGen where+ StdGen x1 == StdGen x2 = SM.unseedSMGen x1 == SM.unseedSMGen x2++instance RandomGen SM.SMGen where+ next = SM.nextInt+ genWord32 = SM.nextWord32+ genWord64 = SM.nextWord64+ split = SM.splitSMGen++instance RandomGen SM32.SMGen where+ next = SM32.nextInt+ genWord32 = SM32.nextWord32+ genWord64 = SM32.nextWord64+ split = SM32.splitSMGen++-- | Constructs a 'StdGen' deterministically.+mkStdGen :: Int -> StdGen+mkStdGen = StdGen . SM.mkSMGen . fromIntegral++-- | The class of types for which a uniformly distributed value can be drawn+-- from all possible values of the type.+--+-- @since 1.2.0+class Uniform a where+ -- | Generates a value uniformly distributed over all possible values of that+ -- type.+ --+ -- @since 1.2.0+ uniformM :: StatefulGen g m => g -> m a++-- | The class of types for which a uniformly distributed value can be drawn+-- from a range.+--+-- @since 1.2.0+class UniformRange a where+ -- | Generates a value uniformly distributed over the provided range, which+ -- is interpreted as inclusive in the lower and upper bound.+ --+ -- * @uniformRM (1 :: Int, 4 :: Int)@ generates values uniformly from the+ -- set \(\{1,2,3,4\}\)+ --+ -- * @uniformRM (1 :: Float, 4 :: Float)@ generates values uniformly from+ -- the set \(\{x\;|\;1 \le x \le 4\}\)+ --+ -- The following law should hold to make the function always defined:+ --+ -- > uniformRM (a, b) = uniformRM (b, a)+ --+ -- @since 1.2.0+ uniformRM :: StatefulGen g m => (a, a) -> g -> m a++instance UniformRange Integer where+ uniformRM = uniformIntegralM++instance UniformRange Natural where+ uniformRM = uniformIntegralM++instance Uniform Int8 where+ uniformM = fmap (fromIntegral :: Word8 -> Int8) . uniformWord8+instance UniformRange Int8 where+ uniformRM = signedBitmaskWithRejectionRM (fromIntegral :: Int8 -> Word8) fromIntegral++instance Uniform Int16 where+ uniformM = fmap (fromIntegral :: Word16 -> Int16) . uniformWord16+instance UniformRange Int16 where+ uniformRM = signedBitmaskWithRejectionRM (fromIntegral :: Int16 -> Word16) fromIntegral+ {-# INLINE uniformRM #-}++instance Uniform Int32 where+ uniformM = fmap (fromIntegral :: Word32 -> Int32) . uniformWord32+instance UniformRange Int32 where+ uniformRM = signedBitmaskWithRejectionRM (fromIntegral :: Int32 -> Word32) fromIntegral+ {-# INLINE uniformRM #-}++instance Uniform Int64 where+ uniformM = fmap (fromIntegral :: Word64 -> Int64) . uniformWord64+instance UniformRange Int64 where+ uniformRM = signedBitmaskWithRejectionRM (fromIntegral :: Int64 -> Word64) fromIntegral+ {-# INLINE uniformRM #-}++wordSizeInBits :: Int+wordSizeInBits = finiteBitSize (0 :: Word)++instance Uniform Int where+ uniformM+ | wordSizeInBits == 64 =+ fmap (fromIntegral :: Word64 -> Int) . uniformWord64+ | otherwise =+ fmap (fromIntegral :: Word32 -> Int) . uniformWord32++instance UniformRange Int where+ uniformRM = signedBitmaskWithRejectionRM (fromIntegral :: Int -> Word) fromIntegral+ {-# INLINE uniformRM #-}++instance Uniform Word where+ uniformM+ | wordSizeInBits == 64 =+ fmap (fromIntegral :: Word64 -> Word) . uniformWord64+ | otherwise =+ fmap (fromIntegral :: Word32 -> Word) . uniformWord32++instance UniformRange Word where+ {-# INLINE uniformRM #-}+ uniformRM = unsignedBitmaskWithRejectionRM++instance Uniform Word8 where+ {-# INLINE uniformM #-}+ uniformM = uniformWord8+instance UniformRange Word8 where+ {-# INLINE uniformRM #-}+ uniformRM = unbiasedWordMult32RM++instance Uniform Word16 where+ {-# INLINE uniformM #-}+ uniformM = uniformWord16+instance UniformRange Word16 where+ {-# INLINE uniformRM #-}+ uniformRM = unbiasedWordMult32RM++instance Uniform Word32 where+ {-# INLINE uniformM #-}+ uniformM = uniformWord32+instance UniformRange Word32 where+ {-# INLINE uniformRM #-}+ uniformRM = unbiasedWordMult32RM++instance Uniform Word64 where+ {-# INLINE uniformM #-}+ uniformM = uniformWord64+instance UniformRange Word64 where+ {-# INLINE uniformRM #-}+ uniformRM = unsignedBitmaskWithRejectionRM++#if __GLASGOW_HASKELL__ >= 802+instance Uniform CBool where+ uniformM = fmap CBool . uniformM+instance UniformRange CBool where+ uniformRM (CBool b, CBool t) = fmap CBool . uniformRM (b, t)+ {-# INLINE uniformRM #-}+#endif++instance Uniform CChar where+ uniformM = fmap CChar . uniformM+instance UniformRange CChar where+ uniformRM (CChar b, CChar t) = fmap CChar . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CSChar where+ uniformM = fmap CSChar . uniformM+instance UniformRange CSChar where+ uniformRM (CSChar b, CSChar t) = fmap CSChar . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CUChar where+ uniformM = fmap CUChar . uniformM+instance UniformRange CUChar where+ uniformRM (CUChar b, CUChar t) = fmap CUChar . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CShort where+ uniformM = fmap CShort . uniformM+instance UniformRange CShort where+ uniformRM (CShort b, CShort t) = fmap CShort . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CUShort where+ uniformM = fmap CUShort . uniformM+instance UniformRange CUShort where+ uniformRM (CUShort b, CUShort t) = fmap CUShort . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CInt where+ uniformM = fmap CInt . uniformM+instance UniformRange CInt where+ uniformRM (CInt b, CInt t) = fmap CInt . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CUInt where+ uniformM = fmap CUInt . uniformM+instance UniformRange CUInt where+ uniformRM (CUInt b, CUInt t) = fmap CUInt . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CLong where+ uniformM = fmap CLong . uniformM+instance UniformRange CLong where+ uniformRM (CLong b, CLong t) = fmap CLong . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CULong where+ uniformM = fmap CULong . uniformM+instance UniformRange CULong where+ uniformRM (CULong b, CULong t) = fmap CULong . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CPtrdiff where+ uniformM = fmap CPtrdiff . uniformM+instance UniformRange CPtrdiff where+ uniformRM (CPtrdiff b, CPtrdiff t) = fmap CPtrdiff . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CSize where+ uniformM = fmap CSize . uniformM+instance UniformRange CSize where+ uniformRM (CSize b, CSize t) = fmap CSize . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CWchar where+ uniformM = fmap CWchar . uniformM+instance UniformRange CWchar where+ uniformRM (CWchar b, CWchar t) = fmap CWchar . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CSigAtomic where+ uniformM = fmap CSigAtomic . uniformM+instance UniformRange CSigAtomic where+ uniformRM (CSigAtomic b, CSigAtomic t) = fmap CSigAtomic . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CLLong where+ uniformM = fmap CLLong . uniformM+instance UniformRange CLLong where+ uniformRM (CLLong b, CLLong t) = fmap CLLong . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CULLong where+ uniformM = fmap CULLong . uniformM+instance UniformRange CULLong where+ uniformRM (CULLong b, CULLong t) = fmap CULLong . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CIntPtr where+ uniformM = fmap CIntPtr . uniformM+instance UniformRange CIntPtr where+ uniformRM (CIntPtr b, CIntPtr t) = fmap CIntPtr . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CUIntPtr where+ uniformM = fmap CUIntPtr . uniformM+instance UniformRange CUIntPtr where+ uniformRM (CUIntPtr b, CUIntPtr t) = fmap CUIntPtr . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CIntMax where+ uniformM = fmap CIntMax . uniformM+instance UniformRange CIntMax where+ uniformRM (CIntMax b, CIntMax t) = fmap CIntMax . uniformRM (b, t)+ {-# INLINE uniformRM #-}++instance Uniform CUIntMax where+ uniformM = fmap CUIntMax . uniformM+instance UniformRange CUIntMax where+ uniformRM (CUIntMax b, CUIntMax t) = fmap CUIntMax . uniformRM (b, t)+ {-# INLINE uniformRM #-}++-- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats).+instance UniformRange CFloat where+ uniformRM (CFloat l, CFloat h) = fmap CFloat . uniformRM (l, h)+ {-# INLINE uniformRM #-}++-- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats).+instance UniformRange CDouble where+ uniformRM (CDouble l, CDouble h) = fmap CDouble . uniformRM (l, h)+ {-# INLINE uniformRM #-}+++-- The `chr#` and `ord#` are the prim functions that will be called, regardless of which+-- way you gonna do the `Char` conversion, so it is better to call them directly and+-- bypass all the hoops. Also because `intToChar` and `charToInt` are internal functions+-- and are called on valid character ranges it is impossible to generate an invalid+-- `Char`, therefore it is totally fine to omit all the unnecessary checks involved in+-- other paths of conversion.+word32ToChar :: Word32 -> Char+word32ToChar (W32# w#) = C# (chr# (word2Int# w#))+{-# INLINE word32ToChar #-}++charToWord32 :: Char -> Word32+charToWord32 (C# c#) = W32# (int2Word# (ord# c#))+{-# INLINE charToWord32 #-}++instance Uniform Char where+ uniformM g = word32ToChar <$> unbiasedWordMult32 (charToWord32 maxBound) g+ {-# INLINE uniformM #-}+instance UniformRange Char where+ uniformRM (l, h) g =+ word32ToChar <$> unbiasedWordMult32RM (charToWord32 l, charToWord32 h) g+ {-# INLINE uniformRM #-}++instance Uniform Bool where+ uniformM = fmap wordToBool . uniformWord8+ where wordToBool w = (w .&. 1) /= 0+instance UniformRange Bool where+ uniformRM (False, False) _g = return False+ uniformRM (True, True) _g = return True+ uniformRM _ g = uniformM g++-- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats).+instance UniformRange Double where+ uniformRM (l, h) g+ | l == h = return l+ | otherwise = do+ x <- uniformDouble01M g+ return $ x * l + (1 -x) * h++-- | Generates uniformly distributed 'Double' in the range \([0, 1]\).+-- Numbers are generated by generating uniform 'Word64' and dividing+-- it by \(2^{64}\). It's used to implement 'UniformR' instance for+-- 'Double'.+--+-- @since 1.2.0+uniformDouble01M :: StatefulGen g m => g -> m Double+uniformDouble01M g = do+ w64 <- uniformWord64 g+ return $ fromIntegral w64 / m+ where+ m = fromIntegral (maxBound :: Word64) :: Double++-- | Generates uniformly distributed 'Double' in the range+-- \((0, 1]\). Number is generated as \(2^{-64}/2+\operatorname{uniformDouble01M}\).+-- Constant is 1\/2 of smallest nonzero value which could be generated+-- by 'uniformDouble01M'.+--+-- @since 1.2.0+uniformDoublePositive01M :: StatefulGen g m => g -> m Double+uniformDoublePositive01M g = (+ d) <$> uniformDouble01M g+ where+ -- We add small constant to shift generated value from zero. It's+ -- selected as 1/2 of smallest possible nonzero value+ d = 2.710505431213761e-20 -- 2**(-65)++-- | See [Floating point number caveats](System-Random-Stateful.html#fpcaveats).+instance UniformRange Float where+ uniformRM (l, h) g+ | l == h = return l+ | otherwise = do+ x <- uniformFloat01M g+ return $ x * l + (1 - x) * h++-- | Generates uniformly distributed 'Float' in the range \([0, 1]\).+-- Numbers are generated by generating uniform 'Word32' and dividing+-- it by \(2^{32}\). It's used to implement 'UniformR' instance for 'Float'+--+-- @since 1.2.0+uniformFloat01M :: StatefulGen g m => g -> m Float+uniformFloat01M g = do+ w32 <- uniformWord32 g+ return $ fromIntegral w32 / m+ where+ m = fromIntegral (maxBound :: Word32) :: Float++-- | Generates uniformly distributed 'Float' in the range+-- \((0, 1]\). Number is generated as \(2^{-32}/2+\operatorname{uniformFloat01M}\).+-- Constant is 1\/2 of smallest nonzero value which could be generated+-- by 'uniformFloat01M'.+--+-- @since 1.2.0+uniformFloatPositive01M :: StatefulGen g m => g -> m Float+uniformFloatPositive01M g = (+ d) <$> uniformFloat01M g+ where+ -- See uniformDoublePositive01M+ d = 1.1641532182693481e-10 -- 2**(-33)++-- The two integer functions below take an [inclusive,inclusive] range.+randomIvalIntegral :: (RandomGen g, Integral a) => (a, a) -> g -> (a, g)+randomIvalIntegral (l,h) = randomIvalInteger (toInteger l, toInteger h)++{-# SPECIALIZE randomIvalInteger :: (Num a) =>+ (Integer, Integer) -> StdGen -> (a, StdGen) #-}++randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)+randomIvalInteger (l,h) rng+ | l > h = randomIvalInteger (h,l) rng+ | otherwise = case f 1 0 rng of (v, rng') -> (fromInteger (l + v `mod` k), rng')+ where+ (genlo, genhi) = genRange rng+ b = fromIntegral genhi - fromIntegral genlo + 1 :: Integer++ -- Probabilities of the most likely and least likely result+ -- will differ at most by a factor of (1 +- 1/q). Assuming the RandomGen+ -- is uniform, of course++ -- On average, log q / log b more pseudo-random values will be generated+ -- than the minimum+ q = 1000 :: Integer+ k = h - l + 1+ magtgt = k * q++ -- generate pseudo-random values until we exceed the target magnitude+ f mag v g | mag >= magtgt = (v, g)+ | otherwise = v' `seq`f (mag*b) v' g' where+ (x,g') = next g+ v' = v * b + (fromIntegral x - fromIntegral genlo)++-- | Generate an integral in the range @[l, h]@ if @l <= h@ and @[h, l]@+-- otherwise.+uniformIntegralM :: (Bits a, Integral a, StatefulGen g m) => (a, a) -> g -> m a+uniformIntegralM (l, h) gen = case l `compare` h of+ LT -> do+ let limit = h - l+ bounded <- case toIntegralSized limit :: Maybe Word64 of+ Just limitAsWord64 ->+ -- Optimisation: if 'limit' fits into 'Word64', generate a bounded+ -- 'Word64' and then convert to 'Integer'+ fromIntegral <$> unsignedBitmaskWithRejectionM uniformWord64 limitAsWord64 gen+ Nothing -> boundedExclusiveIntegralM (limit + 1) gen+ return $ l + bounded+ GT -> uniformIntegralM (h, l) gen+ EQ -> pure l+{-# INLINEABLE uniformIntegralM #-}++-- | Generate an integral in the range @[0, s)@ using a variant of Lemire's+-- multiplication method.+--+-- Daniel Lemire. 2019. Fast Random Integer Generation in an Interval. In ACM+-- Transactions on Modeling and Computer Simulation+-- https://doi.org/10.1145/3230636+--+-- PRECONDITION (unchecked): s > 0+boundedExclusiveIntegralM :: forall a g m . (Bits a, Integral a, StatefulGen g m) => a -> g -> m a+boundedExclusiveIntegralM s gen = go+ where+ n = integralWordSize s+ -- We renamed 'L' from the paper to 'k' here because 'L' is not a valid+ -- variable name in Haskell and 'l' is already used in the algorithm.+ k = wordSizeInBits * n+ twoToK = (1 :: a) `shiftL` k+ modTwoToKMask = twoToK - 1++ t = (twoToK - s) `rem` s -- `rem`, instead of `mod` because `twoToK >= s` is guaranteed+ go :: (Bits a, Integral a, StatefulGen g m) => m a+ go = do+ x <- uniformIntegralWords n gen+ let m = x * s+ -- m .&. modTwoToKMask == m `mod` twoToK+ let l = m .&. modTwoToKMask+ if l < t+ then go+ -- m `shiftR` k == m `quot` twoToK+ else return $ m `shiftR` k+{-# INLINE boundedExclusiveIntegralM #-}++-- | @integralWordSize i@ returns that least @w@ such that+-- @i <= WORD_SIZE_IN_BITS^w@.+integralWordSize :: (Bits a, Num a) => a -> Int+integralWordSize = go 0+ where+ go !acc i+ | i == 0 = acc+ | otherwise = go (acc + 1) (i `shiftR` wordSizeInBits)+{-# INLINE integralWordSize #-}++-- | @uniformIntegralWords n@ is a uniformly pseudo-random integral in the range+-- @[0, WORD_SIZE_IN_BITS^n)@.+uniformIntegralWords :: (Bits a, Integral a, StatefulGen g m) => Int -> g -> m a+uniformIntegralWords n gen = go 0 n+ where+ go !acc i+ | i == 0 = return acc+ | otherwise = do+ (w :: Word) <- uniformM gen+ go ((acc `shiftL` wordSizeInBits) .|. fromIntegral w) (i - 1)+{-# INLINE uniformIntegralWords #-}++-- | Uniformly generate an 'Integral' in an inclusive-inclusive range.+--+-- Only use for integrals size less than or equal to that of 'Word32'.+unbiasedWordMult32RM :: (StatefulGen g m, Integral a) => (a, a) -> g -> m a+unbiasedWordMult32RM (b, t) g+ | b <= t = (+b) . fromIntegral <$> unbiasedWordMult32 (fromIntegral (t - b)) g+ | otherwise = (+t) . fromIntegral <$> unbiasedWordMult32 (fromIntegral (b - t)) g+{-# SPECIALIZE unbiasedWordMult32RM :: StatefulGen g m => (Word8, Word8) -> g -> m Word8 #-}++-- | Uniformly generate Word32 in @[0, s]@.+unbiasedWordMult32 :: StatefulGen g m => Word32 -> g -> m Word32+unbiasedWordMult32 s g+ | s == maxBound = uniformWord32 g+ | otherwise = unbiasedWordMult32Exclusive (s+1) g+{-# INLINE unbiasedWordMult32 #-}++-- | See [Lemire's paper](https://arxiv.org/pdf/1805.10941.pdf),+-- [O\'Neill's+-- blogpost](https://www.pcg-random.org/posts/bounded-rands.html) and+-- more directly [O\'Neill's github+-- repo](https://github.com/imneme/bounded-rands/blob/3d71f53c975b1e5b29f2f3b05a74e26dab9c3d84/bounded32.cpp#L234).+-- N.B. The range is [0,r) **not** [0,r].+unbiasedWordMult32Exclusive :: forall g m . StatefulGen g m => Word32 -> g -> m Word32+unbiasedWordMult32Exclusive r g = go+ where+ t :: Word32+ t = (-r) `mod` r -- Calculates 2^32 `mod` r!!!+ go :: StatefulGen g m => m Word32+ go = do+ x <- uniformWord32 g+ let m :: Word64+ m = fromIntegral x * fromIntegral r+ l :: Word32+ l = fromIntegral m+ if l >= t then return (fromIntegral $ m `shiftR` 32) else go++-- | This only works for unsigned integrals+unsignedBitmaskWithRejectionRM ::+ (StatefulGen g m, FiniteBits a, Num a, Ord a, Uniform a)+ => (a, a)+ -> g+ -> m a+unsignedBitmaskWithRejectionRM (bottom, top) gen+ | bottom == top = pure top+ | otherwise = (b +) <$> unsignedBitmaskWithRejectionM uniformM r gen+ where+ (b, r) = if bottom > top then (top, bottom - top) else (bottom, top - bottom)+{-# INLINE unsignedBitmaskWithRejectionRM #-}++-- | This works for signed integrals by explicit conversion to unsigned and abusing+-- overflow. It uses `unsignedBitmaskWithRejectionM`, therefore it requires functions that+-- take the value to unsigned and back.+signedBitmaskWithRejectionRM ::+ (Num a, Num b, Ord b, Ord a, FiniteBits a, StatefulGen g f, Uniform a)+ => (b -> a) -- ^ Convert signed to unsigned. @a@ and @b@ must be of the same size.+ -> (a -> b) -- ^ Convert unsigned to signed. @a@ and @b@ must be of the same size.+ -> (b, b) -- ^ Range.+ -> g -- ^ Generator.+ -> f b+signedBitmaskWithRejectionRM toUnsigned fromUnsigned (bottom, top) gen+ | bottom == top = pure top+ | otherwise =+ (b +) . fromUnsigned <$> unsignedBitmaskWithRejectionM uniformM r gen+ -- This works in all cases, see Appendix 1 at the end of the file.+ where+ (b, r) =+ if bottom > top+ then (top, toUnsigned bottom - toUnsigned top)+ else (bottom, toUnsigned top - toUnsigned bottom)+{-# INLINE signedBitmaskWithRejectionRM #-}+++-- | Detailed explanation about the algorithm employed here can be found in this post:+-- http://web.archive.org/web/20200520071940/https://www.pcg-random.org/posts/bounded-rands.html+unsignedBitmaskWithRejectionM ::+ forall a g m . (Ord a, FiniteBits a, Num a, StatefulGen g m) => (g -> m a) -> a -> g -> m a+unsignedBitmaskWithRejectionM genUniformM range gen = go+ where+ mask :: a+ mask = complement zeroBits `shiftR` countLeadingZeros (range .|. 1)+ go = do+ x <- genUniformM gen+ let x' = x .&. mask+ if x' > range+ then go+ else pure x'+{-# INLINE unsignedBitmaskWithRejectionM #-}++-------------------------------------------------------------------------------+-- 'Uniform' instances for tuples+-------------------------------------------------------------------------------++instance (Uniform a, Uniform b) => Uniform (a, b) where+ uniformM g = (,) <$> uniformM g <*> uniformM g++instance (Uniform a, Uniform b, Uniform c) => Uniform (a, b, c) where+ uniformM g = (,,) <$> uniformM g <*> uniformM g <*> uniformM g++instance (Uniform a, Uniform b, Uniform c, Uniform d) => Uniform (a, b, c, d) where+ uniformM g = (,,,) <$> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g++instance (Uniform a, Uniform b, Uniform c, Uniform d, Uniform e) => Uniform (a, b, c, d, e) where+ uniformM g = (,,,,) <$> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g++instance (Uniform a, Uniform b, Uniform c, Uniform d, Uniform e, Uniform f) => Uniform (a, b, c, d, e, f) where+ uniformM g = (,,,,,) <$> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g++instance (Uniform a, Uniform b, Uniform c, Uniform d, Uniform e, Uniform f, Uniform g) => Uniform (a, b, c, d, e, f, g) where+ uniformM g = (,,,,,,) <$> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g <*> uniformM g++-- Appendix 1.+--+-- @top@ and @bottom@ are signed integers of bit width @n@. @toUnsigned@+-- converts a signed integer to an unsigned number of the same bit width @n@.+--+-- range = toUnsigned top - toUnsigned bottom+--+-- This works out correctly thanks to modular arithmetic. Conceptually,+--+-- toUnsigned x | x >= 0 = x+-- toUnsigned x | x < 0 = 2^n + x+--+-- The following combinations are possible:+--+-- 1. @bottom >= 0@ and @top >= 0@+-- 2. @bottom < 0@ and @top >= 0@+-- 3. @bottom < 0@ and @top < 0@+--+-- Note that @bottom >= 0@ and @top < 0@ is impossible because of the+-- invariant @bottom < top@.+--+-- For any signed integer @i@ of width @n@, we have:+--+-- -2^(n-1) <= i <= 2^(n-1) - 1+--+-- Considering each combination in turn, we have+--+-- 1. @bottom >= 0@ and @top >= 0@+--+-- range = (toUnsigned top - toUnsigned bottom) `mod` 2^n+-- --^ top >= 0, so toUnsigned top == top+-- --^ bottom >= 0, so toUnsigned bottom == bottom+-- = (top - bottom) `mod` 2^n+-- --^ top <= 2^(n-1) - 1 and bottom >= 0+-- --^ top - bottom <= 2^(n-1) - 1+-- --^ 0 < top - bottom <= 2^(n-1) - 1+-- = top - bottom+--+-- 2. @bottom < 0@ and @top >= 0@+--+-- range = (toUnsigned top - toUnsigned bottom) `mod` 2^n+-- --^ top >= 0, so toUnsigned top == top+-- --^ bottom < 0, so toUnsigned bottom == 2^n + bottom+-- = (top - (2^n + bottom)) `mod` 2^n+-- --^ summand -2^n cancels out in calculation modulo 2^n+-- = (top - bottom) `mod` 2^n+-- --^ top <= 2^(n-1) - 1 and bottom >= -2^(n-1)+-- --^ top - bottom <= (2^(n-1) - 1) - (-2^(n-1)) = 2^n - 1+-- --^ 0 < top - bottom <= 2^n - 1+-- = top - bottom+--+-- 3. @bottom < 0@ and @top < 0@+--+-- range = (toUnsigned top - toUnsigned bottom) `mod` 2^n+-- --^ top < 0, so toUnsigned top == 2^n + top+-- --^ bottom < 0, so toUnsigned bottom == 2^n + bottom+-- = ((2^n + top) - (2^n + bottom)) `mod` 2^n+-- --^ summand 2^n cancels out in calculation modulo 2^n+-- = (top - bottom) `mod` 2^n+-- --^ top <= -1+-- --^ bottom >= -2^(n-1)+-- --^ top - bottom <= -1 - (-2^(n-1)) = 2^(n-1) - 1+-- --^ 0 < top - bottom <= 2^(n-1) - 1+-- = top - bottom
+ src/System/Random/Stateful.hs view
@@ -0,0 +1,721 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module : System.Random.Stateful+-- Copyright : (c) The University of Glasgow 2001+-- License : BSD-style (see the file LICENSE in the 'random' repository)+-- Maintainer : libraries@haskell.org+-- Stability : stable+--+-- This library deals with the common task of pseudo-random number generation.+module System.Random.Stateful+ (+ -- * Pure Random Generator+ module System.Random+ -- * Monadic Random Generator+ -- $introduction++ -- * Usage+ -- $usagemonadic++ -- * Mutable pseudo-random number generator interfaces+ -- $interfaces+ , StatefulGen(..)+ , FrozenGen(..)+ , RandomGenM(..)+ , withMutableGen+ , withMutableGen_+ , randomM+ , randomRM+ , splitGenM++ -- * Monadic adapters for pure pseudo-random number generators #monadicadapters#+ -- $monadicadapters++ -- ** Pure adapter+ , StateGen(..)+ , StateGenM(..)+ , runStateGen+ , runStateGen_+ , runStateGenT+ , runStateGenT_+ , runStateGenST+ -- ** Mutable adapter with atomic operations+ , AtomicGen(..)+ , AtomicGenM(..)+ , newAtomicGenM+ , applyAtomicGen+ -- ** Mutable adapter in 'IO'+ , IOGen(..)+ , IOGenM(..)+ , newIOGenM+ , applyIOGen+ -- ** Mutable adapter in 'ST'+ , STGen(..)+ , STGenM(..)+ , newSTGenM+ , applySTGen+ , runSTGen+ , runSTGen_++ -- * Pseudo-random values of various types+ -- $uniform+ , Uniform(..)+ , uniformListM+ , UniformRange(..)++ -- * Generators for sequences of pseudo-random bytes+ , genShortByteStringIO+ , genShortByteStringST+ , uniformByteStringM+ , uniformDouble01M+ , uniformDoublePositive01M+ , uniformFloat01M+ , uniformFloatPositive01M++ -- * Appendix++ -- ** How to implement 'StatefulGen'+ -- $implementmonadrandom++ -- ** Floating point number caveats #fpcaveats#+ -- $floating++ -- * References+ -- $references+ ) where++import Control.DeepSeq+import Control.Monad.IO.Class+import Control.Monad.ST+import Control.Monad.State.Strict+import Data.IORef+import Data.STRef+import Foreign.Storable+import System.Random+import System.Random.Internal++-- $introduction+--+-- This module provides type classes and instances for the following concepts:+--+-- [Monadic pseudo-random number generators] 'StatefulGen' is an interface to+-- monadic pseudo-random number generators.+--+-- [Monadic adapters] 'StateGenM', 'AtomicGenM', 'IOGenM' and 'STGenM' turn a+-- 'RandomGen' instance into a 'StatefulGen' instance.+--+-- [Drawing from a range] 'UniformRange' is used to generate a value of a+-- type uniformly within a range.+--+-- This library provides instances of 'UniformRange' for many common+-- numeric types.+--+-- [Drawing from the entire domain of a type] 'Uniform' is used to generate a+-- value of a type uniformly over all possible values of that type.+--+-- This library provides instances of 'Uniform' for many common bounded+-- numeric types.+--+-- $usagemonadic+--+-- In monadic code, use the relevant 'Uniform' and 'UniformRange' instances to+-- generate pseudo-random values via 'uniformM' and 'uniformRM', respectively.+--+-- As an example, @rollsM@ generates @n@ pseudo-random values of @Word@ in the+-- range @[1, 6]@ in a 'StatefulGen' context; given a /monadic/ pseudo-random+-- number generator, you can run this probabilistic computation as follows:+--+-- >>> :{+-- let rollsM :: StatefulGen g m => Int -> g -> m [Word]+-- rollsM n = replicateM n . uniformRM (1, 6)+-- in do+-- monadicGen <- MWC.create+-- rollsM 10 monadicGen :: IO [Word]+-- :}+-- [3,4,3,1,4,6,1,6,1,4]+--+-- Given a /pure/ pseudo-random number generator, you can run the monadic+-- pseudo-random number computation @rollsM@ in an 'IO' or 'ST' context by+-- applying a monadic adapter like 'AtomicGenM', 'IOGenM' or 'STGenM'+-- (see [monadic-adapters](#monadicadapters)) to the pure pseudo-random number+-- generator.+--+-- >>> :{+-- let rollsM :: StatefulGen g m => Int -> g -> m [Word]+-- rollsM n = replicateM n . uniformRM (1, 6)+-- pureGen = mkStdGen 42+-- in+-- newIOGenM pureGen >>= rollsM 10 :: IO [Word]+-- :}+-- [1,1,3,2,4,5,3,4,6,2]++-------------------------------------------------------------------------------+-- Pseudo-random number generator interfaces+-------------------------------------------------------------------------------++-- $interfaces+--+-- Pseudo-random number generators come in two flavours: /pure/ and /monadic/.+--+-- ['System.Random.RandomGen': pure pseudo-random number generators]+-- See "System.Random" module.+--+-- ['StatefulGen': monadic pseudo-random number generators] These generators+-- mutate their own state as they produce pseudo-random values. They+-- generally live in 'ST' or 'IO' or some transformer that implements+-- @PrimMonad@.+--++-------------------------------------------------------------------------------+-- Monadic adapters+-------------------------------------------------------------------------------++-- $monadicadapters+--+-- Pure pseudo-random number generators can be used in monadic code via the+-- adapters 'StateGenM', 'AtomicGenM', 'IOGenM' and 'STGenM'.+--+-- * 'StateGenM' can be used in any state monad. With strict 'StateT' there is+-- no performance overhead compared to using the 'RandomGen' instance+-- directly. 'StateGenM' is /not/ safe to use in the presence of exceptions+-- and concurrency.+--+-- * 'AtomicGenM' is safe in the presence of exceptions and concurrency since+-- it performs all actions atomically.+--+-- * 'IOGenM' is a wrapper around an 'IORef' that holds a pure generator.+-- 'IOGenM' is safe in the presence of exceptions, but not concurrency.+--+-- * 'STGenM' is a wrapper around an 'STRef' that holds a pure generator.+-- 'STGenM' is safe in the presence of exceptions, but not concurrency.++-- | Interface to operations on 'RandomGen' wrappers like 'IOGenM' and 'StateGenM'.+--+-- @since 1.2.0+class (RandomGen r, StatefulGen g m) => RandomGenM g r m | g -> r where+ applyRandomGenM :: (r -> (a, r)) -> g -> m a++-- | Splits a pseudo-random number generator into two. Overwrites the mutable+-- wrapper with one of the resulting generators and returns the other.+--+-- @since 1.2.0+splitGenM :: RandomGenM g r m => g -> m r+splitGenM = applyRandomGenM split++instance (RandomGen r, MonadIO m) => RandomGenM (IOGenM r) r m where+ applyRandomGenM = applyIOGen++instance (RandomGen r, MonadIO m) => RandomGenM (AtomicGenM r) r m where+ applyRandomGenM = applyAtomicGen++instance (RandomGen r, MonadState r m) => RandomGenM (StateGenM r) r m where+ applyRandomGenM f _ = state f++instance RandomGen r => RandomGenM (STGenM r s) r (ST s) where+ applyRandomGenM = applySTGen+++-- | Runs a mutable pseudo-random number generator from its 'Frozen' state.+--+-- ====__Examples__+--+-- >>> import Data.Int (Int8)+-- >>> withMutableGen (IOGen (mkStdGen 217)) (uniformListM 5) :: IO ([Int8], IOGen StdGen)+-- ([-74,37,-50,-2,3],IOGen {unIOGen = StdGen {unStdGen = SMGen 4273268533320920145 15251669095119325999}})+--+-- @since 1.2.0+withMutableGen :: FrozenGen f m => f -> (MutableGen f m -> m a) -> m (a, f)+withMutableGen fg action = do+ g <- thawGen fg+ res <- action g+ fg' <- freezeGen g+ pure (res, fg')++-- | Same as 'withMutableGen', but only returns the generated value.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> withMutableGen_ (IOGen pureGen) (uniformRM (1 :: Int, 6 :: Int))+-- 4+--+-- @since 1.2.0+withMutableGen_ :: FrozenGen f m => f -> (MutableGen f m -> m a) -> m a+withMutableGen_ fg action = fst <$> withMutableGen fg action+++-- | Generates a list of pseudo-random values.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> g <- newIOGenM pureGen+-- >>> uniformListM 10 g :: IO [Bool]+-- [True,True,True,True,False,True,True,False,False,False]+--+-- @since 1.2.0+uniformListM :: (StatefulGen g m, Uniform a) => Int -> g -> m [a]+uniformListM n gen = replicateM n (uniformM gen)++-- | Generates a pseudo-random value using monadic interface and `Random` instance.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> g <- newIOGenM pureGen+-- >>> randomM g :: IO Double+-- 0.5728354935654512+--+-- @since 1.2.0+randomM :: (RandomGenM g r m, Random a) => g -> m a+randomM = applyRandomGenM random++-- | Generates a pseudo-random value using monadic interface and `Random` instance.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> g <- newIOGenM pureGen+-- >>> randomRM (1, 100) g :: IO Int+-- 52+--+-- @since 1.2.0+randomRM :: (RandomGenM g r m, Random a) => (a, a) -> g -> m a+randomRM r = applyRandomGenM (randomR r)++-- | Wraps an 'IORef' that holds a pure pseudo-random number generator. All+-- operations are performed atomically.+--+-- * 'AtomicGenM' is safe in the presence of exceptions and concurrency.+-- * 'AtomicGenM' is the slowest of the monadic adapters due to the overhead+-- of its atomic operations.+--+-- @since 1.2.0+newtype AtomicGenM g = AtomicGenM { unAtomicGenM :: IORef g}+++-- | Frozen version of mutable `AtomicGenM` generator+--+-- @since 1.2.0+newtype AtomicGen g = AtomicGen { unAtomicGen :: g}+ deriving (Eq, Ord, Show, RandomGen, Storable, NFData)++-- | Creates a new 'AtomicGenM'.+--+-- @since 1.2.0+newAtomicGenM :: MonadIO m => g -> m (AtomicGenM g)+newAtomicGenM = fmap AtomicGenM . liftIO . newIORef++instance (RandomGen g, MonadIO m) => StatefulGen (AtomicGenM g) m where+ uniformWord32R r = applyAtomicGen (genWord32R r)+ {-# INLINE uniformWord32R #-}+ uniformWord64R r = applyAtomicGen (genWord64R r)+ {-# INLINE uniformWord64R #-}+ uniformWord8 = applyAtomicGen genWord8+ {-# INLINE uniformWord8 #-}+ uniformWord16 = applyAtomicGen genWord16+ {-# INLINE uniformWord16 #-}+ uniformWord32 = applyAtomicGen genWord32+ {-# INLINE uniformWord32 #-}+ uniformWord64 = applyAtomicGen genWord64+ {-# INLINE uniformWord64 #-}+ uniformShortByteString n = applyAtomicGen (genShortByteString n)+++instance (RandomGen g, MonadIO m) => FrozenGen (AtomicGen g) m where+ type MutableGen (AtomicGen g) m = AtomicGenM g+ freezeGen = fmap AtomicGen . liftIO . readIORef . unAtomicGenM+ thawGen (AtomicGen g) = newAtomicGenM g++-- | Atomically applies a pure operation to the wrapped pseudo-random number+-- generator.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> g <- newAtomicGenM pureGen+-- >>> applyAtomicGen random g :: IO Int+-- 7879794327570578227+--+-- @since 1.2.0+applyAtomicGen :: MonadIO m => (g -> (a, g)) -> (AtomicGenM g) -> m a+applyAtomicGen op (AtomicGenM gVar) =+ liftIO $ atomicModifyIORef' gVar $ \g ->+ case op g of+ (a, g') -> (g', a)+{-# INLINE applyAtomicGen #-}++-- | Wraps an 'IORef' that holds a pure pseudo-random number generator.+--+-- * 'IOGenM' is safe in the presence of exceptions, but not concurrency.+-- * 'IOGenM' is slower than 'StateGenM' due to the extra pointer indirection.+-- * 'IOGenM' is faster than 'AtomicGenM' since the 'IORef' operations used by+-- 'IOGenM' are not atomic.+--+-- An example use case is writing pseudo-random bytes into a file:+--+-- >>> import UnliftIO.Temporary (withSystemTempFile)+-- >>> import Data.ByteString (hPutStr)+-- >>> let ioGen g = withSystemTempFile "foo.bin" $ \_ h -> uniformRM (0, 100) g >>= flip uniformByteStringM g >>= hPutStr h+--+-- and then run it:+--+-- >>> newIOGenM (mkStdGen 1729) >>= ioGen+--+-- @since 1.2.0+newtype IOGenM g = IOGenM { unIOGenM :: IORef g }++-- | Frozen version of mutable `IOGenM` generator+--+-- @since 1.2.0+newtype IOGen g = IOGen { unIOGen :: g }+ deriving (Eq, Ord, Show, RandomGen, Storable, NFData)+++-- | Creates a new 'IOGenM'.+--+-- @since 1.2.0+newIOGenM :: MonadIO m => g -> m (IOGenM g)+newIOGenM = fmap IOGenM . liftIO . newIORef++instance (RandomGen g, MonadIO m) => StatefulGen (IOGenM g) m where+ uniformWord32R r = applyIOGen (genWord32R r)+ {-# INLINE uniformWord32R #-}+ uniformWord64R r = applyIOGen (genWord64R r)+ {-# INLINE uniformWord64R #-}+ uniformWord8 = applyIOGen genWord8+ {-# INLINE uniformWord8 #-}+ uniformWord16 = applyIOGen genWord16+ {-# INLINE uniformWord16 #-}+ uniformWord32 = applyIOGen genWord32+ {-# INLINE uniformWord32 #-}+ uniformWord64 = applyIOGen genWord64+ {-# INLINE uniformWord64 #-}+ uniformShortByteString n = applyIOGen (genShortByteString n)+++instance (RandomGen g, MonadIO m) => FrozenGen (IOGen g) m where+ type MutableGen (IOGen g) m = IOGenM g+ freezeGen = fmap IOGen . liftIO . readIORef . unIOGenM+ thawGen (IOGen g) = newIOGenM g+++-- | Applies a pure operation to the wrapped pseudo-random number generator.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> g <- newIOGenM pureGen+-- >>> applyIOGen random g :: IO Int+-- 7879794327570578227+--+-- @since 1.2.0+applyIOGen :: MonadIO m => (g -> (a, g)) -> IOGenM g -> m a+applyIOGen f (IOGenM ref) = liftIO $ do+ g <- readIORef ref+ case f g of+ (!a, !g') -> a <$ writeIORef ref g'+{-# INLINE applyIOGen #-}++-- | Wraps an 'STRef' that holds a pure pseudo-random number generator.+--+-- * 'STGenM' is safe in the presence of exceptions, but not concurrency.+-- * 'STGenM' is slower than 'StateGenM' due to the extra pointer indirection.+--+-- @since 1.2.0+newtype STGenM g s = STGenM { unSTGenM :: STRef s g }++-- | Frozen version of mutable `STGenM` generator+--+-- @since 1.2.0+newtype STGen g = STGen { unSTGen :: g }+ deriving (Eq, Ord, Show, RandomGen, Storable, NFData)++-- | Creates a new 'STGenM'.+--+-- @since 1.2.0+newSTGenM :: g -> ST s (STGenM g s)+newSTGenM = fmap STGenM . newSTRef+++instance RandomGen g => StatefulGen (STGenM g s) (ST s) where+ uniformWord32R r = applySTGen (genWord32R r)+ {-# INLINE uniformWord32R #-}+ uniformWord64R r = applySTGen (genWord64R r)+ {-# INLINE uniformWord64R #-}+ uniformWord8 = applySTGen genWord8+ {-# INLINE uniformWord8 #-}+ uniformWord16 = applySTGen genWord16+ {-# INLINE uniformWord16 #-}+ uniformWord32 = applySTGen genWord32+ {-# INLINE uniformWord32 #-}+ uniformWord64 = applySTGen genWord64+ {-# INLINE uniformWord64 #-}+ uniformShortByteString n = applySTGen (genShortByteString n)++instance RandomGen g => FrozenGen (STGen g) (ST s) where+ type MutableGen (STGen g) (ST s) = STGenM g s+ freezeGen = fmap STGen . readSTRef . unSTGenM+ thawGen (STGen g) = newSTGenM g+++-- | Applies a pure operation to the wrapped pseudo-random number generator.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> (runSTGen pureGen (\g -> applySTGen random g)) :: (Int, StdGen)+-- (7879794327570578227,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627})+--+-- @since 1.2.0+applySTGen :: (g -> (a, g)) -> STGenM g s -> ST s a+applySTGen f (STGenM ref) = do+ g <- readSTRef ref+ case f g of+ (!a, !g') -> a <$ writeSTRef ref g'+{-# INLINE applySTGen #-}++-- | Runs a monadic generating action in the `ST` monad using a pure+-- pseudo-random number generator.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> (runSTGen pureGen (\g -> applySTGen random g)) :: (Int, StdGen)+-- (7879794327570578227,StdGen {unStdGen = SMGen 11285859549637045894 7641485672361121627})+--+-- @since 1.2.0+runSTGen :: RandomGen g => g -> (forall s . STGenM g s -> ST s a) -> (a, g)+runSTGen g action = unSTGen <$> runST (withMutableGen (STGen g) action)++-- | Runs a monadic generating action in the `ST` monad using a pure+-- pseudo-random number generator. Returns only the resulting pseudo-random+-- value.+--+-- ====__Examples__+--+-- >>> import System.Random.Stateful+-- >>> let pureGen = mkStdGen 137+-- >>> (runSTGen_ pureGen (\g -> applySTGen random g)) :: Int+-- 7879794327570578227+--+-- @since 1.2.0+runSTGen_ :: RandomGen g => g -> (forall s . STGenM g s -> ST s a) -> a+runSTGen_ g action = fst $ runSTGen g action+++-- $uniform+--+-- This library provides two type classes to generate pseudo-random values:+--+-- * 'UniformRange' is used to generate a value of a type uniformly within a+-- range.+-- * 'Uniform' is used to generate a value of a type uniformly over all+-- possible values of that type.+--+-- Types may have instances for both or just one of 'UniformRange' and+-- 'Uniform'. A few examples illustrate this:+--+-- * 'Int', 'Word16' and 'Bool' are instances of both 'UniformRange' and+-- 'Uniform'.+-- * 'Integer', 'Float' and 'Double' each have an instance for 'UniformRange'+-- but no 'Uniform' instance.+-- * A hypothetical type @Radian@ representing angles by taking values in the+-- range @[0, 2π)@ has a trivial 'Uniform' instance, but no 'UniformRange'+-- instance: the problem is that two given @Radian@ values always span /two/+-- ranges, one clockwise and one anti-clockwise.+-- * It is trivial to construct a @Uniform (a, b)@ instance given+-- @Uniform a@ and @Uniform b@ (and this library provides this tuple+-- instance).+-- * On the other hand, there is no correct way to construct a+-- @UniformRange (a, b)@ instance based on just @UniformRange a@ and+-- @UniformRange b@.++-------------------------------------------------------------------------------+-- Notes+-------------------------------------------------------------------------------++-- $floating+--+-- The 'UniformRange' instances for 'Float' and 'Double' use the following+-- procedure to generate a random value in a range for @uniformRM (a, b) g@:+--+-- If \(a = b\), return \(a\). Otherwise:+--+-- 1. Generate \(x\) uniformly such that \(0 \leq x \leq 1\).+--+-- The method by which \(x\) is sampled does not cover all representable+-- floating point numbers in the unit interval. The method never generates+-- denormal floating point numbers, for example.+--+-- 2. Return \(x \cdot a + (1 - x) \cdot b\).+--+-- Due to rounding errors, floating point operations are neither+-- associative nor distributive the way the corresponding operations on+-- real numbers are. Additionally, floating point numbers admit special+-- values @NaN@ as well as negative and positive infinity.+--+-- For pathological values, step 2 can yield surprising results.+--+-- * The result may be greater than @max a b@.+--+-- >>> :{+-- let (a, b, x) = (-2.13238e-29, -2.1323799e-29, 0.27736077)+-- result = x * a + (1 - x) * b :: Float+-- in (result, result > max a b)+-- :}+-- (-2.1323797e-29,True)+--+-- * The result may be smaller than @min a b@.+--+-- >>> :{+-- let (a, b, x) = (-1.9087862, -1.908786, 0.4228573)+-- result = x * a + (1 - x) * b :: Float+-- in (result, result < min a b)+-- :}+-- (-1.9087863,True)+--+-- What happens when @NaN@ or @Infinity@ are given to 'uniformRM'? We first+-- define them as constants:+--+-- >>> nan = read "NaN" :: Float+-- >>> inf = read "Infinity" :: Float+--+-- * If at least one of \(a\) or \(b\) is @NaN@, the result is @NaN@.+--+-- >>> let (a, b, x) = (nan, 1, 0.5) in x * a + (1 - x) * b+-- NaN+-- >>> let (a, b, x) = (-1, nan, 0.5) in x * a + (1 - x) * b+-- NaN+--+-- * If \(a\) is @-Infinity@ and \(b\) is @Infinity@, the result is @NaN@.+-- >>> let (a, b, x) = (-inf, inf, 0.5) in x * a + (1 - x) * b+-- NaN+--+-- * Otherwise, if \(a\) is @Infinity@ or @-Infinity@, the result is \(a\).+--+-- >>> let (a, b, x) = (inf, 1, 0.5) in x * a + (1 - x) * b+-- Infinity+-- >>> let (a, b, x) = (-inf, 1, 0.5) in x * a + (1 - x) * b+-- -Infinity+--+-- * Otherwise, if \(b\) is @Infinity@ or @-Infinity@, the result is \(b\).+--+-- >>> let (a, b, x) = (1, inf, 0.5) in x * a + (1 - x) * b+-- Infinity+-- >>> let (a, b, x) = (1, -inf, 0.5) in x * a + (1 - x) * b+-- -Infinity+--+-- Note that the [GCC 10.1.0 C++ standard library](https://gcc.gnu.org/git/?p=gcc.git;a=blob;f=libstdc%2B%2B-v3/include/bits/random.h;h=19307fbc3ca401976ef6823e8fda893e4a263751;hb=63fa67847628e5f358e7e2e7edb8314f0ee31f30#l1859),+-- the [Java 10 standard library](https://docs.oracle.com/javase/10/docs/api/java/util/Random.html#doubles%28double,double%29)+-- and [CPython 3.8](https://github.com/python/cpython/blob/3.8/Lib/random.py#L417)+-- use the same procedure to generate floating point values in a range.+--+-- $implementmonadrandom+--+-- Typically, a monadic pseudo-random number generator has facilities to save+-- and restore its internal state in addition to generating pseudo-random numbers.+--+-- Here is an example instance for the monadic pseudo-random number generator+-- from the @mwc-random@ package:+--+-- > instance (s ~ PrimState m, PrimMonad m) => StatefulGen (MWC.Gen s) m where+-- > uniformWord8 = MWC.uniform+-- > uniformWord16 = MWC.uniform+-- > uniformWord32 = MWC.uniform+-- > uniformWord64 = MWC.uniform+-- > uniformShortByteString n g = unsafeSTToPrim (genShortByteStringST n (MWC.uniform g))+--+-- > instance PrimMonad m => FrozenGen MWC.Seed m where+-- > type MutableGen MWC.Seed m = MWC.Gen (PrimState m)+-- > thawGen = MWC.restore+-- > freezeGen = MWC.save+--+-- === @FrozenGen@+--+-- `FrozenGen` gives us ability to use any stateful pseudo-random number generator in its+-- immutable form, if one exists that is. This concept is commonly known as a seed, which+-- allows us to save and restore the actual mutable state of a pseudo-random number+-- generator. The biggest benefit that can be drawn from a polymorphic access to a+-- stateful pseudo-random number generator in a frozen form is the ability to serialize,+-- deserialize and possibly even use the stateful generator in a pure setting without+-- knowing the actual type of a generator ahead of time. For example we can write a+-- function that accepts a frozen state of some pseudo-random number generator and+-- produces a short list with random even integers.+--+-- >>> import Data.Int (Int8)+-- >>> :{+-- myCustomRandomList :: FrozenGen f m => f -> m [Int8]+-- myCustomRandomList f =+-- withMutableGen_ f $ \gen -> do+-- len <- uniformRM (5, 10) gen+-- replicateM len $ do+-- x <- uniformM gen+-- pure $ if even x then x else x + 1+-- :}+--+-- and later we can apply it to a frozen version of a stateful generator, such as `STGen`:+--+-- >>> print $ runST $ myCustomRandomList (STGen (mkStdGen 217))+-- [-50,-2,4,-8,-58,-40,24,-32,-110,24]+--+-- or a @Seed@ from @mwc-random@:+--+-- >>> import Data.Vector.Primitive as P+-- >>> print $ runST $ myCustomRandomList (MWC.toSeed (P.fromList [1,2,3]))+-- [24,40,10,40,-8,48,-78,70,-12]+--+-- Alternatively, instead of discarding the final state of the generator, as it happens+-- above, we could have used `withMutableGen`, which together with the result would give+-- us back its frozen form. This would allow us to store the end state of our generator+-- somewhere for the later reuse.+--+--+-- $references+--+-- 1. 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:+-- <https://doi.org/10.1145/2660193.2660195>++-- $setup+-- >>> import Control.Monad.Primitive+-- >>> import qualified System.Random.MWC as MWC+--+-- >>> :set -XFlexibleContexts+-- >>> :set -XFlexibleInstances+-- >>> :set -XMultiParamTypeClasses+-- >>> :set -XTypeFamilies+-- >>> :set -XUndecidableInstances+--+-- >>> :{+-- instance (s ~ PrimState m, PrimMonad m) => StatefulGen (MWC.Gen s) m where+-- uniformWord8 = MWC.uniform+-- uniformWord16 = MWC.uniform+-- uniformWord32 = MWC.uniform+-- uniformWord64 = MWC.uniform+-- uniformShortByteString n g = unsafeSTToPrim (genShortByteStringST n (MWC.uniform g))+-- instance PrimMonad m => FrozenGen MWC.Seed m where+-- type MutableGen MWC.Seed m = MWC.Gen (PrimState m)+-- thawGen = MWC.restore+-- freezeGen = MWC.save+-- :}+--
+ test-legacy/Legacy.hs view
@@ -0,0 +1,15 @@+module Main (main) where++import qualified Random1283 as Random1283+import qualified RangeTest as RangeTest+import qualified T7936 as T7936+import qualified TestRandomIOs as TestRandomIOs+import qualified TestRandomRs as TestRandomRs++main :: IO ()+main = do+ Random1283.main+ RangeTest.main+ T7936.main+ TestRandomIOs.main+ TestRandomRs.main
+ test-legacy/Random1283.hs view
@@ -0,0 +1,48 @@+module Random1283 (main) where++import Control.Concurrent+import Control.Monad+import Data.Sequence (Seq, ViewL(..), empty, fromList, viewl, (<|), (|>), (><))+import System.Random++-- This test++threads, samples :: Int+threads = 4+samples = 5000++main :: IO ()+main = loopTest threads samples++loopTest :: Int -> Int -> IO ()+loopTest t s = do+ isClean <- testRace t s+ unless isClean $ putStrLn "race condition!"++testRace :: Int -> Int -> IO Bool+testRace t s = do+ ref <- liftM (take (t*s) . randoms) getStdGen+ iss <- threadRandoms t s+ return (isInterleavingOf (ref::[Int]) iss)++threadRandoms :: Random a => Int -> Int -> IO [[a]]+threadRandoms t s = do+ vs <- sequence $ replicate t $ do+ v <- newEmptyMVar+ _ <- forkIO (sequence (replicate s randomIO) >>= putMVar v)+ return v+ mapM takeMVar vs++isInterleavingOf :: Eq a => [a] -> [[a]] -> Bool+isInterleavingOf xs' yss' = iio xs' (viewl $ fromList yss') EmptyL where+ iio (x:xs) ((y:ys) :< yss) zss+ | x /= y = iio (x:xs) (viewl yss) (viewl (fromViewL zss |> (y:ys)))+ | x == y = iio xs (viewl ((ys <| yss) >< fromViewL zss)) EmptyL+ iio xs ([] :< yss) zss = iio xs (viewl yss) zss+ iio [] EmptyL EmptyL = True+ iio _ _ _ = False++fromViewL :: ViewL a -> Seq a+fromViewL EmptyL = empty+fromViewL (x :< xs) = x <| xs+
+ test-legacy/RangeTest.hs view
@@ -0,0 +1,138 @@+module RangeTest (main) where++import Control.Monad+import System.Random+import Data.Int+import Data.Word+import Foreign.C.Types++-- Take many measurements and record the max/min/average random values.+approxBounds ::+ (RandomGen g, Random a, Ord a, Num a) =>+ (g -> (a,g)) -> Int -> a -> (a,a) -> g -> ((a,a,a),g)+-- Here we do a little hack to essentiall pass in the type in the last argument:+approxBounds nxt iters unused (explo,exphi) initrng =+ if False+ then ((unused,unused,unused),undefined)+-- else loop initrng iters 100 (-100) 0 -- Oops, can't use minBound/maxBound here.+ else loop initrng iters exphi explo 0+ where+ loop rng 0 mn mx sum' = ((mn,mx,sum'),rng)+ loop rng n mn mx sum' =+ case nxt rng of+ (x, rng') -> loop rng' (n-1) (min x mn) (max x mx) (x+sum')+++-- We check that:+-- (1) all generated numbers are in bounds+-- (2) we get "close" to the bounds+-- The with (2) is that we do enough trials to ensure that we can at+-- least hit the 90% mark.+checkBounds ::+ (Real a, Show a, Ord a) =>+ String -> (Bool, a, a) -> ((a,a) -> StdGen -> ((a, a, t), StdGen)) -> IO ()+checkBounds msg (exclusive,lo,hi) fun = do+ -- (lo,hi) is [inclusive,exclusive)+ putStr $ msg ++ ": "+ (mn,mx,_) <- getStdRandom (fun (lo,hi))+ when (mn < lo) $ error $ "broke lower bound: " ++ show mn+ when (mx > hi) $ error $ "broke upper bound: " ++ show mx+ when (exclusive && mx >= hi)$ error$ "hit upper bound: " ++ show mx++ let epsilon = 0.1 * (toRational hi - toRational lo)++ when (toRational (hi - mx) > epsilon) $ error $ "didn't get close enough to upper bound: "++ show mx+ when (toRational (mn - lo) > epsilon) $ error $ "didn't get close enough to lower bound: "++ show mn+ putStrLn "Passed"++boundedRange :: (Num a, Bounded a) => (Bool, a, a)+boundedRange = ( False, minBound, maxBound )++trials :: Int+trials = 5000++-- Keep in mind here that on some architectures (e.g. ARM) CChar, CWchar, and CSigAtomic+-- are unsigned+main :: IO ()+main =+ do+ checkBounds "Int" boundedRange (approxBounds random trials (undefined::Int))+ checkBounds "Integer" (False, fromIntegral (minBound::Int), fromIntegral (maxBound::Int))+ (approxBounds random trials (undefined::Integer))+ checkBounds "Int8" boundedRange (approxBounds random trials (undefined::Int8))+ checkBounds "Int16" boundedRange (approxBounds random trials (undefined::Int16))+ checkBounds "Int32" boundedRange (approxBounds random trials (undefined::Int32))+ checkBounds "Int64" boundedRange (approxBounds random trials (undefined::Int64))+ checkBounds "Word" boundedRange (approxBounds random trials (undefined::Word))+ checkBounds "Word8" boundedRange (approxBounds random trials (undefined::Word8))+ checkBounds "Word16" boundedRange (approxBounds random trials (undefined::Word16))+ checkBounds "Word32" boundedRange (approxBounds random trials (undefined::Word32))+ checkBounds "Word64" boundedRange (approxBounds random trials (undefined::Word64))+ checkBounds "Double" (False,0.0,1.0) (approxBounds random trials (undefined::Double))+ checkBounds "Float" (False,0.0,1.0) (approxBounds random trials (undefined::Float))++ checkBounds "CChar" boundedRange (approxBounds random trials (undefined:: CChar))+ checkBounds "CSChar" boundedRange (approxBounds random trials (undefined:: CSChar))+ checkBounds "CUChar" boundedRange (approxBounds random trials (undefined:: CUChar))+ checkBounds "CShort" boundedRange (approxBounds random trials (undefined:: CShort))+ checkBounds "CUShort" boundedRange (approxBounds random trials (undefined:: CUShort))+ checkBounds "CInt" boundedRange (approxBounds random trials (undefined:: CInt))+ checkBounds "CUInt" boundedRange (approxBounds random trials (undefined:: CUInt))+ checkBounds "CLong" boundedRange (approxBounds random trials (undefined:: CLong))+ checkBounds "CULong" boundedRange (approxBounds random trials (undefined:: CULong))+ checkBounds "CPtrdiff" boundedRange (approxBounds random trials (undefined:: CPtrdiff))+ checkBounds "CSize" boundedRange (approxBounds random trials (undefined:: CSize))+ checkBounds "CWchar" boundedRange (approxBounds random trials (undefined:: CWchar))+ checkBounds "CSigAtomic" boundedRange (approxBounds random trials (undefined:: CSigAtomic))+ checkBounds "CLLong" boundedRange (approxBounds random trials (undefined:: CLLong))+ checkBounds "CULLong" boundedRange (approxBounds random trials (undefined:: CULLong))+ checkBounds "CIntPtr" boundedRange (approxBounds random trials (undefined:: CIntPtr))+ checkBounds "CUIntPtr" boundedRange (approxBounds random trials (undefined:: CUIntPtr))+ checkBounds "CIntMax" boundedRange (approxBounds random trials (undefined:: CIntMax))+ checkBounds "CUIntMax" boundedRange (approxBounds random trials (undefined:: CUIntMax))++ -- Then check all the range-restricted versions:+ checkBounds "Int R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined::Int))+ checkBounds "Integer R"+ (False,-100000000000000000000,100000000000000000000)+ (approxBounds (randomR (-100000000000000000000,100000000000000000000)) trials (undefined::Integer))+ checkBounds "Int8 R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined::Int8))+ checkBounds "Int8 Rsmall" (False,-50,50) (approxBounds (randomR (-50,50)) trials (undefined::Int8))+ checkBounds "Int8 Rmini" (False,3,4) (approxBounds (randomR (3,4)) trials (undefined::Int8))+ checkBounds "Int8 Rtrivial" (False,3,3) (approxBounds (randomR (3,3)) trials (undefined::Int8))++ checkBounds "Int16 R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined::Int16))+ checkBounds "Int32 R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined::Int32))+ checkBounds "Int64 R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined::Int64))+ checkBounds "Word R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined::Word))+ checkBounds "Word8 R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined::Word8))+ checkBounds "Word16 R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined::Word16))+ checkBounds "Word32 R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined::Word32))+ checkBounds "Word64 R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined::Word64))+ checkBounds "Double R" (False,10.0,77.0) (approxBounds (randomR (10,77)) trials (undefined::Double))+ checkBounds "Float R" (False,10.0,77.0) (approxBounds (randomR (10,77)) trials (undefined::Float))++ checkBounds "CChar R" (False,0,100) (approxBounds (randomR (0,100)) trials (undefined:: CChar))+ checkBounds "CSChar R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CSChar))+ checkBounds "CUChar R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CUChar))+ checkBounds "CShort R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CShort))+ checkBounds "CUShort R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CUShort))+ checkBounds "CInt R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CInt))+ checkBounds "CUInt R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CUInt))+ checkBounds "CLong R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CLong))+ checkBounds "CULong R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CULong))+ checkBounds "CPtrdiff R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CPtrdiff))+ checkBounds "CSize R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CSize))+ checkBounds "CWchar R" (False,0,100) (approxBounds (randomR (0,100)) trials (undefined:: CWchar))+ checkBounds "CSigAtomic R" (False,0,100) (approxBounds (randomR (0,100)) trials (undefined:: CSigAtomic))+ checkBounds "CLLong R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CLLong))+ checkBounds "CULLong R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CULLong))+ checkBounds "CIntPtr R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CIntPtr))+ checkBounds "CUIntPtr R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CUIntPtr))+ checkBounds "CIntMax R" (False,-100,100) (approxBounds (randomR (-100,100)) trials (undefined:: CIntMax))+ checkBounds "CUIntMax R" (False,0,200) (approxBounds (randomR (0,200)) trials (undefined:: CUIntMax))++-- Untested:+-- instance Random Char where+-- instance Random Bool where+-- instance Random Integer where
+ test-legacy/T7936.hs view
@@ -0,0 +1,15 @@+-- Test for ticket #7936:+-- https://ghc.haskell.org/trac/ghc/ticket/7936+--+-- Used to fail with:+--+-- $ cabal test T7936 --test-options="+RTS -M1M -RTS"+-- T7936: Heap exhausted;++module T7936 where++import System.Random (newStdGen)+import Control.Monad (replicateM_)++main :: IO ()+main = replicateM_ 100000 newStdGen
+ test-legacy/TestRandomIOs.hs view
@@ -0,0 +1,21 @@+-- Test for ticket #4218 (TestRandomIOs):+-- https://ghc.haskell.org/trac/ghc/ticket/4218+--+-- Used to fail with:+--+-- $ cabal test TestRandomIOs --test-options="+RTS -M1M -RTS"+-- TestRandomIOs: Heap exhausted;++module TestRandomIOs where++import Control.Monad (replicateM)+import System.Random (randomIO)++-- Build a list of 5000 random ints in memory (IO Monad is strict), and print+-- the last one.+-- Should use less than 1Mb of heap space, or we are generating a list of+-- unevaluated thunks.+main :: IO ()+main = do+ rs <- replicateM 5000 randomIO :: IO [Int]+ print $ last rs
+ test-legacy/TestRandomRs.hs view
@@ -0,0 +1,23 @@+-- Test for ticket #4218 (TestRandomRs):+-- https://ghc.haskell.org/trac/ghc/ticket/4218+--+-- Fixed together with ticket #8704+-- https://ghc.haskell.org/trac/ghc/ticket/8704+-- Commit 4695ffa366f659940369f05e419a4f2249c3a776+--+-- Used to fail with:+--+-- $ cabal test TestRandomRs --test-options="+RTS -M1M -RTS"+-- TestRandomRs: Heap exhausted;++module TestRandomRs where++import Control.Monad (liftM)+import System.Random (randomRs, getStdGen)++-- Return the five-thousandth random number:+-- Should run in constant space (< 1Mb heap).+main :: IO ()+main = do+ n <- (last . take 5000 . randomRs (0, 1000000)) `liftM` getStdGen+ print (n::Integer)
+ test/Spec.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main (main) where++import Data.ByteString.Short as SBS+import Data.Int+import Data.Typeable+import Data.Word+import Foreign.C.Types+import Numeric.Natural (Natural)+import System.Random+import Test.SmallCheck.Series as SC+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.SmallCheck as SC++import qualified Spec.Range as Range+import qualified Spec.Run as Run++main :: IO ()+main =+ defaultMain $+ testGroup+ "Spec"+ [ floatingSpec (Proxy :: Proxy Double)+ , floatingSpec (Proxy :: Proxy Float)+ , floatingSpec (Proxy :: Proxy CDouble)+ , floatingSpec (Proxy :: Proxy CFloat)+ , integralSpec (Proxy :: Proxy Word8)+ , integralSpec (Proxy :: Proxy Word16)+ , integralSpec (Proxy :: Proxy Word32)+ , integralSpec (Proxy :: Proxy Word64)+ , integralSpec (Proxy :: Proxy Word)+ , integralSpec (Proxy :: Proxy Int8)+ , integralSpec (Proxy :: Proxy Int16)+ , integralSpec (Proxy :: Proxy Int32)+ , integralSpec (Proxy :: Proxy Int64)+ , integralSpec (Proxy :: Proxy Int)+ , integralSpec (Proxy :: Proxy Char)+ , integralSpec (Proxy :: Proxy Bool)+#if __GLASGOW_HASKELL >= 802+ , integralSpec (Proxy :: Proxy CBool)+#endif+ , integralSpec (Proxy :: Proxy CChar)+ , integralSpec (Proxy :: Proxy CSChar)+ , integralSpec (Proxy :: Proxy CUChar)+ , integralSpec (Proxy :: Proxy CShort)+ , integralSpec (Proxy :: Proxy CUShort)+ , integralSpec (Proxy :: Proxy CInt)+ , integralSpec (Proxy :: Proxy CUInt)+ , integralSpec (Proxy :: Proxy CLong)+ , integralSpec (Proxy :: Proxy CULong)+ , integralSpec (Proxy :: Proxy CPtrdiff)+ , integralSpec (Proxy :: Proxy CSize)+ , integralSpec (Proxy :: Proxy CWchar)+ , integralSpec (Proxy :: Proxy CSigAtomic)+ , integralSpec (Proxy :: Proxy CLLong)+ , integralSpec (Proxy :: Proxy CULLong)+ , integralSpec (Proxy :: Proxy CIntPtr)+ , integralSpec (Proxy :: Proxy CUIntPtr)+ , integralSpec (Proxy :: Proxy CIntMax)+ , integralSpec (Proxy :: Proxy CUIntMax)+ , integralSpec (Proxy :: Proxy Integer)+ , integralSpec (Proxy :: Proxy Natural)+ , runSpec+ , floatTests+ , byteStringSpec+ , SC.testProperty "uniformRangeWithinExcludedF" $ seeded Range.uniformRangeWithinExcludedF+ , SC.testProperty "uniformRangeWithinExcludedD" $ seeded Range.uniformRangeWithinExcludedD+ ]++floatTests :: TestTree+floatTests = testGroup "(Float)"+ [ -- Check that https://github.com/haskell/random/issues/53 does not regress++ testCase "Subnormal generation not above upper bound" $+ [] @?= filter (>4.0e-45) (take 100000 $ randomRs (0, 4.0e-45::Float) $ mkStdGen 0)++ , testCase "Subnormal generation includes upper bound" $+ 1.0e-45 `elem` take 100 (randomRs (0, 1.0e-45::Float) $ mkStdGen 0) @?+ "Does not contain 1.0e-45"+ ]++showsType :: forall t . Typeable t => Proxy t -> ShowS+showsType px = showsTypeRep (typeRep px)++byteStringSpec :: TestTree+byteStringSpec =+ testGroup+ "ByteString"+ [ SC.testProperty "genShortByteString" $ \(seed, n8) ->+ let n = fromIntegral (n8 :: Word8) -- no need to generate huge collection of bytes+ in SBS.length (fst (seeded (genShortByteString n) seed)) == n+ , SC.testProperty "genByteString" $ \(seed, n8) ->+ let n = fromIntegral (n8 :: Word8)+ in SBS.toShort (fst (seeded (genByteString n) seed)) ==+ fst (seeded (genShortByteString n) seed)+ ]+++rangeSpec ::+ forall a.+ (SC.Serial IO a, Typeable a, Ord a, UniformRange a, Show a)+ => Proxy a -> TestTree+rangeSpec px =+ testGroup ("Range (" ++ showsType px ")")+ [ SC.testProperty "uniformR" $ seeded $ Range.uniformRangeWithin px+ ]++integralSpec ::+ forall a.+ (SC.Serial IO a, Typeable a, Ord a, UniformRange a, Show a)+ => Proxy a -> TestTree+integralSpec px =+ testGroup ("(" ++ showsType px ")")+ [ SC.testProperty "symmetric" $ seeded $ Range.symmetric px+ , SC.testProperty "bounded" $ seeded $ Range.bounded px+ , SC.testProperty "singleton" $ seeded $ Range.singleton px+ , rangeSpec px+ -- TODO: Add more tests+ ]++floatingSpec ::+ forall a.+ (SC.Serial IO a, Typeable a, Num a, Ord a, Random a, UniformRange a, Show a)+ => Proxy a -> TestTree+floatingSpec px =+ testGroup ("(" ++ showsType px ")")+ [ SC.testProperty "uniformR" $ seeded $ Range.uniformRangeWithin px+ -- TODO: Add more tests+ ]++runSpec :: TestTree+runSpec = testGroup "runGenState_ and runPrimGenIO_"+ [ SC.testProperty "equal outputs" $ seeded $ \g -> monadic $ Run.runsEqual g ]++-- | Create a StdGen instance from an Int and pass it to the given function.+seeded :: (StdGen -> a) -> Int -> a+seeded f = f . mkStdGen
+ test/Spec/Range.hs view
@@ -0,0 +1,42 @@+module Spec.Range+ ( symmetric+ , bounded+ , singleton+ , uniformRangeWithin+ , uniformRangeWithinExcludedF+ , uniformRangeWithinExcludedD+ ) where++import System.Random.Internal+import System.Random.Stateful+import Data.Proxy++symmetric :: (RandomGen g, UniformRange a, Eq a) => Proxy a -> g -> (a, a) -> Bool+symmetric _ g (l, r) = fst (uniformR (l, r) g) == fst (uniformR (r, l) g)++bounded :: (RandomGen g, UniformRange a, Ord a) => Proxy a -> g -> (a, a) -> Bool+bounded _ g (l, r) = bottom <= result && result <= top+ where+ bottom = min l r+ top = max l r+ result = fst (uniformR (l, r) g)++singleton :: (RandomGen g, UniformRange a, Eq a) => Proxy a -> g -> a -> Bool+singleton _ g x = result == x+ where+ result = fst (uniformR (x, x) g)++uniformRangeWithin :: (RandomGen g, UniformRange a, Ord a) => Proxy a -> g -> (a, a) -> Bool+uniformRangeWithin _ gen (l, r) =+ runStateGen_ gen $ \g ->+ (\result -> min l r <= result && result <= max l r) <$> uniformRM (l, r) g++uniformRangeWithinExcludedF :: RandomGen g => g -> Bool+uniformRangeWithinExcludedF gen =+ runStateGen_ gen $ \g ->+ (\result -> 0 < result && result <= 1) <$> uniformFloatPositive01M g++uniformRangeWithinExcludedD :: RandomGen g => g -> Bool+uniformRangeWithinExcludedD gen =+ runStateGen_ gen $ \g ->+ (\result -> 0 < result && result <= 1) <$> uniformDoublePositive01M g
+ test/Spec/Run.hs view
@@ -0,0 +1,14 @@+module Spec.Run (runsEqual) where++import Data.Word (Word64)+import System.Random.Stateful++runsEqual :: RandomGen g => g -> IO Bool+runsEqual g = do+ let pureResult = runStateGen_ g uniformM :: Word64+ stResult = runSTGen_ g uniformM :: Word64+ ioGenM <- newIOGenM g+ ioResult <- uniformM ioGenM+ atomicGenM <- newAtomicGenM g+ atomicResult <- uniformM atomicGenM+ return $ all (pureResult ==) [stResult, ioResult, atomicResult]
+ test/doctests.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}+module Main where++#if __GLASGOW_HASKELL__ >= 802++import Test.DocTest (doctest)++main :: IO ()+main = doctest ["src"]++#else++-- TODO: fix doctest support+main :: IO ()+main = putStrLn "\nDoctests are not supported for older ghc version\n"++#endif
− tests/T7936.hs
@@ -1,14 +0,0 @@--- Test for ticket #7936:--- https://ghc.haskell.org/trac/ghc/ticket/7936------ Used to fail with:------ $ cabal test T7936 --test-options="+RTS -M1M -RTS"--- T7936: Heap exhausted;--module Main where--import System.Random (newStdGen)-import Control.Monad (replicateM_)--main = replicateM_ 100000 newStdGen
− tests/TestRandomIOs.hs
@@ -1,20 +0,0 @@--- Test for ticket #4218 (TestRandomIOs):--- https://ghc.haskell.org/trac/ghc/ticket/4218------ Used to fail with:------ $ cabal test TestRandomIOs --test-options="+RTS -M1M -RTS"--- TestRandomIOs: Heap exhausted;--module Main where--import Control.Monad (replicateM)-import System.Random (randomIO)---- Build a list of 5000 random ints in memory (IO Monad is strict), and print--- the last one.--- Should use less than 1Mb of heap space, or we are generating a list of--- unevaluated thunks.-main = do- rs <- replicateM 5000 randomIO :: IO [Int]- print $ last rs
− tests/TestRandomRs.hs
@@ -1,22 +0,0 @@--- Test for ticket #4218 (TestRandomRs):--- https://ghc.haskell.org/trac/ghc/ticket/4218------ Fixed together with ticket #8704--- https://ghc.haskell.org/trac/ghc/ticket/8704--- Commit 4695ffa366f659940369f05e419a4f2249c3a776------ Used to fail with:------ $ cabal test TestRandomRs --test-options="+RTS -M1M -RTS"--- TestRandomRs: Heap exhausted;--module Main where--import Control.Monad (liftM, replicateM)-import System.Random (randomRs, getStdGen)---- Return the five-thousandth random number:--- Should run in constant space (< 1Mb heap).-main = do- n <- (last . take 5000 . randomRs (0, 1000000)) `liftM` getStdGen- print (n::Integer)