1 -----------------------------------------------------------------------------
3 -- Module : System.Random
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/core/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : portable
11 -- $Id: Random.hs,v 1.1 2001/06/28 14:15:04 simonmar Exp $
15 -----------------------------------------------------------------------------
19 RandomGen(next, split)
22 , Random ( random, randomR,
31 -- The June 1988 (v31 #6) issue of the Communications of the ACM has an
32 -- article by Pierre L'Ecuyer called, "Efficient and Portable Combined
33 -- Random Number Generators". Here is the Portable Combined Generator of
34 -- L'Ecuyer for 32-bit computers. It has a period of roughly 2.30584e18.
36 -- Transliterator: Lennart Augustsson
38 -- sof 1/99 - code brought (kicking and screaming) into the new Random
43 import System.CPUTime ( getCPUTime )
44 import Data.Char ( isSpace, chr, ord )
45 import System.IO.Unsafe ( unsafePerformIO )
48 #ifdef __GLASGOW_HASKELL__
49 import GHC.Show ( showSignedInt, showSpace )
50 import GHC.Read ( readDec )
51 import GHC.IOBase ( unsafePerformIO, stToIO )
52 import System.Time ( getClockTime, ClockTime(..) )
55 class RandomGen g where
63 instance RandomGen StdGen where
67 #ifdef __GLASGOW_HASKELL__
68 instance Show StdGen where
69 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)
104 mkStdGen :: Int -> StdGen -- why not Integer ?
106 | s < 0 = mkStdGen (-s)
107 | otherwise = StdGen (s1+1) (s2+1)
109 (q, s1) = s `divMod` 2147483562
110 s2 = q `mod` 2147483398
112 createStdGen :: Integer -> StdGen
114 | s < 0 = createStdGen (-s)
115 | otherwise = StdGen (fromInteger (s1+1)) (fromInteger (s2+1))
117 (q, s1) = s `divMod` 2147483562
118 s2 = q `mod` 2147483398
121 -- The class definition - see library report for details.
124 -- Minimal complete definition: random and randomR
125 random :: RandomGen g => g -> (a, g)
126 randomR :: RandomGen g => (a,a) -> g -> (a,g)
128 randoms :: RandomGen g => g -> [a]
129 randoms g = x : randoms g' where (x,g') = random g
131 randomRs :: RandomGen g => (a,a) -> g -> [a]
132 randomRs ival g = x : randomRs ival g' where (x,g') = randomR ival g
135 randomIO = getStdRandom random
137 randomRIO :: (a,a) -> IO a
138 randomRIO range = getStdRandom (randomR range)
141 instance Random Int where
142 randomR (a,b) g = randomIvalInteger (toInteger a, toInteger b) g
143 random g = randomR (minBound,maxBound) g
145 instance Random Char where
147 case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of
149 random g = randomR (minBound,maxBound) g
151 instance Random Bool where
153 case (randomIvalInteger (toInteger (bool2Int a), toInteger (bool2Int b)) g) of
154 (x, g) -> (int2Bool x, g)
162 random g = randomR (minBound,maxBound) g
164 instance Random Integer where
165 randomR ival g = randomIvalInteger ival g
166 random g = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g
168 instance Random Double where
169 randomR ival g = randomIvalDouble ival id g
170 random g = randomR (0::Double,1) g
172 -- hah, so you thought you were saving cycles by using Float?
173 instance Random Float where
174 random g = randomIvalDouble (0::Double,1) realToFrac g
175 randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g
177 #ifdef __GLASGOW_HASKELL__
178 mkStdRNG :: Integer -> IO StdGen
181 (TOD sec _) <- getClockTime
182 return (createStdGen (sec * 12345 + ct + o))
186 mkStdRNG :: Integer -> IO StdGen
189 return (createStdGen (ct + o))
192 randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)
193 randomIvalInteger (l,h) rng
194 | l > h = randomIvalInteger (h,l) rng
195 | otherwise = case (f n 1 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng')
206 f (n-1) (fromIntegral x + acc * b) g'
208 randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g)
209 randomIvalDouble (l,h) fromDouble rng
210 | l > h = randomIvalDouble (h,l) fromDouble rng
212 case (randomIvalInteger (toInteger (minBound::Int), toInteger (maxBound::Int)) rng) of
216 fromDouble ((l+h)/2) +
217 fromDouble ((h-l) / realToFrac intRange) *
218 fromIntegral (x::Int)
223 intRange = toInteger (maxBound::Int) - toInteger (minBound::Int)
225 iLogBase :: Integer -> Integer -> Integer
226 iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b)
228 stdNext :: StdGen -> (Int, StdGen)
229 stdNext (StdGen s1 s2) = (z', StdGen s1'' s2'')
230 where z' = if z < 1 then z + 2147483562 else z
234 s1' = 40014 * (s1 - k * 53668) - k * 12211
235 s1'' = if s1' < 0 then s1' + 2147483563 else s1'
238 s2' = 40692 * (s2 - k' * 52774) - k' * 3791
239 s2'' = if s2' < 0 then s2' + 2147483399 else s2'
241 stdSplit :: StdGen -> (StdGen, StdGen)
242 stdSplit std@(StdGen s1 s2)
245 -- no statistical foundation for this!
246 left = StdGen new_s1 t2
247 right = StdGen t1 new_s2
249 new_s1 | s1 == 2147483562 = 1
252 new_s2 | s2 == 1 = 2147483398
255 StdGen t1 t2 = snd (next std)
258 setStdGen :: StdGen -> IO ()
259 setStdGen sgen = writeIORef theStdGen sgen
261 getStdGen :: IO StdGen
262 getStdGen = readIORef theStdGen
264 theStdGen :: IORef StdGen
265 theStdGen = unsafePerformIO (newIORef (createStdGen 0))
267 newStdGen :: IO StdGen
270 let (a,b) = split rng
274 getStdRandom :: (StdGen -> (a,StdGen)) -> IO a
277 let (v, new_rng) = f rng