1 % ------------------------------------------------------------------------------
2 % $Id: Random.lhs,v 1.24 2001/02/28 00:01:03 qrczak 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 PrelShow ( showSignedInt, showSpace )
37 import PrelRead ( readDec )
38 import PrelIOBase ( unsafePerformIO, stToIO )
39 import PrelArr ( STRef, newSTRef, readSTRef, writeSTRef )
40 import Time ( getClockTime, ClockTime(..) )
42 import PrelPrim ( IORef
50 import CPUTime ( getCPUTime )
51 import Char ( isSpace, chr, ord )
55 class RandomGen g where
65 instance RandomGen StdGen where
70 instance Show StdGen where
71 showsPrec p (StdGen s1 s2) =
76 instance Show StdGen where
77 showsPrec p (StdGen s1 s2) =
83 instance Read StdGen where
87 _ -> [stdFromString r] -- because it shouldn't ever fail.
90 (s1, r1) <- readDec (dropWhile isSpace r)
91 (s2, r2) <- readDec (dropWhile isSpace r1)
92 return (StdGen s1 s2, r2)
95 If we cannot unravel the StdGen from a string, create
96 one based on the string given.
98 stdFromString :: String -> (StdGen, String)
99 stdFromString s = (mkStdGen num, rest)
100 where (cs, rest) = splitAt 6 s
101 num = foldl (\a x -> x + 3 * a) 1 (map ord cs)
105 mkStdGen :: Int -> StdGen -- why not Integer ?
107 | s < 0 = mkStdGen (-s)
108 | otherwise = StdGen (s1+1) (s2+1)
110 (q, s1) = s `divMod` 2147483562
111 s2 = q `mod` 2147483398
113 createStdGen :: Integer -> StdGen
115 | s < 0 = createStdGen (-s)
116 | otherwise = StdGen (fromInteger (s1+1)) (fromInteger (s2+1))
118 (q, s1) = s `divMod` 2147483562
119 s2 = q `mod` 2147483398
123 The class definition - see library report for details.
127 -- Minimal complete definition: random and randomR
128 random :: RandomGen g => g -> (a, g)
129 randomR :: RandomGen g => (a,a) -> g -> (a,g)
131 randoms :: RandomGen g => g -> [a]
132 randoms g = x : randoms g' where (x,g') = random g
134 randomRs :: RandomGen g => (a,a) -> g -> [a]
135 randomRs ival g = x : randomRs ival g' where (x,g') = randomR ival g
138 randomIO = getStdRandom random
140 randomRIO :: (a,a) -> IO a
141 randomRIO range = getStdRandom (randomR range)
145 instance Random Int where
146 randomR (a,b) g = randomIvalInteger (toInteger a, toInteger b) g
147 random g = randomR (minBound,maxBound) g
149 instance Random Char where
151 case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of
153 random g = randomR (minBound,maxBound) g
155 instance Random Bool where
157 case (randomIvalInteger (toInteger (bool2Int a), toInteger (bool2Int b)) g) of
158 (x, g) -> (int2Bool x, g)
166 random g = randomR (minBound,maxBound) g
168 instance Random Integer where
169 randomR ival g = randomIvalInteger ival g
170 random g = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g
172 instance Random Double where
173 randomR ival g = randomIvalDouble ival id g
174 random g = randomR (0::Double,1) g
176 -- hah, so you thought you were saving cycles by using Float?
177 instance Random Float where
178 random g = randomIvalDouble (0::Double,1) realToFrac g
179 randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g
185 mkStdRNG :: Integer -> IO StdGen
188 return (createStdGen (ct + o))
190 mkStdRNG :: Integer -> IO StdGen
193 (TOD sec _) <- getClockTime
194 return (createStdGen (sec * 12345 + ct + o))
197 randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)
198 randomIvalInteger (l,h) rng
199 | l > h = randomIvalInteger (h,l) rng
200 | otherwise = case (f n 1 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng')
211 f (n-1) (fromIntegral x + acc * b) g'
213 randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g)
214 randomIvalDouble (l,h) fromDouble rng
215 | l > h = randomIvalDouble (h,l) fromDouble rng
217 case (randomIvalInteger (toInteger (minBound::Int), toInteger (maxBound::Int)) rng) of
221 fromDouble ((l+h)/2) +
222 fromDouble ((h-l) / realToFrac intRange) *
223 fromIntegral (x::Int)
228 intRange = toInteger (maxBound::Int) - toInteger (minBound::Int)
230 iLogBase :: Integer -> Integer -> Integer
231 iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b)
233 stdNext :: StdGen -> (Int, StdGen)
234 stdNext (StdGen s1 s2) = (z', StdGen s1'' s2'')
235 where z' = if z < 1 then z + 2147483562 else z
239 s1' = 40014 * (s1 - k * 53668) - k * 12211
240 s1'' = if s1' < 0 then s1' + 2147483563 else s1'
243 s2' = 40692 * (s2 - k' * 52774) - k' * 3791
244 s2'' = if s2' < 0 then s2' + 2147483399 else s2'
246 stdSplit :: StdGen -> (StdGen, StdGen)
247 stdSplit std@(StdGen s1 s2)
250 -- no statistical foundation for this!
251 left = StdGen new_s1 t2
252 right = StdGen t1 new_s2
254 new_s1 | s1 == 2147483562 = 1
257 new_s2 | s2 == 1 = 2147483398
260 StdGen t1 t2 = snd (next std)
267 setStdGen :: StdGen -> IO ()
268 setStdGen sgen = writeIORef theStdGen sgen
270 getStdGen :: IO StdGen
271 getStdGen = readIORef theStdGen
273 theStdGen :: IORef StdGen
274 theStdGen = unsafePerformIO (newIORef (createStdGen 0))
278 global_rng :: STRef RealWorld StdGen
279 global_rng = unsafePerformIO $ do
281 stToIO (newSTRef rng)
283 setStdGen :: StdGen -> IO ()
284 setStdGen sgen = stToIO (writeSTRef global_rng sgen)
286 getStdGen :: IO StdGen
287 getStdGen = stToIO (readSTRef global_rng)
292 newStdGen :: IO StdGen
295 let (a,b) = split rng
299 getStdRandom :: (StdGen -> (a,StdGen)) -> IO a
302 let (v, new_rng) = f rng