The Haskell 98 Report
top | back | next | contents | function index

27  Random Numbers


module Random (
RandomGen(next, split, genRange),
StdGen, mkStdGen,
Random( random,   randomR, 
randoms,  randomRs,
randomIO, randomRIO ),
getStdRandom, getStdGen, setStdGen, newStdGen
  ) where

---------------- The RandomGen class ------------------------

class RandomGen g where
  genRange :: g -> (Int, Int)
  next     :: g -> (Int, g)
  split    :: g -> (g, g)

---------------- A standard instance of RandomGen -----------
data StdGen = ... -- Abstract

instance RandomGen StdGen where ...
instance Read     StdGen where ...
instance Show     StdGen where ...

mkStdGen :: Int -> StdGen

---------------- The Random class ---------------------------
class Random a where
   randomR :: RandomGen g => (a, a) -> g -> (a, g)
   random  :: RandomGen g => g -> (a, g)

   randomRs :: RandomGen g => (a, a) -> g -> [a]
   randoms  :: RandomGen g => g -> [a]

   randomRIO :: (a,a) -> IO a
   randomIO  :: IO a

instance Random Int     where ...
instance Random Integer where ...
instance Random Float   where ...
instance Random Double  where ...
instance Random Bool    where ...
instance Random Char    where ...

---------------- The global random generator ----------------
newStdGen    :: IO StdGen
setStdGen    :: StdGen -> IO ()
getStdGen    :: IO StdGen
getStdRandom :: (StdGen -> (a, StdGen)) -> IO a


The Random library deals with the common task of pseudo-random number generation. The library makes it possible to generate repeatable results, by starting with a specified initial random number generator; or to get different results on each run by using the system-initialised generator, or by supplying a seed from some other source.

The library is split into two layers:

27.1  The RandomGen class, and the StdGen generator

The class RandomGen provides a common interface to random number generators.

  class RandomGen g where
    genRange :: g -> (Int,Int)
    next     :: g  -> (Int, g)
    split    :: g -> (g, g)
  
    -- Default method
    genRange g = (minBound,maxBound)

The Random library provides one instance of RandomGen, the abstract data type StdGen:

  data StdGen = ... -- Abstract
  
  instance RandomGen StdGen where ...
  instance Read      StdGen where ...
  instance Show      StdGen where ...
  
  mkStdGen :: Int -> StdGen

The StgGen instance of RandomGen has a genRange of at least 30 bits.

The result of repeatedly using next should be at least as statistically robust as the "Minimal Standard Random Number Generator" described by [2,3]. Until more is known about implementations of split, all we require is that split deliver generators that are (a) not identical and (b) independently robust in the sense just given.

The Show/Read instances of StdGen provide a primitive way to save the state of a random number generator. It is required that read (show g) == g.

In addition, read may be used to map an arbitrary string (not necessarily one produced by show) onto a value of type StdGen. In general, the read instance of StdGen has the following properties:

The function mkStdGen provides an alternative way of producing an initial generator, by mapping an Int into a generator. Again, distinct arguments should be likely to produce distinct generators.

Programmers may, of course, supply their own instances of RandomGen.

Implementation warning. A superficially attractive implementation of split is

  instance RandomGen MyGen where
    ...
    split g = (g, variantOf g)

Here, split returns g itself and a new generator derived from g. But now consider these two apparently-independent generators:

  g1 = snd (split g)
  g2 = snd (split (fst (split g)))

If split genuinely delivers independent generators (as specified), then g1 and g2 should be independent, but in fact they are both equal to variantOf g. Implementations of the above form do not meet the specification.

27.2  The Random class

With a source of random number supply in hand, the Random class allows the programmer to extract random values of a variety of types:

class Random a where
   randomR :: RandomGen g => (a, a) -> g -> (a, g)
   random  :: RandomGen g => g -> (a, g)

   randomRs :: RandomGen g => (a, a) -> g -> [a]
   randoms  :: RandomGen g => g -> [a]

   randomRIO :: (a,a) -> IO a
   randomIO :: IO a

     -- Default methods
   randoms g = x : randoms g' 
   where 
     (x,g') = random g
   randomRs = ...similar...

   randomIO        = getStdRandom random
   randomRIO range = getStdRandom (randomR range)


instance Random Int     where ...
instance Random Integer where ...
instance Random Float   where ...
instance Random Double  where ...
instance Random Bool    where ...
instance Random Char    where ...

27.3  The global random number generator

There is a single, implicit, global random number generator of type StdGen, held in some global variable maintained by the IO monad. It is initialised automatically in some system-dependent fashion, for example, by using the time of day, or Linux's kernel random number generator. To get deterministic behaviour, use setStdGen.

  setStdGen    :: StdGen -> IO ()
  getStdGen    :: IO StdGen
  newStdGen    :: IO StdGen
  getStdRandom :: (StdGen -> (a, StdGen)) -> IO a

References

[1]
FW Burton and RL Page, "Distributed random number generation", Journal of Functional Programming, 2(2):203-212, April 1992.

[2]
SK Park, and KW Miller, "Random number generators - good ones are hard to find", Comm ACM 31(10), Oct 1988, pp1192-1201.

[3]
DG Carta, "Two fast implementations of the minimal standard random number generator", Comm ACM, 33(1), Jan 1990, pp87-88.

[4]
P Hellekalek, "Don't trust parallel Monte Carlo", ACM SIGSIM Simulation Digest 28(1), pp82-89, July 1998.

The Web site http://random.mat.sbg.ac.at/ is a great source of information.


The Haskell 98 Report
top | back | next | contents | function index
December 2002