diff --git a/Benchmark/Makefile b/Benchmark/Makefile index 8a84e6479..69d2d37b5 100644 --- a/Benchmark/Makefile +++ b/Benchmark/Makefile @@ -1,7 +1,6 @@ -#OPTS= -O2 -Wall -XCPP -OPTS= -O2 -Wall -XCPP -Werror +OPTS= -O2 -Wall -XCPP all: lib bench diff --git a/Benchmark/RandomnessTest2.hs b/Benchmark/RandomnessTest2.hs new file mode 100644 index 000000000..14bc0d773 --- /dev/null +++ b/Benchmark/RandomnessTest2.hs @@ -0,0 +1,42 @@ +module Main where + +import Control.Monad +import System.Random + +-- splitN :: (RandomGen g) => Int -> g -> ([g], g) +splitN 0 g = ([], g) +splitN n g = (g1:l, g') + where + (l, g') = splitN (n-1) g2 + (g1, g2) = split g + +-- The funny splitting operation. +split' :: (RandomGen g) => g -> (g, g) +split' g = (g12, g21) + where + (g1, g2) = split g + (_, g12) = split g1 + (g21, _) = split g2 + +-- This test checks if generators created by calling split 2 times are independent. +-- It generates pairs of integers from 0 to n-1, using split' to +-- generate both numbers using one seed. Then it counts how often the +-- two numbers are equal. +test :: (RandomGen g) => Int -> Int -> g -> Int +test numTests n g = equals + where + (gs, _) = splitN numTests g + equals = count id $ map single gs + count p l = length $ filter p l + single g' = (fst $ randomR (0, n-1) g1) == (fst $ randomR (0, n-1) g2) + where + (g1, g2) = split' g' + +main = do + let g = mkStdGen 42 + forM_ [2..15] $ \i -> do + let actual = test (i * 1000) i g + putStrLn $ "Generated " ++ show (i * 1000) + ++ " pairs of numbers from 0 to " ++ show (i - 1) + ++ " -- " ++ show actual ++ " pairs contained equal numbers " + ++ "and we expected about 1000." diff --git a/Benchmark/RandomnessTest3.hs b/Benchmark/RandomnessTest3.hs new file mode 100644 index 000000000..b943f59d3 --- /dev/null +++ b/Benchmark/RandomnessTest3.hs @@ -0,0 +1,43 @@ +module Main where + +import Control.Monad +import System.Random.TF.Gen +import System.Random.TF.Instances + +splitN :: (RandomGen g) => Int -> g -> ([g], g) +splitN 0 g = ([], g) +splitN n g = (g1:l, g') + where + (l, g') = splitN (n-1) g2 + (g1, g2) = split g + +-- The funny splitting operation. +split' :: (RandomGen g) => g -> (g, g) +split' g = (g12, g21) + where + (g1, g2) = split g + (_, g12) = split g1 + (g21, _) = split g2 + +-- This test checks if generators created by calling split 2 times are independent. +-- It generates pairs of integers from 0 to n-1, using split' to +-- generate both numbers using one seed. Then it counts how often the +-- two numbers are equal. +test :: (RandomGen g) => Int -> Int -> g -> Int +test numTests n g = equals + where + (gs, _) = splitN numTests g + equals = count id $ map single gs + count p l = length $ filter p l + single g' = (fst $ randomR (0, n-1) g1) == (fst $ randomR (0, n-1) g2) + where + (g1, g2) = split' g' + +main = do + let g = seedTFGen (42, 42, 42, 42) + forM_ [2..15] $ \i -> do + let actual = test (i * 1000) i g + putStrLn $ "Generated " ++ show (i * 1000) + ++ " pairs of numbers from 0 to " ++ show (i - 1) + ++ " -- " ++ show actual ++ " pairs contained equal numbers " + ++ "and we expected about 1000." diff --git a/Benchmark/SimpleRNGBench.hs b/Benchmark/SimpleRNGBench.hs index c25b75d47..04e2f7715 100644 --- a/Benchmark/SimpleRNGBench.hs +++ b/Benchmark/SimpleRNGBench.hs @@ -33,6 +33,7 @@ import Prelude hiding (last,sum) import BinSearch #ifdef TEST_COMPETITORS +import System.Random.TF import System.Random.Mersenne.Pure64 import System.Random.MWC import Control.Monad.Primitive @@ -44,11 +45,11 @@ import GHC.IO -- Miscellaneous helpers: -- Readable large integer printing: -commaint :: Integral a => a -> String +commaint :: (Show a, Integral a) => a -> String commaint n = reverse $ concat $ intersperse "," $ - chunk 3 $ + chunksOf 3 $ reverse (show n) padleft :: Int -> String -> String @@ -281,7 +282,13 @@ main = do timeit th freq "System.Random.Mersenne.Pure64 Ints" gen_mt randInt2 timeit th freq "System.Random.Mersenne.Pure64 Floats" gen_mt randFloat2 --- gen_mwc <- create + let gen_tf = seedTFGen (0,1,2,3) + randInt4 = random :: RandomGen g => g -> (Int,g) + randFloat4 = random :: RandomGen g => g -> (Float,g) + timeit th freq "System.Random.TF next" gen_tf next + timeit th freq "System.Random.TF Ints" gen_tf randInt4 + timeit th freq "System.Random.TF Floats" gen_tf randFloat4 + withSystemRandom $ \ gen_mwc -> do let randInt3 = random :: RandomGen g => g -> (Int,g) randFloat3 = random :: RandomGen g => g -> (Float,g) diff --git a/README.md b/README.md index 9d5bb51b2..47b75896b 100644 --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ The API documentation can be found here: 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) +(https://downloads.haskell.org/~ghc/latest/docs/html/libraries/haskell98-2.0.0.3/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). diff --git a/System/Random.hs b/System/Random.hs index ab7727405..7f9b4832a 100644 --- a/System/Random.hs +++ b/System/Random.hs @@ -7,7 +7,7 @@ -- 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 @@ -18,7 +18,7 @@ -- 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: +-- 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. @@ -40,40 +40,40 @@ #include "MachDeps.h" module System.Random - ( + ( - -- $intro + -- $intro - -- * Random number generators + -- * Random number generators #ifdef ENABLE_SPLITTABLEGEN - RandomGen(next, genRange) - , SplittableGen(split) + RandomGen(next, genRange) + , SplittableGen(split) #else - RandomGen(next, genRange, split) + RandomGen(next, genRange, split) #endif - -- ** Standard random number generators - , StdGen - , mkStdGen + -- ** Standard random number generators + , StdGen + , mkStdGen - -- ** The global random number generator + -- ** The global random number generator - -- $globalrng + -- $globalrng - , getStdRandom - , getStdGen - , setStdGen - , newStdGen + , getStdRandom + , getStdGen + , setStdGen + , newStdGen - -- * Random values of various types - , Random ( random, randomR, - randoms, randomRs, - randomIO, randomRIO ) + -- * Random values of various types + , Random ( random, randomR, + randoms, randomRs, + randomIO, randomRIO ) - -- * References - -- $references + -- * References + -- $references - ) where + ) where import Prelude @@ -83,15 +83,15 @@ import Data.Word import Foreign.C.Types #ifdef __NHC__ -import CPUTime ( getCPUTime ) +import CPUTime ( getCPUTime ) import Foreign.Ptr ( Ptr, nullPtr ) -import Foreign.C ( CTime, CUInt ) +import Foreign.C ( CTime, CUInt ) #else -import System.CPUTime ( getCPUTime ) -import Data.Time ( getCurrentTime, UTCTime(..) ) +import System.CPUTime ( getCPUTime ) +import Data.Time ( getCurrentTime, UTCTime(..) ) import Data.Ratio ( numerator, denominator ) #endif -import Data.Char ( isSpace, chr, ord ) +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) @@ -99,7 +99,7 @@ import Data.IORef ( atomicModifyIORef' ) #else import Data.IORef ( atomicModifyIORef ) #endif -import Numeric ( readDec ) +import Numeric ( readDec ) #ifdef __GLASGOW_HASKELL__ import GHC.Exts ( build ) @@ -169,9 +169,6 @@ class RandomGen g where -- 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. @@ -201,17 +198,17 @@ 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: +instance of 'StdGen' has the following properties: -* It guarantees to succeed on any string. +* It guarantees to succeed on any string. -* It guarantees to consume only a finite portion of the string. +* It guarantees to consume only a finite portion of the string. * Different argument strings are likely to result in different results. -} -data StdGen +data StdGen = StdGen !Int32 !Int32 instance RandomGen StdGen where @@ -224,8 +221,8 @@ instance SplittableGen StdGen where split = stdSplit instance Show StdGen where - showsPrec p (StdGen s1 s2) = - showsPrec p s1 . + showsPrec p (StdGen s1 s2) = + showsPrec p s1 . showChar ' ' . showsPrec p s2 @@ -234,11 +231,11 @@ instance Read StdGen where case try_read r of r'@[_] -> r' _ -> [stdFromString r] -- because it shouldn't ever fail. - where + where try_read r = do (s1, r1) <- readDec (dropWhile isSpace r) - (s2, r2) <- readDec (dropWhile isSpace r1) - return (StdGen s1 s2, r2) + (s2, r2) <- readDec (dropWhile isSpace r1) + return (StdGen s1 s2, r2) {- If we cannot unravel the StdGen from a string, create @@ -246,7 +243,7 @@ instance Read StdGen where -} stdFromString :: String -> (StdGen, String) stdFromString s = (mkStdGen num, rest) - where (cs, rest) = splitAt 6 s + where (cs, rest) = splitAt 6 s num = foldl (\a x -> x + 3 * a) 1 (map ord cs) @@ -266,11 +263,11 @@ 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 + -- 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 @@ -323,7 +320,7 @@ class Random a where -- | A variant of 'random' that uses the global random number generator -- (see "System.Random#globalrng"). randomIO :: IO a - randomIO = getStdRandom random + randomIO = getStdRandom random -- | Produce an infinite list-equivalent of random values. {-# INLINE buildRandoms #-} @@ -340,7 +337,7 @@ buildRandoms cons rand = go instance Random Integer where randomR ival g = randomIvalInteger ival g - random g = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) 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 @@ -378,13 +375,13 @@ instance Random CIntMax where randomR = randomIvalIntegral; random = randomBo instance Random CUIntMax where randomR = randomIvalIntegral; random = randomBounded instance Random Char where - randomR (a,b) g = + 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 + random g = randomR (minBound,maxBound) g instance Random Bool where - randomR (a,b) g = + randomR (a,b) g = case (randomIvalInteger (bool2Int a, bool2Int b) g) of (x, g') -> (int2Bool x, g') where @@ -392,42 +389,42 @@ instance Random Bool where bool2Int False = 0 bool2Int True = 1 - int2Bool :: Int -> Bool - int2Bool 0 = False - int2Bool _ = True + int2Bool :: Int -> Bool + int2Bool 0 = False + int2Bool _ = True - random g = randomR (minBound,maxBound) g + 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 +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 + | 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') -> + 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 + ((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') -> + 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]: + ((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 @@ -436,8 +433,8 @@ instance Random Float where -- 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') + random rng = case random rng of + (x,rng') -> (realToFrac (x::Float), rng') instance Random CDouble where randomR = randomRFloating @@ -445,8 +442,8 @@ instance Random CDouble where -- 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') + -- random rng = case random rng of + -- (x,rng') -> (realToFrac (x::Double), rng') mkStdRNG :: Integer -> IO StdGen mkStdRNG o = do @@ -463,7 +460,7 @@ 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 @@ -482,7 +479,7 @@ randomIvalInteger (l,h) rng k = h - l + 1 magtgt = k * q - -- generate random values until we exceed the target magnitude + -- 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 @@ -494,18 +491,18 @@ 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 +randomIvalDouble (l,h) fromDouble rng | l > h = randomIvalDouble (h,l) fromDouble rng - | otherwise = + | 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 + (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') + fromIntegral (x::Int32) + in + (scaled_x, rng') int32Count :: Integer int32Count = toInteger (maxBound::Int32) - toInteger (minBound::Int32) + 1 -- GHC ticket #3982 @@ -516,16 +513,16 @@ 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' + 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) diff --git a/random.cabal b/random.cabal index fd29840fb..a28063c90 100644 --- a/random.cabal +++ b/random.cabal @@ -40,7 +40,7 @@ Library source-repository head type: git - location: http://git.haskell.org/packages/random.git + location: https://github.com/haskell/random.git -- To run the Test-Suite: -- $ cabal configure --enable-tests diff --git a/tests/all.T b/tests/all.T index f1675ed5c..f85ec767a 100644 --- a/tests/all.T +++ b/tests/all.T @@ -1,3 +1,4 @@ +setTestOpts(reqlib('random')) test('rangeTest', normal,