1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
------------------------------------------------------------------------------
-- Standard Library: Random numbers
--
-- Suitable for use with Hugs 98
--
-- The code in this file draws heavily from several different sources,
-- including the implementations in previous Hugs and GHC implementations.
-- Much of this was done by Sigbjorn Finne. If there are mistakes here,
-- blame me. The random number generation itself is based on a published
-- article by L'Ecuyer that was transliterated into Haskell by Lennart
-- Augustsson. See the comments below for further details.
------------------------------------------------------------------------------
module Random(
RandomGen(next, split),
StdGen, mkStdGen,
Random( random, randomR,
randoms, randomRs,
randomIO, randomRIO ),
getStdRandom, getStdGen, setStdGen, newStdGen
) where
import IOExts
-- The RandomGen class: ------------------------------------------------------
class RandomGen g where
next :: g -> (Int, g)
split :: g -> (g, g)
-- An efficient and portable combined random number generator: ---------------
--
-- The June 1988 (v31 #6) issue of the Communications of the ACM has an
-- article by Pierre L'Ecuyer called, "Efficient and Portable Combined
-- Random Number Generators". Here is the Portable Combined Generator of
-- L'Ecuyer for 32-bit computers. It has a period of roughly 2.30584e18.
--
-- Transliterator: Lennart Augustsson
-- sof 1/99 - code brought (kicking and screaming) into the new Random
-- world..
------------------------------------------------------------------------------
data StdGen = StdGen Int Int
mkStdGen :: Int -> StdGen
mkStdGen seed = StdGen (s1+1) (s2+1)
where s = abs seed
(q, s1) = s `divMod` 2147483562
s2 = q `mod` 2147483398
stdFromString :: String -> (StdGen, String)
stdFromString s = (mkStdGen num, rest)
where (cs, rest) = splitAt 6 s
num = foldl (\a x -> x + 3 * a) 1 (map ord cs)
stdNext :: StdGen -> (Int, StdGen)
stdNext (StdGen s1 s2) = (z', StdGen s1'' s2'')
where z' = if z < 1 then z + 2147483562 else z
z = s1'' - s2''
k = s1 `quot` 53668
s1' = 40014 * (s1 - k * 53668) - k * 12211
s1'' = if s1' < 0 then s1' + 2147483563 else s1'
k' = s2 `quot` 52774
s2' = 40692 * (s2 - k' * 52774) - k' * 3791
s2'' = if s2' < 0 then s2' + 2147483399 else s2'
stdSplit :: StdGen -> (StdGen, StdGen)
stdSplit std@(StdGen s1 s2)
= (left, right)
where
-- no statistical foundation for this!
left = StdGen new_s1 t2
right = StdGen t1 new_s2
new_s1 | s1 == 2147483562 = 1
| otherwise = s1 + 1
new_s2 | s2 == 1 = 2147483398
| otherwise = s2 - 1
StdGen t1 t2 = snd (next std)
-- A standard instance of RandomGen: -----------------------------------------
instance RandomGen StdGen where
next = stdNext
split = stdSplit
instance Show StdGen where
showsPrec p (StdGen s1 s2)
= showSigned showInt p s1 . showChar ' ' . showSigned showInt p s2
instance Read StdGen where
readsPrec p = \ r ->
case try_read r of
r@[_] -> r
_ -> [stdFromString r] -- because it shouldn't ever fail.
where
try_read r = do
(s1, r1) <- readDec (dropWhile isSpace r)
(s2, r2) <- readDec (dropWhile isSpace r1)
return (StdGen s1 s2, r2)
-- The Random class: ---------------------------------------------------------
class Random a where
-- Minimal complete definition: random and randomR
random :: RandomGen g => g -> (a, g)
randomR :: RandomGen g => (a,a) -> g -> (a,g)
randoms :: RandomGen g => g -> [a]
randoms g = x : randoms g' where (x,g') = random g
randomRs :: RandomGen g => (a,a) -> g -> [a]
randomRs ival g = x : randomRs ival g' where (x,g') = randomR ival g
randomIO :: IO a
randomIO = getStdRandom random
randomRIO :: (a,a) -> IO a
randomRIO range = getStdRandom (randomR range)
instance Random Int where
random g = randomR (minBound,maxBound) g
randomR (a,b) g = randomIvalInteger (toInteger a, toInteger b) g
instance Random Char where
random g = randomR (minBound,maxBound) g
randomR (a,b) g =
case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of
(x,g) -> (chr x, g)
instance Random Bool where
random g = randomR (minBound,maxBound) g
randomR (a,b) g =
case (randomIvalInteger (toInteger (bool2Int a), toInteger (bool2Int b)) g) of
(x, g) -> (int2Bool x, g)
where
bool2Int False = 0
bool2Int True = 1
int2Bool 0 = False
int2Bool _ = True
instance Random Integer where
random g = randomR (toInteger (minBound::Int),
toInteger (maxBound::Int)) g
randomR ival g = randomIvalInteger ival g
instance Random Double where
random g = randomR (0::Double,1) g
randomR ival g = randomIvalDouble ival id g
-- hah, so you thought you were saving cycles by using Float?
instance Random Float where
random g = randomIvalDouble (0::Double,1) realToFrac g
randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g
-- Auxiliary functions: ------------------------------------------------------
randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)
randomIvalInteger (l,h) rng
| l > h = randomIvalInteger (h,l) rng
| otherwise = case (f n 1 rng) of
(v, rng') -> (fromInteger (l + v `mod` k), rng')
where
k = h - l + 1
b = 2147483561
n = iLogBase b k
f 0 acc g = (acc, g)
f n acc g = let (x,g') = next g
in f (n-1) (fromInt x + acc * b) g'
randomIvalDouble :: (RandomGen g, Fractional a)
=> (Double, Double) -> (Double -> a) -> g -> (a, g)
randomIvalDouble (l,h) fromDouble rng
| l > h = randomIvalDouble (h,l) fromDouble rng
| otherwise =
case (randomIvalInteger (toInteger (minBound::Int), toInteger (maxBound::Int)) rng) of
(x, rng') ->
let
scaled_x =
fromDouble ((l+h)/2) +
fromDouble ((h-l) / realToFrac intRange) *
fromIntegral (x::Int)
in
(scaled_x, rng')
intRange :: Integer
intRange = toInteger (maxBound::Int) - toInteger (minBound::Int)
iLogBase :: Integer -> Integer -> Integer
iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b)
-- The global standard random number generator: ------------------------------
primitive getRandomSeed :: IO Integer
global_rng :: IORef StdGen
global_rng = unsafePerformIO (do seed <- getRandomSeed
newIORef (mkStdGen (toInt seed)))
setStdGen :: StdGen -> IO ()
setStdGen sgen = writeIORef global_rng sgen
getStdGen :: IO StdGen
getStdGen = readIORef global_rng
newStdGen :: IO StdGen
newStdGen = do rng <- getStdGen
let (a,b) = split rng
setStdGen a
return b
getStdRandom :: (StdGen -> (a,StdGen)) -> IO a
getStdRandom f = do rng <- getStdGen
let (v, new_rng) = f rng
setStdGen new_rng
return v
------------------------------------------------------------------------------
|
