-------------------------------------------------------------------------
-- 
--  Haskell: The Craft of Functional Programming, 3e
--  Simon Thompson
--  (c) Addison-Wesley, 1996-2011.
--
--  Random number generation.
--
-------------------------------------------------------------------------

-- Lazy programming
-- ^^^^^^^^^^^^^^^^

module RandomGen where


-- Find the next (pseudo-)random number in the sequence.

nextRand :: Int -> Int
nextRand :: Int -> Int
nextRand Int
n = (Int
multiplierInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
increment) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
modulus

-- A (pseudo-)random sequence is given by iterating this function,

randomSequence :: Int -> [Int]
randomSequence :: Int -> [Int]
randomSequence = (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate Int -> Int
nextRand

-- Suitable values for the constants.

seed, multiplier, increment, modulus :: Int
seed :: Int
seed       = Int
17489
multiplier :: Int
multiplier = Int
25173
increment :: Int
increment  = Int
13849
modulus :: Int
modulus    = Int
65536

-- Scaling the numbers to come in the (integer) range a to b (inclusive).

scaleSequence :: Int -> Int -> [Int] -> [Int]
scaleSequence :: Int -> Int -> [Int] -> [Int]
scaleSequence Int
s Int
t
  = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
scale
    where
    scale :: Int -> Int
scale Int
n = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
denom Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s
    range :: Int
range   = Int
tInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
    denom :: Int
denom   = Int
modulus Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
range

-- Turn a distribution into a function.

makeFunction :: [(a,Double)] -> (Double -> a)

makeFunction :: forall a. [(a, Double)] -> Double -> a
makeFunction [(a, Double)]
dist = [(a, Double)] -> Double -> Double -> a
forall {t} {a}. (Ord t, Num t) => [(a, t)] -> t -> t -> a
makeFun [(a, Double)]
dist Double
0.0

makeFun :: [(a, t)] -> t -> t -> a
makeFun ((a
ob,t
p):[(a, t)]
dist) t
nLast t
rand
  | t
nNext t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
rand Bool -> Bool -> Bool
&& t
rand t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
nLast     
        = a
ob
  | Bool
otherwise                           
        = [(a, t)] -> t -> t -> a
makeFun [(a, t)]
dist t
nNext t
rand
          where
          nNext :: t
nNext = t
pt -> t -> t
forall a. Num a => a -> a -> a
*Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
modulus t -> t -> t
forall a. Num a => a -> a -> a
+ t
nLast

-- Random numbers from 1 to 6 according to the example distribution, dist.

randomTimes :: [Int]
randomTimes :: [Int]
randomTimes = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, Double)] -> Double -> Int
forall a. [(a, Double)] -> Double -> a
makeFunction [(Int, Double)]
dist (Double -> Int) -> (Int -> Double) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Int -> [Int]
randomSequence Int
seed)

-- The distribution in question


dist :: [(Int,Double)]
dist :: [(Int, Double)]
dist = [(Int
1,Double
0.2), (Int
2,Double
0.25), (Int
3,Double
0.25), (Int
4,Double
0.15), (Int
5,Double
0.1), (Int
6,Double
0.05)]