-- |
-- Module      : FRP.Yampa.Random
-- Copyright   : (c) Ivan Perez, 2014-2022
--               (c) George Giorgidze, 2007-2012
--               (c) Henrik Nilsson, 2005-2006
--               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
-- License     : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  : ivan.perez@keera.co.uk
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- Signals and signal functions with noise and randomness.
--
-- The Random number generators are re-exported from "System.Random".
module FRP.Yampa.Random
    (
      -- * Random number generators
      RandomGen(..)
    , Random(..)

      -- * Noise, random signals, and stochastic event sources
    , noise
    , noiseR
    , occasionally
    )
  where

-- External imports
import System.Random (Random (..), RandomGen (..))

-- Internal imports
import FRP.Yampa.Diagnostics  (intErr, usrErr)
import FRP.Yampa.Event        (Event (..))
import FRP.Yampa.InternalCore (SF (..), SF' (..), Time)

-- * Noise (i.e. random signal generators) and stochastic processes

-- | Noise (random signal) with default range for type in question; based on
-- "randoms".
noise :: (RandomGen g, Random b) => g -> SF a b
noise :: forall g b a. (RandomGen g, Random b) => g -> SF a b
noise g
g0 = [b] -> SF a b
forall b a. [b] -> SF a b
streamToSF (g -> [b]
forall g. RandomGen g => g -> [b]
forall a g. (Random a, RandomGen g) => g -> [a]
randoms g
g0)

-- | Noise (random signal) with specified range; based on "randomRs".
noiseR :: (RandomGen g, Random b) => (b, b) -> g -> SF a b
noiseR :: forall g b a. (RandomGen g, Random b) => (b, b) -> g -> SF a b
noiseR (b, b)
range g
g0 = [b] -> SF a b
forall b a. [b] -> SF a b
streamToSF ((b, b) -> g -> [b]
forall g. RandomGen g => (b, b) -> g -> [b]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (b, b)
range g
g0)

streamToSF :: [b] -> SF a b
streamToSF :: forall b a. [b] -> SF a b
streamToSF []     = String -> String -> String -> SF a b
forall a. String -> String -> String -> a
intErr String
"Yampa" String
"streamToSF" String
"Empty list!"
streamToSF (b
b:[b]
bs) = SF {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
forall {p} {a}. p -> (SF' a b, b)
tf0}
  where
    tf0 :: p -> (SF' a b, b)
tf0 p
_ = ([b] -> SF' a b
forall {b} {a}. [b] -> SF' a b
stsfAux [b]
bs, b
b)

    stsfAux :: [b] -> SF' a b
stsfAux []     = String -> String -> String -> SF' a b
forall a. String -> String -> String -> a
intErr String
"Yampa" String
"streamToSF" String
"Empty list!"
    -- Invarying since stsfAux [] is an error.
    stsfAux (b
b:[b]
bs) = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
forall {p} {p}. p -> p -> Transition a b
tf -- True
      where
        tf :: p -> p -> Transition a b
tf p
_ p
_ = ([b] -> SF' a b
stsfAux [b]
bs, b
b)

-- | Stochastic event source with events occurring on average once every tAvg
-- seconds. However, no more than one event results from any one sampling
-- interval in the case of relatively sparse sampling, thus avoiding an "event
-- backlog" should sampling become more frequent at some later point in time.
occasionally :: RandomGen g => g -> Time -> b -> SF a (Event b)
occasionally :: forall g b a. RandomGen g => g -> DTime -> b -> SF a (Event b)
occasionally g
g DTime
tAvg b
x | DTime
tAvg DTime -> DTime -> Bool
forall a. Ord a => a -> a -> Bool
> DTime
0 = SF {sfTF :: a -> Transition a (Event b)
sfTF = a -> Transition a (Event b)
forall {p} {a} {a}. p -> (SF' a (Event b), Event a)
tf0}
                      | Bool
otherwise = String -> String -> String -> SF a (Event b)
forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"occasionally"
                                           String
"Non-positive average interval."
  where
    -- Generally, if events occur with an average frequency of f, the
    -- probability of at least one event occurring in an interval of t is given
    -- by (1 - exp (-f*t)). The goal in the following is to decide whether at
    -- least one event occurred in the interval of size dt preceding the current
    -- sample point. For the first point, we can think of the preceding interval
    -- as being 0, implying no probability of an event occurring.

    tf0 :: p -> (SF' a (Event b), Event a)
tf0 p
_ = ([DTime] -> SF' a (Event b)
forall {a}. [DTime] -> SF' a (Event b)
occAux (g -> [DTime]
forall g. RandomGen g => g -> [DTime]
forall a g. (Random a, RandomGen g) => g -> [a]
randoms g
g :: [Time]), Event a
forall a. Event a
NoEvent)

    occAux :: [DTime] -> SF' a (Event b)
occAux []     = SF' a (Event b)
forall a. HasCallStack => a
undefined
    occAux (DTime
r:[DTime]
rs) = (DTime -> a -> Transition a (Event b)) -> SF' a (Event b)
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a (Event b)
forall {p}. DTime -> p -> Transition a (Event b)
tf -- True
      where
        tf :: DTime -> p -> Transition a (Event b)
tf DTime
dt p
_ = ([DTime] -> SF' a (Event b)
occAux [DTime]
rs, if DTime
r DTime -> DTime -> Bool
forall a. Ord a => a -> a -> Bool
< DTime
p then b -> Event b
forall a. a -> Event a
Event b
x else Event b
forall a. Event a
NoEvent)
          where
            p :: DTime
p = DTime
1 DTime -> DTime -> DTime
forall a. Num a => a -> a -> a
- DTime -> DTime
forall a. Floating a => a -> a
exp (- (DTime
dt DTime -> DTime -> DTime
forall a. Fractional a => a -> a -> a
/ DTime
tAvg)) -- Probability for at least one event.