1 % ------------------------------------------------------------------------------
2 % $Id: Random.lhs,v 1.21 2000/06/30 13:39:36 simonmar Exp $
4 % (c) The University of Glasgow, 1995-2000
7 \section[Random]{Module @Random@}
9 The June 1988 (v31 #6) issue of the Communications of the ACM has an
10 article by Pierre L'Ecuyer called, "Efficient and Portable Combined
11 Random Number Generators". Here is the Portable Combined Generator of
12 L'Ecuyer for 32-bit computers. It has a period of roughly 2.30584e18.
14 Transliterator: Lennart Augustsson
16 sof 1/99 - code brought (kicking and screaming) into the new Random
22 RandomGen(next, split)
25 , Random ( random, randomR,
35 import PrelGHC ( RealWorld )
36 import PrelNum ( fromInt )
37 import PrelShow ( showSignedInt, showSpace )
38 import PrelRead ( readDec )
39 import PrelIOBase ( unsafePerformIO, stToIO )
40 import PrelArr ( STRef, newSTRef, readSTRef, writeSTRef )
41 import PrelReal ( toInt )
42 import PrelFloat ( float2Double, double2Float )
43 import Time ( getClockTime, ClockTime(..) )
45 import PrelPrim ( IORef
53 import CPUTime ( getCPUTime )
54 import Char ( isSpace, chr, ord )
58 class RandomGen g where
68 instance RandomGen StdGen where
73 instance Show StdGen where
74 showsPrec p (StdGen s1 s2) =
79 instance Show StdGen where
80 showsPrec p (StdGen s1 s2) =
86 instance Read StdGen where
90 _ -> [stdFromString r] -- because it shouldn't ever fail.
93 (s1, r1) <- readDec (dropWhile isSpace r)
94 (s2, r2) <- readDec (dropWhile isSpace r1)
95 return (StdGen s1 s2, r2)
98 If we cannot unravel the StdGen from a string, create
99 one based on the string given.
101 stdFromString :: String -> (StdGen, String)
102 stdFromString s = (mkStdGen num, rest)
103 where (cs, rest) = splitAt 6 s
104 num = foldl (\a x -> x + 3 * a) 1 (map ord cs)
108 mkStdGen :: Int -> StdGen -- why not Integer ?
110 | s < 0 = mkStdGen (-s)
111 | otherwise = StdGen (s1+1) (s2+1)
113 (q, s1) = s `divMod` 2147483562
114 s2 = q `mod` 2147483398
116 createStdGen :: Integer -> StdGen
118 | s < 0 = createStdGen (-s)
119 | otherwise = StdGen (toInt (s1+1)) (toInt (s2+1))
121 (q, s1) = s `divMod` 2147483562
122 s2 = q `mod` 2147483398
126 The class definition - see library report for details.
130 -- Minimal complete definition: random and randomR
131 random :: RandomGen g => g -> (a, g)
132 randomR :: RandomGen g => (a,a) -> g -> (a,g)
134 randoms :: RandomGen g => g -> [a]
135 randoms g = x : randoms g' where (x,g') = random g
137 randomRs :: RandomGen g => (a,a) -> g -> [a]
138 randomRs ival g = x : randomRs ival g' where (x,g') = randomR ival g
141 randomIO = getStdRandom random
143 randomRIO :: (a,a) -> IO a
144 randomRIO range = getStdRandom (randomR range)
148 instance Random Int where
149 randomR (a,b) g = randomIvalInteger (toInteger a, toInteger b) g
150 random g = randomR (minBound,maxBound) g
152 instance Random Char where
154 case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of
156 random g = randomR (minBound,maxBound) g
158 instance Random Bool where
160 case (randomIvalInteger (toInteger (bool2Int a), toInteger (bool2Int b)) g) of
161 (x, g) -> (int2Bool x, g)
169 random g = randomR (minBound,maxBound) g
171 instance Random Integer where
172 randomR ival g = randomIvalInteger ival g
173 random g = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g
175 instance Random Double where
176 randomR ival g = randomIvalDouble ival id g
177 random g = randomR (0::Double,1) g
179 -- hah, so you thought you were saving cycles by using Float?
182 instance Random Float where
183 random g = randomIvalDouble (0::Double,1) realToFrac g
184 randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g
186 instance Random Float where
187 randomR (a,b) g = randomIvalDouble (float2Double a, float2Double b) double2Float g
188 random g = randomIvalDouble (0::Double,1) double2Float g
196 mkStdRNG :: Integer -> IO StdGen
199 return (createStdGen (ct + o))
201 mkStdRNG :: Integer -> IO StdGen
204 (TOD sec _) <- getClockTime
205 return (createStdGen (sec * 12345 + ct + o))
208 randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)
209 randomIvalInteger (l,h) rng
210 | l > h = randomIvalInteger (h,l) rng
211 | otherwise = case (f n 1 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng')
222 f (n-1) (fromInt x + acc * b) g'
224 randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g)
225 randomIvalDouble (l,h) fromDouble rng
226 | l > h = randomIvalDouble (h,l) fromDouble rng
228 case (randomIvalInteger (toInteger (minBound::Int), toInteger (maxBound::Int)) rng) of
232 fromDouble ((l+h)/2) +
233 fromDouble ((h-l) / realToFrac intRange) *
234 fromIntegral (x::Int)
239 intRange = toInteger (maxBound::Int) - toInteger (minBound::Int)
241 iLogBase :: Integer -> Integer -> Integer
242 iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b)
244 stdNext :: StdGen -> (Int, StdGen)
245 stdNext (StdGen s1 s2) = (z', StdGen s1'' s2'')
246 where z' = if z < 1 then z + 2147483562 else z
250 s1' = 40014 * (s1 - k * 53668) - k * 12211
251 s1'' = if s1' < 0 then s1' + 2147483563 else s1'
254 s2' = 40692 * (s2 - k' * 52774) - k' * 3791
255 s2'' = if s2' < 0 then s2' + 2147483399 else s2'
257 stdSplit :: StdGen -> (StdGen, StdGen)
258 stdSplit std@(StdGen s1 s2)
261 -- no statistical foundation for this!
262 left = StdGen new_s1 t2
263 right = StdGen t1 new_s2
265 new_s1 | s1 == 2147483562 = 1
268 new_s2 | s2 == 1 = 2147483398
271 StdGen t1 t2 = snd (next std)
278 setStdGen :: StdGen -> IO ()
279 setStdGen sgen = writeIORef theStdGen sgen
281 getStdGen :: IO StdGen
282 getStdGen = readIORef theStdGen
284 theStdGen :: IORef StdGen
285 theStdGen = unsafePerformIO (newIORef (createStdGen 0))
289 global_rng :: STRef RealWorld StdGen
290 global_rng = unsafePerformIO $ do
292 stToIO (newSTRef rng)
294 setStdGen :: StdGen -> IO ()
295 setStdGen sgen = stToIO (writeSTRef global_rng sgen)
297 getStdGen :: IO StdGen
298 getStdGen = stToIO (readSTRef global_rng)
303 newStdGen :: IO StdGen
306 let (a,b) = split rng
310 getStdRandom :: (StdGen -> (a,StdGen)) -> IO a
313 let (v, new_rng) = f rng