[project @ 2002-05-09 13:16:29 by simonmar]
[packages/random.git] / System / Random.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : System.Random
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : portable
10 --
11 -- Random numbers.
12 --
13 -----------------------------------------------------------------------------
14
15 module System.Random
16 (
17 RandomGen(next, split, genRange)
18 , StdGen
19 , mkStdGen
20 , Random ( random, randomR,
21 randoms, randomRs,
22 randomIO, randomRIO )
23 , getStdRandom
24 , getStdGen
25 , setStdGen
26 , newStdGen
27 ) where
28
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.
33
34 -- Transliterator: Lennart Augustsson
35
36 -- sof 1/99 - code brought (kicking and screaming) into the new Random
37 -- world..
38
39 import Prelude
40
41 import System.CPUTime ( getCPUTime )
42 import Data.Char ( isSpace, chr, ord )
43 import System.IO.Unsafe ( unsafePerformIO )
44 import Data.IORef
45
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(..) )
51 #endif
52
53 class RandomGen g where
54 next :: g -> (Int, g)
55 split :: g -> (g, g)
56 genRange :: g -> (Int,Int)
57
58 -- default mathod
59 genRange g = (minBound,maxBound)
60
61
62 data StdGen
63 = StdGen Int Int
64
65 instance RandomGen StdGen where
66 next = stdNext
67 split = stdSplit
68
69 #ifdef __GLASGOW_HASKELL__
70 instance Show StdGen where
71 showsPrec p (StdGen s1 s2) =
72 showSignedInt p s1 .
73 showSpace .
74 showSignedInt p s2
75 #endif
76
77 #ifdef __HUGS__
78 instance Show StdGen where
79 showsPrec p (StdGen s1 s2) =
80 showsPrec p s1 .
81 showChar ' ' .
82 showsPrec p s2
83 #endif
84
85 instance Read StdGen where
86 readsPrec _p = \ r ->
87 case try_read r of
88 r@[_] -> r
89 _ -> [stdFromString r] -- because it shouldn't ever fail.
90 where
91 try_read r = do
92 (s1, r1) <- readDec (dropWhile isSpace r)
93 (s2, r2) <- readDec (dropWhile isSpace r1)
94 return (StdGen s1 s2, r2)
95
96 {-
97 If we cannot unravel the StdGen from a string, create
98 one based on the string given.
99 -}
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)
104
105
106 mkStdGen :: Int -> StdGen -- why not Integer ?
107 mkStdGen s
108 | s < 0 = mkStdGen (-s)
109 | otherwise = StdGen (s1+1) (s2+1)
110 where
111 (q, s1) = s `divMod` 2147483562
112 s2 = q `mod` 2147483398
113
114 createStdGen :: Integer -> StdGen
115 createStdGen s
116 | s < 0 = createStdGen (-s)
117 | otherwise = StdGen (fromInteger (s1+1)) (fromInteger (s2+1))
118 where
119 (q, s1) = s `divMod` 2147483562
120 s2 = q `mod` 2147483398
121
122
123 -- The class definition - see library report for details.
124
125 class Random a where
126 -- Minimal complete definition: random and randomR
127 random :: RandomGen g => g -> (a, g)
128 randomR :: RandomGen g => (a,a) -> g -> (a,g)
129
130 randoms :: RandomGen g => g -> [a]
131 randoms g = x : randoms g' where (x,g') = random g
132
133 randomRs :: RandomGen g => (a,a) -> g -> [a]
134 randomRs ival g = x : randomRs ival g' where (x,g') = randomR ival g
135
136 randomIO :: IO a
137 randomIO = getStdRandom random
138
139 randomRIO :: (a,a) -> IO a
140 randomRIO range = getStdRandom (randomR range)
141
142
143 instance Random Int where
144 randomR (a,b) g = randomIvalInteger (toInteger a, toInteger b) g
145 random g = randomR (minBound,maxBound) g
146
147 instance Random Char where
148 randomR (a,b) g =
149 case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of
150 (x,g) -> (chr x, g)
151 random g = randomR (minBound,maxBound) g
152
153 instance Random Bool where
154 randomR (a,b) g =
155 case (randomIvalInteger (toInteger (bool2Int a), toInteger (bool2Int b)) g) of
156 (x, g) -> (int2Bool x, g)
157 where
158 bool2Int False = 0
159 bool2Int True = 1
160
161 int2Bool 0 = False
162 int2Bool _ = True
163
164 random g = randomR (minBound,maxBound) g
165
166 instance Random Integer where
167 randomR ival g = randomIvalInteger ival g
168 random g = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g
169
170 instance Random Double where
171 randomR ival g = randomIvalDouble ival id g
172 random g = randomR (0::Double,1) g
173
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
178
179 #ifdef __GLASGOW_HASKELL__
180 mkStdRNG :: Integer -> IO StdGen
181 mkStdRNG o = do
182 ct <- getCPUTime
183 (TOD sec _) <- getClockTime
184 return (createStdGen (sec * 12345 + ct + o))
185 #endif
186
187 #ifdef __HUGS__
188 mkStdRNG :: Integer -> IO StdGen
189 mkStdRNG o = do
190 ct <- getCPUTime
191 return (createStdGen (ct + o))
192 #endif
193
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')
198 where
199 k = h - l + 1
200 b = 2147483561
201 n = iLogBase b k
202
203 f 0 acc g = (acc, g)
204 f n acc g =
205 let
206 (x,g') = next g
207 in
208 f (n-1) (fromIntegral x + acc * b) g'
209
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
213 | otherwise =
214 case (randomIvalInteger (toInteger (minBound::Int), toInteger (maxBound::Int)) rng) of
215 (x, rng') ->
216 let
217 scaled_x =
218 fromDouble ((l+h)/2) +
219 fromDouble ((h-l) / realToFrac intRange) *
220 fromIntegral (x::Int)
221 in
222 (scaled_x, rng')
223
224 intRange :: Integer
225 intRange = toInteger (maxBound::Int) - toInteger (minBound::Int)
226
227 iLogBase :: Integer -> Integer -> Integer
228 iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b)
229
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
233 z = s1'' - s2''
234
235 k = s1 `quot` 53668
236 s1' = 40014 * (s1 - k * 53668) - k * 12211
237 s1'' = if s1' < 0 then s1' + 2147483563 else s1'
238
239 k' = s2 `quot` 52774
240 s2' = 40692 * (s2 - k' * 52774) - k' * 3791
241 s2'' = if s2' < 0 then s2' + 2147483399 else s2'
242
243 stdSplit :: StdGen -> (StdGen, StdGen)
244 stdSplit std@(StdGen s1 s2)
245 = (left, right)
246 where
247 -- no statistical foundation for this!
248 left = StdGen new_s1 t2
249 right = StdGen t1 new_s2
250
251 new_s1 | s1 == 2147483562 = 1
252 | otherwise = s1 + 1
253
254 new_s2 | s2 == 1 = 2147483398
255 | otherwise = s2 - 1
256
257 StdGen t1 t2 = snd (next std)
258
259
260 setStdGen :: StdGen -> IO ()
261 setStdGen sgen = writeIORef theStdGen sgen
262
263 getStdGen :: IO StdGen
264 getStdGen = readIORef theStdGen
265
266 theStdGen :: IORef StdGen
267 theStdGen = unsafePerformIO (newIORef (createStdGen 0))
268
269 newStdGen :: IO StdGen
270 newStdGen = do
271 rng <- getStdGen
272 let (a,b) = split rng
273 setStdGen a
274 return b
275
276 getStdRandom :: (StdGen -> (a,StdGen)) -> IO a
277 getStdRandom f = do
278 rng <- getStdGen
279 let (v, new_rng) = f rng
280 setStdGen new_rng
281 return v