-- |
-- Module     : Simulation.Aivika.Stream.Random
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- This module defines random streams of events, which are useful
-- for describing the input of the model.
--

module Simulation.Aivika.Stream.Random
       (-- * Stream of Random Events
        randomStream,
        randomUniformStream,
        randomUniformIntStream,
        randomTriangularStream,
        randomNormalStream,
        randomLogNormalStream,
        randomExponentialStream,
        randomErlangStream,
        randomPoissonStream,
        randomBinomialStream,
        randomGammaStream,
        randomBetaStream,
        randomWeibullStream,
        randomDiscreteStream) where

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika.Generator
import Simulation.Aivika.Parameter
import Simulation.Aivika.Parameter.Random
import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Event
import Simulation.Aivika.Process
import Simulation.Aivika.Processor
import Simulation.Aivika.Stream
import Simulation.Aivika.Statistics
import Simulation.Aivika.Ref
import Simulation.Aivika.Arrival

-- | Return a stream of random events that arrive with the specified delay.
randomStream :: Parameter (Double, a)
                -- ^ compute a pair of the delay and event of type @a@
                -> Stream (Arrival a)
                -- ^ a stream of delayed events
randomStream :: Parameter (Double, a) -> Stream (Arrival a)
randomStream Parameter (Double, a)
delay = Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a. Process (a, Stream a) -> Stream a
Cons (Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a))
-> Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a b. (a -> b) -> a -> b
$ Maybe Double -> Process (Arrival a, Stream (Arrival a))
loop Maybe Double
forall a. Maybe a
Nothing where
  loop :: Maybe Double -> Process (Arrival a, Stream (Arrival a))
loop Maybe Double
t0 =
    do Double
t1 <- Dynamics Double -> Process Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
       case Maybe Double
t0 of
         Maybe Double
Nothing -> () -> Process ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Just Double
t0 ->
           Bool -> Process () -> Process ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
t1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
t0) (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$
           [Char] -> Process ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> Process ()) -> [Char] -> Process ()
forall a b. (a -> b) -> a -> b
$
           [Char]
"The time of requesting for a new random event is different from " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
           [Char]
"the time when the previous event has arrived. Probably, your model " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
           [Char]
"contains a logical error. The random events should be requested permanently. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
           [Char]
"At least, they can be lost, for example, when trying to enqueue them, but " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
           [Char]
"the random stream itself must always work: randomStream."
       (Double
delay, a
a) <- Parameter (Double, a) -> Process (Double, a)
forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter (Double, a)
delay
       Bool -> Process () -> Process ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
delay Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0) (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$
         Double -> Process ()
holdProcess Double
delay
       Double
t2 <- Dynamics Double -> Process Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
       let arrival :: Arrival a
arrival = Arrival :: forall a. a -> Double -> Maybe Double -> Arrival a
Arrival { arrivalValue :: a
arrivalValue = a
a,
                               arrivalTime :: Double
arrivalTime  = Double
t2,
                               arrivalDelay :: Maybe Double
arrivalDelay =
                                 case Maybe Double
t0 of
                                   Maybe Double
Nothing -> Maybe Double
forall a. Maybe a
Nothing
                                   Just Double
t0 -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
delay }
       (Arrival a, Stream (Arrival a))
-> Process (Arrival a, Stream (Arrival a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Arrival a
arrival, Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a. Process (a, Stream a) -> Stream a
Cons (Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a))
-> Process (Arrival a, Stream (Arrival a)) -> Stream (Arrival a)
forall a b. (a -> b) -> a -> b
$ Maybe Double -> Process (Arrival a, Stream (Arrival a))
loop (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t2))

-- | Create a new stream with random delays distributed uniformly.
randomUniformStream :: Double
                       -- ^ the minimum delay
                       -> Double
                       -- ^ the maximum delay
                       -> Stream (Arrival Double)
                       -- ^ the stream of random events with the delays generated
randomUniformStream :: Double -> Double -> Stream (Arrival Double)
randomUniformStream Double
min Double
max =
  Parameter (Double, Double) -> Stream (Arrival Double)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Double) -> Stream (Arrival Double))
-> Parameter (Double, Double) -> Stream (Arrival Double)
forall a b. (a -> b) -> a -> b
$
  Double -> Double -> Parameter Double
randomUniform Double
min Double
max Parameter Double
-> (Double -> Parameter (Double, Double))
-> Parameter (Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x ->
  (Double, Double) -> Parameter (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
x)

-- | Create a new stream with integer random delays distributed uniformly.
randomUniformIntStream :: Int
                          -- ^ the minimum delay
                          -> Int
                          -- ^ the maximum delay
                          -> Stream (Arrival Int)
                          -- ^ the stream of random events with the delays generated
randomUniformIntStream :: Int -> Int -> Stream (Arrival Int)
randomUniformIntStream Int
min Int
max =
  Parameter (Double, Int) -> Stream (Arrival Int)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Int) -> Stream (Arrival Int))
-> Parameter (Double, Int) -> Stream (Arrival Int)
forall a b. (a -> b) -> a -> b
$
  Int -> Int -> Parameter Int
