ghc/lib/std/Random.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-99
   3 %
   4
   5
   6 The June 1988 (v31 #6) issue of the Communications of the ACM has an
   7 article by Pierre L'Ecuyer called, "Efficient and Portable Combined
   8 Random Number Generators".  Here is the Portable Combined Generator of
   9 L'Ecuyer for 32-bit computers.  It has a period of roughly 2.30584e18.
  10
  11 Transliterator: Lennart Augustsson
  12
  13 sof 1/99 - code brought (kicking and screaming) into the new Random
  14 world..
  15
  16 \begin{code}
  17 module Random
  18         (
  19           RandomGen(next, split)
  20         , StdGen
  21         , mkStdGen
  22         , Random ( random,   randomR,
  23                    randoms,  randomRs,
  24                    randomIO, randomRIO )
  25         , getStdRandom
  26         , getStdGen
  27         , setStdGen
  28         , newStdGen
  29         ) where
  30
  31 import CPUTime (getCPUTime)
  32 import PrelST
  33 import PrelRead
  34 import PrelShow
  35 import PrelIOBase
  36 import PrelNumExtra ( float2Double, double2Float )
  37 import PrelBase
  38 import PrelArr
  39 import Char ( isSpace, chr, ord )
  40 import Time (getClockTime, ClockTime(..))
  41
  42 \end{code}
  43
  44 \begin{code}
  45 class RandomGen g where
  46    next  :: g -> (Int, g)
  47    split :: g -> (g, g)
  48
  49 \end{code}
  50
  51 \begin{code}
  52 data StdGen
  53  = StdGen Int Int
  54
  55 instance RandomGen StdGen where
  56   next  = stdNext
  57   split = stdSplit
  58
  59 instance Show StdGen where
  60   showsPrec p (StdGen s1 s2) =
  61      showSignedInt p s1 .
  62      showSpace          .
  63      showSignedInt p s2
  64
  65 instance Read StdGen where
  66   readsPrec _p = \ r ->
  67      case try_read r of
  68        r@[_] -> r
  69        _   -> [stdFromString r] -- because it shouldn't ever fail.
  70     where
  71       try_read r = do
  72          (s1, r1) <- readDec (dropWhile isSpace r)
  73          (s2, r2) <- readDec (dropWhile isSpace r1)
  74          return (StdGen s1 s2, r2)
  75
  76 {-
  77  If we cannot unravel the StdGen from a string, create
  78  one based on the string given.
  79 -}
  80 stdFromString         :: String -> (StdGen, String)
  81 stdFromString s        = (mkStdGen num, rest)
  82         where (cs, rest) = splitAt 6 s
  83               num        = foldl (\a x -> x + 3 * a) 1 (map ord cs)
  84 \end{code}
  85
  86 \begin{code}
  87 mkStdGen :: Int -> StdGen -- why not Integer ?
  88 mkStdGen s
  89  | s < 0     = mkStdGen (-s)
  90  | otherwise = StdGen (s1+1) (s2+1)
  91       where
  92         (q, s1) = s `divMod` 2147483562
  93         s2      = q `mod` 2147483398
  94
  95 createStdGen :: Integer -> StdGen
  96 createStdGen s
  97  | s < 0     = createStdGen (-s)
  98  | otherwise = StdGen (toInt (s1+1)) (toInt (s2+1))
  99       where
 100         (q, s1) = s `divMod` 2147483562
 101         s2      = q `mod` 2147483398
 102
 103 \end{code}
 104
 105 The class definition - see library report for details.
 106
 107 \begin{code}
 108 class Random a where
 109   -- Minimal complete definition: random and randomR
 110   random  :: RandomGen g => g -> (a, g)
 111   randomR :: RandomGen g => (a,a) -> g -> (a,g)
 112
 113   randoms  :: RandomGen g => g -> [a]
 114   randoms  g      = x : randoms g' where (x,g') = random g
 115
 116   randomRs :: RandomGen g => (a,a) -> g -> [a]
 117   randomRs ival g = x : randomRs ival g' where (x,g') = randomR ival g
 118
 119   randomIO  :: IO a
 120   randomIO         = getStdRandom random
 121
 122   randomRIO :: (a,a) -> IO a
 123   randomRIO range  = getStdRandom (randomR range)
 124 \end{code}
 125
 126 \begin{code}
 127 instance Random Int where
 128   randomR (a,b) g = randomIvalInteger (toInteger a, toInteger b) g
 129   random g        = randomR (minBound,maxBound) g
 130
 131 instance Random Char where
 132   randomR (a,b) g =
 133       case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of
 134         (x,g) -> (chr x, g)
 135   random g        = randomR (minBound,maxBound) g
 136
 137 instance Random Bool where
 138   randomR (a,b) g =
 139       case (randomIvalInteger (toInteger (bool2Int a), toInteger (bool2Int b)) g) of
 140         (x, g) -> (int2Bool x, g)
 141        where
 142          bool2Int False = 0
 143          bool2Int True  = 1
 144
 145          int2Bool 0     = False
 146          int2Bool _     = True
 147
 148   random g        = randomR (minBound,maxBound) g
 149
 150 instance Random Integer where
 151   randomR ival g = randomIvalInteger ival g
 152   random g       = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g
 153
 154 instance Random Double where
 155   randomR ival g = randomIvalDouble ival id g
 156   random g       = randomR (0::Double,1) g
 157
 158 -- hah, so you thought you were saving cycles by using Float?
 159 instance Random Float where
 160   randomR (a,b) g = randomIvalDouble (float2Double a, float2Double b) double2Float g
 161   random g        = randomIvalDouble (0::Double,1) double2Float g
 162
 163 \end{code}
 164
 165
 166 \begin{code}
 167 mkStdRNG :: Integer -> IO StdGen
 168 mkStdRNG o = do
 169     ct          <- getCPUTime
 170     (TOD sec _) <- getClockTime
 171     return (createStdGen (sec * 12345 + ct + o))
 172
 173 randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)
 174 randomIvalInteger (l,h) rng
 175  | l > h     = randomIvalInteger (h,l) rng
 176  | otherwise = case (f n 1 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng')
 177      where
 178        k = h - l + 1
 179        b = 2147483561
 180        n = iLogBase b k
 181
 182        f 0 acc g = (acc, g)
 183        f n acc g =
 184           let
 185            (x,g')   = next g
 186           in
 187           f (n-1) (fromInt x + acc * b) g'
 188
 189 randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g)
 190 randomIvalDouble (l,h) fromDouble rng
 191   | l > h     = randomIvalDouble (h,l) fromDouble rng
 192   | otherwise =
 193        case (randomIvalInteger (toInteger (minBound::Int), toInteger (maxBound::Int)) rng) of
 194          (x, rng') ->
 195             let
 196              scaled_x =
 197                 fromDouble ((l+h)/2) +
 198                 fromDouble ((h-l) / realToFrac intRange) *
 199                 fromIntegral (x::Int)
 200             in
 201             (scaled_x, rng')
 202
 203 intRange :: Integer
 204 intRange  = toInteger (maxBound::Int) - toInteger (minBound::Int)
 205
 206 iLogBase :: Integer -> Integer -> Integer
 207 iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b)
 208
 209 stdNext :: StdGen -> (Int, StdGen)
 210 stdNext (StdGen s1 s2) = (z', StdGen s1'' s2'')
 211         where   z'   = if z < 1 then z + 2147483562 else z
 212                 z    = s1'' - s2''
 213
 214                 k    = s1 `quot` 53668
 215                 s1'  = 40014 * (s1 - k * 53668) - k * 12211
 216                 s1'' = if s1' < 0 then s1' + 2147483563 else s1'
 217
 218                 k'   = s2 `quot` 52774
 219                 s2'  = 40692 * (s2 - k' * 52774) - k' * 3791
 220                 s2'' = if s2' < 0 then s2' + 2147483399 else s2'
 221
 222 stdSplit :: StdGen -> (StdGen, StdGen)
 223 stdSplit std@(StdGen s1 _) = (std, unsafePerformIO (mkStdRNG (fromInt s1)))
 224
 225 \end{code}
 226
 227
 228 \begin{code}
 229 global_rng :: MutableVar RealWorld StdGen
 230 global_rng = unsafePerformIO $ do
 231    rng <- mkStdRNG 0
 232    stToIO (newVar rng)
 233
 234 setStdGen :: StdGen -> IO ()
 235 setStdGen sgen = stToIO (writeVar global_rng sgen)
 236
 237 getStdGen :: IO StdGen
 238 getStdGen = stToIO (readVar global_rng)
 239
 240 newStdGen :: IO StdGen
 241 newStdGen = do
 242   rng <- getStdGen
 243   let (a,b) = split rng
 244   setStdGen a
 245   return b
 246
 247 getStdRandom :: (StdGen -> (a,StdGen)) -> IO a
 248 getStdRandom f = do
 249    rng          <- getStdGen
 250    let (v, new_rng) = f rng
 251    setStdGen new_rng
 252    return v
 253 \end{code}