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