randomUniformInt Int
min Int
max Parameter Int
-> (Int -> Parameter (Double, Int)) -> Parameter (Double, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
x ->
  (Double, Int) -> Parameter (Double, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int
x)

-- | Create a new stream with random delays having the triangular distribution.
randomTriangularStream :: Double
                          -- ^ the minimum delay
                          -> Double
                          -- ^ the median of the delay
                          -> Double
                          -- ^ the maximum delay
                          -> Stream (Arrival Double)
                          -- ^ the stream of random events with the delays generated
randomTriangularStream :: Double -> Double -> Double -> Stream (Arrival Double)
randomTriangularStream Double
min Double
median Double
max =
  Parameter (Double, Double) -> Stream (Arrival Double)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Double) -> Stream (Arrival Double))
-> Parameter (Double, Double) -> Stream (Arrival Double)
forall a b. (a -> b) -> a -> b
$
  Double -> Double -> Double -> Parameter Double
randomTriangular Double
min Double
median Double
max Parameter Double
-> (Double -> Parameter (Double, Double))
-> Parameter (Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x ->
  (Double, Double) -> Parameter (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
x)

-- | Create a new stream with random delays distributed normally.
randomNormalStream :: Double
                      -- ^ the mean delay
                      -> Double
                      -- ^ the delay deviation
                      -> Stream (Arrival Double)
                      -- ^ the stream of random events with the delays generated
randomNormalStream :: Double -> Double -> Stream (Arrival Double)
randomNormalStream Double
mu Double
nu =
  Parameter (Double, Double) -> Stream (Arrival Double)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Double) -> Stream (Arrival Double))
-> Parameter (Double, Double) -> Stream (Arrival Double)
forall a b. (a -> b) -> a -> b
$
  Double -> Double -> Parameter Double
randomNormal Double
mu Double
nu Parameter Double
-> (Double -> Parameter (Double, Double))
-> Parameter (Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x ->
  (Double, Double) -> Parameter (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
x)

-- | Create a new stream with random delays having the lognormal distribution.
randomLogNormalStream :: Double
                         -- ^ the mean of a normal distribution which
                         -- this distribution is derived from
                         -> Double
                         -- ^ the deviation of a normal distribution which
                         -- this distribution is derived from
                         -> Stream (Arrival Double)
                         -- ^ the stream of random events with the delays generated
randomLogNormalStream :: Double -> Double -> Stream (Arrival Double)
randomLogNormalStream Double
mu Double
nu =
  Parameter (Double, Double) -> Stream (Arrival Double)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Double) -> Stream (Arrival Double))
-> Parameter (Double, Double) -> Stream (Arrival Double)
forall a b. (a -> b) -> a -> b
$
  Double -> Double -> Parameter Double
randomLogNormal Double
mu Double
nu Parameter Double
-> (Double -> Parameter (Double, Double))
-> Parameter (Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x ->
  (Double, Double) -> Parameter (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
x)

-- | Return a new stream with random delays distibuted exponentially with the specified mean
-- (the reciprocal of the rate).
randomExponentialStream :: Double
                           -- ^ the mean delay (the reciprocal of the rate)
                           -> Stream (Arrival Double)
                           -- ^ the stream of random events with the delays generated
randomExponentialStream :: Double -> Stream (Arrival Double)
randomExponentialStream Double
mu =
  Parameter (Double, Double) -> Stream (Arrival Double)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Double) -> Stream (Arrival Double))
-> Parameter (Double, Double) -> Stream (Arrival Double)
forall a b. (a -> b) -> a -> b
$
  Double -> Parameter Double
randomExponential Double
mu Parameter Double
-> (Double -> Parameter (Double, Double))
-> Parameter (Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x ->
  (Double, Double) -> Parameter (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
x)
         
-- | Return a new stream with random delays having the Erlang distribution with the specified
-- scale (the reciprocal of the rate) and shape parameters.
randomErlangStream :: Double
                      -- ^ the scale (the reciprocal of the rate)
                      -> Int
                      -- ^ the shape
                      -> Stream (Arrival Double)
                      -- ^ the stream of random events with the delays generated
randomErlangStream :: Double -> Int -> Stream (Arrival Double)
randomErlangStream Double
beta Int
m =
  Parameter (Double, Double) -> Stream (Arrival Double)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Double) -> Stream (Arrival Double))
-> Parameter (Double, Double) -> Stream (Arrival Double)
forall a b. (a -> b) -> a -> b
$
  Double -> Int -> Parameter Double
randomErlang Double
beta Int
m Parameter Double
-> (Double -> Parameter (Double, Double))
-> Parameter (Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x ->
  (Double, Double) -> Parameter (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
x)

-- | Return a new stream with random delays having the Poisson distribution with
-- the specified mean.
randomPoissonStream :: Double
                       -- ^ the mean delay
                       -> Stream (Arrival Int)
                       -- ^ the stream of random events with the delays generated
randomPoissonStream :: Double -> Stream (Arrival Int)
randomPoissonStream Double
mu =
  Parameter (Double, Int) -> Stream (Arrival Int)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Int) -> Stream (Arrival Int))
