1 -----------------------------------------------------------------------------
3 -- Module : System.Random
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : portable
13 -----------------------------------------------------------------------------
17 RandomGen(next, split, genRange)
20 , Random ( random, randomR,
29 -- The June 1988 (v31 #6) issue of the Communications of the ACM has an
30 -- article by Pierre L'Ecuyer called, "Efficient and Portable Combined
31 -- Random Number Generators". Here is the Portable Combined Generator of
32 -- L'Ecuyer for 32-bit computers. It has a period of roughly 2.30584e18.
34 -- Transliterator: Lennart Augustsson
36 -- sof 1/99 - code brought (kicking and screaming) into the new Random
41 import System.CPUTime ( getCPUTime )
42 import Data.Char ( isSpace, chr, ord )
43 import System.IO.Unsafe ( unsafePerformIO )
46 #ifdef __GLASGOW_HASKELL__
47 import GHC.Show ( showSignedInt, showSpace )
48 import Numeric ( readDec )
49 import GHC.IOBase ( unsafePerformIO, stToIO )
50 import System.Time ( getClockTime, ClockTime(..) )
53 class RandomGen g where
56 genRange :: g -> (Int,Int)
59 genRange g = (minBound,maxBound)
65 instance RandomGen StdGen where
69 #ifdef __GLASGOW_HASKELL__
70 instance Show StdGen where
71 showsPrec p (StdGen s1 s2) =
78 instance Show StdGen where
79 showsPrec p (StdGen s1 s2) =
85 instance Read StdGen where
89 _ -> [stdFromString r] -- because it shouldn't ever fail.
92 (s1, r1) <- readDec (dropWhile isSpace r)
93 (s2, r2) <- readDec (dropWhile isSpace r1)
94 return (StdGen s1 s2, r2)
97 If we cannot unravel the StdGen from a string, create
98 one based on the string given.
100 stdFromString :: String -> (StdGen, String)
101 stdFromString s = (mkStdGen num, rest)
102 where (cs, rest) = splitAt 6 s
103 num = foldl (\a x -> x + 3 * a) 1 (map ord cs)
106 mkStdGen :: Int -> StdGen -- why not Integer ?
108 | s < 0 = mkStdGen (-s)
109 | otherwise = StdGen (s1+1) (s2+1)
111 (q, s1) = s `divMod` 2147483562
112 s2 = q `mod` 2147483398
114 createStdGen :: Integer -> StdGen
116 | s < 0 = createStdGen (-s)
117 | otherwise = StdGen (fromInteger (s1+1)) (fromInteger (s2+1))
119 (q, s1) = s `divMod` 2147483562
120 s2 = q `mod` 2147483398
123 -- The class definition - see library report for details.
126 -- Minimal complete definition: random and randomR
127 random :: RandomGen g => g -> (a, g)
128 randomR :: RandomGen g => (a,a) -> g -> (a,g)
130 randoms :: RandomGen g => g -> [a]
131 randoms g = x : randoms g' where (x,g') = random g
133 randomRs :: RandomGen g => (a,a) -> g -> [a]
134 randomRs ival g = x : randomRs ival g' where (x,g') = randomR ival g
137 randomIO = getStdRandom random
139 randomRIO :: (a,a) -> IO a
140 randomRIO range = getStdRandom (randomR range)
143 instance Random Int where
144 randomR (a,b) g = randomIvalInteger (toInteger a, toInteger b) g
145 random g = randomR (minBound,maxBound) g
147 instance Random Char where
149 case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of
151 random g = randomR (minBound,maxBound) g
153 instance Random Bool where
155 case (randomIvalInteger (toInteger (bool2Int a), toInteger (bool2Int b)) g) of
156 (x, g) -> (int2Bool x, g)
164 random g = randomR (minBound,maxBound) g
166 instance Random Integer where
167 randomR ival g = randomIvalInteger ival g
168 random g = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g
170 instance Random Double where
171 randomR ival g = randomIvalDouble ival id g
172 random g = randomR (0::Double,1) g
174 -- hah, so you thought you were saving cycles by using Float?
175 instance Random Float where
176 random g = randomIvalDouble (0::Double,1) realToFrac g
177 randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g
179 #ifdef __GLASGOW_HASKELL__
180 mkStdRNG :: Integer -> IO StdGen
183 (TOD sec _) <- getClockTime
184 return (createStdGen (sec * 12345 + ct + o))
188 mkStdRNG :: Integer -> IO StdGen
191 return (createStdGen (ct + o))
194 randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)
195 randomIvalInteger (l,h) rng
196 | l > h = randomIvalInteger (h,l) rng
197 | otherwise = case (f n 1 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng')
208 f (n-1) (fromIntegral x + acc * b) g'
210 randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g)
211 randomIvalDouble (l,h) fromDouble rng
212 | l > h = randomIvalDouble (h,l) fromDouble rng
214 case (randomIvalInteger (toInteger (minBound::Int), toInteger (maxBound::Int)) rng) of
218 fromDouble ((l+h)/2) +
219 fromDouble ((h-l) / realToFrac intRange) *
220 fromIntegral (x::Int)
225 intRange = toInteger (maxBound::Int) - toInteger (minBound::Int)
227 iLogBase :: Integer -> Integer -> Integer
228 iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b)
230 stdNext :: StdGen -> (Int, StdGen)
231 stdNext (StdGen s1 s2) = (z', StdGen s1'' s2'')
232 where z' = if z < 1 then z + 2147483562 else z
236 s1' = 40014 * (s1 - k * 53668) - k * 12211
237 s1'' = if s1' < 0 then s1' + 2147483563 else s1'
240 s2' = 40692 * (s2 - k' * 52774) - k' * 3791
241 s2'' = if s2' < 0 then s2' + 2147483399 else s2'
243 stdSplit :: StdGen -> (StdGen, StdGen)
244 stdSplit std@(StdGen s1 s2)
247 -- no statistical foundation for this!
248 left = StdGen new_s1 t2
249 right = StdGen t1 new_s2
251 new_s1 | s1 == 2147483562 = 1
254 new_s2 | s2 == 1 = 2147483398
257 StdGen t1 t2 = snd (next std)
260 setStdGen :: StdGen -> IO ()
261 setStdGen sgen = writeIORef theStdGen sgen
263 getStdGen :: IO StdGen
264 getStdGen = readIORef theStdGen
266 theStdGen :: IORef StdGen
267 theStdGen = unsafePerformIO $ do
271 newStdGen :: IO StdGen
274 let (a,b) = split rng
278 getStdRandom :: (StdGen -> (a,StdGen)) -> IO a
281 let (v, new_rng) = f rng