-> Parameter (Double, Int) -> Stream (Arrival Int)
forall a b. (a -> b) -> a -> b
$
  Double -> Parameter Int
randomPoisson Double
mu Parameter Int
-> (Int -> Parameter (Double, Int)) -> Parameter (Double, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
x ->
  (Double, Int) -> Parameter (Double, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int
x)

-- | Return a new stream with random delays having the binomial distribution with the specified
-- probability and trials.
randomBinomialStream :: Double
                        -- ^ the probability
                        -> Int
                        -- ^ the number of trials
                        -> Stream (Arrival Int)
                        -- ^ the stream of random events with the delays generated
randomBinomialStream :: Double -> Int -> Stream (Arrival Int)
randomBinomialStream Double
prob Int
trials =
  Parameter (Double, Int) -> Stream (Arrival Int)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Int) -> Stream (Arrival Int))
-> Parameter (Double, Int) -> Stream (Arrival Int)
forall a b. (a -> b) -> a -> b
$
  Double -> Int -> Parameter Int
randomBinomial Double
prob Int
trials Parameter Int
-> (Int -> Parameter (Double, Int)) -> Parameter (Double, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
x ->
  (Double, Int) -> Parameter (Double, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int
x)

-- | Return a new stream with random delays having the Gamma distribution by the specified
-- shape and scale.
randomGammaStream :: Double
                     -- ^ the shape
                     -> Double
                     -- ^ the scale (a reciprocal of the rate)
                     -> Stream (Arrival Double)
                     -- ^ the stream of random events with the delays generated
randomGammaStream :: Double -> Double -> Stream (Arrival Double)
randomGammaStream Double
kappa Double
theta =
  Parameter (Double, Double) -> Stream (Arrival Double)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Double) -> Stream (Arrival Double))
-> Parameter (Double, Double) -> Stream (Arrival Double)
forall a b. (a -> b) -> a -> b
$
  Double -> Double -> Parameter Double
randomGamma Double
kappa Double
theta Parameter Double
-> (Double -> Parameter (Double, Double))
-> Parameter (Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x ->
  (Double, Double) -> Parameter (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
x)

-- | Return a new stream with random delays having the Beta distribution by the specified
-- shape parameters (alpha and beta).
randomBetaStream :: Double
                    -- ^ the shape (alpha)
                    -> Double
                    -- ^ the shape (beta)
                    -> Stream (Arrival Double)
                    -- ^ the stream of random events with the delays generated
randomBetaStream :: Double -> Double -> Stream (Arrival Double)
randomBetaStream Double
alpha Double
beta =
  Parameter (Double, Double) -> Stream (Arrival Double)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Double) -> Stream (Arrival Double))
-> Parameter (Double, Double) -> Stream (Arrival Double)
forall a b. (a -> b) -> a -> b
$
  Double -> Double -> Parameter Double
randomBeta Double
alpha Double
beta Parameter Double
-> (Double -> Parameter (Double, Double))
-> Parameter (Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x ->
  (Double, Double) -> Parameter (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
x)

-- | Return a new stream with random delays having the Weibull distribution by the specified
-- shape and scale.
randomWeibullStream :: Double
                       -- ^ shape
                       -> Double
                       -- ^ scale
                       -> Stream (Arrival Double)
                       -- ^ the stream of random events with the delays generated
randomWeibullStream :: Double -> Double -> Stream (Arrival Double)
randomWeibullStream Double
alpha Double
beta =
  Parameter (Double, Double) -> Stream (Arrival Double)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Double) -> Stream (Arrival Double))
-> Parameter (Double, Double) -> Stream (Arrival Double)
forall a b. (a -> b) -> a -> b
$
  Double -> Double -> Parameter Double
randomWeibull Double
alpha Double
beta Parameter Double
-> (Double -> Parameter (Double, Double))
-> Parameter (Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x ->
  (Double, Double) -> Parameter (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
x)

-- | Return a new stream with random delays having the specified discrete distribution.
randomDiscreteStream :: DiscretePDF Double
                        -- ^ the discrete probability density function
                        -> Stream (Arrival Double)
                        -- ^ the stream of random events with the delays generated
randomDiscreteStream :: DiscretePDF Double -> Stream (Arrival Double)
randomDiscreteStream DiscretePDF Double
dpdf =
  Parameter (Double, Double) -> Stream (Arrival Double)
forall a. Parameter (Double, a) -> Stream (Arrival a)
randomStream (Parameter (Double, Double) -> Stream (Arrival Double))
-> Parameter (Double, Double) -> Stream (Arrival Double)
forall a b. (a -> b) -> a -> b
$
  DiscretePDF Double -> Parameter Double
forall a. DiscretePDF a -> Parameter a
randomDiscrete DiscretePDF Double
dpdf Parameter Double
-> (Double -> Parameter (Double, Double))
-> Parameter (Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x ->
  (Double, Double) -> Parameter (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
x)