-- |
-- Module      : FRP.BearRiver.Random
-- Copyright   : (c) Ivan Perez, 2014-2024
--               (c) George Giorgidze, 2007-2012
--               (c) Henrik Nilsson, 2005-2006
--               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
-- License     : BSD3
--
-- 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.BearRiver.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 (dunai)
import Control.Monad.Trans.MSF.Except (dSwitch)
import Control.Monad.Trans.MSF.Reader (readerS)
import Data.MonadicStreamFunction     (MSF, constM, feedback)

-- Internal imports
import FRP.BearRiver.Event        (Event (..))
import FRP.BearRiver.InternalCore (DTime, SF, Time, arr)

-- * 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, Monad m) => g -> SF m a b
noise :: forall g b (m :: * -> *) a.
(RandomGen g, Random b, Monad m) =>
g -> SF m a b
noise g
g0 = [b] -> SF m a b
forall (m :: * -> *) b a. Monad m => [b] -> SF m 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, Monad m) => (b, b) -> g -> SF m a b
noiseR :: forall g b (m :: * -> *) a.
(RandomGen g, Random b, Monad m) =>
(b, b) -> g -> SF m a b
noiseR (b, b)
range g
g0 = [b] -> SF m a b
forall (m :: * -> *) b a. Monad m => [b] -> SF m 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)

-- | Turn an infinite list of elements into an SF producing those elements. The
-- SF ignores its input.
streamToSF :: Monad m => [b] -> SF m a b
streamToSF :: forall (m :: * -> *) b a. Monad m => [b] -> SF m a b
streamToSF [b]
ls = [b] -> MSF (ClockInfo m) (a, [b]) (b, [b]) -> MSF (ClockInfo m) a b
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback [b]
ls (MSF (ClockInfo m) (a, [b]) (b, [b]) -> MSF (ClockInfo m) a b)
-> MSF (ClockInfo m) (a, [b]) (b, [b]) -> MSF (ClockInfo m) a b
forall a b. (a -> b) -> a -> b
$ ((a, [b]) -> (b, [b])) -> MSF (ClockInfo m) (a, [b]) (b, [b])
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((a, [b]) -> (b, [b])) -> MSF (ClockInfo m) (a, [b]) (b, [b]))
-> ((a, [b]) -> (b, [b])) -> MSF (ClockInfo m) (a, [b]) (b, [b])
forall a b. (a -> b) -> a -> b
$ [b] -> (b, [b])
forall {a}. [a] -> (a, [a])
fAux ([b] -> (b, [b])) -> ((a, [b]) -> [b]) -> (a, [b]) -> (b, [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [b]) -> [b]
forall a b. (a, b) -> b
snd
  where
    fAux :: [a] -> (a, [a])
fAux []     = [Char] -> (a, [a])
forall a. HasCallStack => [Char] -> a
error [Char]
"BearRiver: streamToSF: Empty list!"
    fAux (a
b:[a]
bs) = (a
b, [a]
bs)

-- | 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, Monad m) => g -> Time -> b -> SF m a (Event b)
occasionally :: forall g (m :: * -> *) b a.
(RandomGen g, Monad m) =>
g -> Time -> b -> SF m a (Event b)
occasionally g
g Time
tAvg b
x | Time
tAvg Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
0  = MSF (ReaderT Time m) a (Event b)
forall {a}. MSF (ReaderT Time m) a (Event b)
tf0
                      | Bool
otherwise = [Char] -> MSF (ReaderT Time m) a (Event b)
forall a. HasCallStack => [Char] -> a
error ([Char] -> MSF (ReaderT Time m) a (Event b))
-> [Char] -> MSF (ReaderT Time m) a (Event b)
forall a b. (a -> b) -> a -> b
$ [Char]
"BearRiver: occasionally: "
                                         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"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 :: MSF (ReaderT Time m) a (Event b)
tf0 = MSF (ReaderT Time m) a (Event b, Maybe ())
-> (() -> MSF (ReaderT Time m) a (Event b))
-> MSF (ReaderT Time m) a (Event b)
forall (m :: * -> *) a b c.
Monad m =>
MSF m a (b, Maybe c) -> (c -> MSF m a b) -> MSF m a b
dSwitch
            (ReaderT Time m (Event b, Maybe ())
-> MSF (ReaderT Time m) a (Event b, Maybe ())
forall (m :: * -> *) b a. Monad m => m b -> MSF m a b
constM (ReaderT Time m (Event b, Maybe ())
 -> MSF (ReaderT Time m) a (Event b, Maybe ()))
-> ReaderT Time m (Event b, Maybe ())
-> MSF (ReaderT Time m) a (Event b, Maybe ())
forall a b. (a -> b) -> a -> b
$ (Event b, Maybe ()) -> ReaderT Time m (Event b, Maybe ())
forall a. a -> ReaderT Time m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event b
forall a. Event a
NoEvent, () -> Maybe ()
forall a. a -> Maybe a
Just ()))
            (MSF (ReaderT Time m) a (Event b)
-> () -> MSF (ReaderT Time m) a (Event b)
forall a b. a -> b -> a
const (MSF (ReaderT Time m) a (Event b)
 -> () -> MSF (ReaderT Time m) a (Event b))
-> MSF (ReaderT Time m) a (Event b)
-> ()
-> MSF (ReaderT Time m) a (Event b)
forall a b. (a -> b) -> a -> b
$ [Time]
-> MSF (ReaderT Time m) (a, [Time]) (Event b, [Time])
-> MSF (ReaderT Time m) a (Event b)
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback (g -> [Time]
forall g. RandomGen g => g -> [Time]
forall a g. (Random a, RandomGen g) => g -> [a]
randoms g
g :: [Time]) (MSF (ReaderT Time m) (a, [Time]) (Event b, [Time])
 -> MSF (ReaderT Time m) a (Event b))
-> MSF (ReaderT Time m) (a, [Time]) (Event b, [Time])
-> MSF (ReaderT Time m) a (Event b)
forall a b. (a -> b) -> a -> b
$ MSF m (Time, (a, [Time])) (Event b, [Time])
-> MSF (ReaderT Time m) (a, [Time]) (Event b, [Time])
forall (m :: * -> *) r a b.
Monad m =>
MSF m (r, a) b -> MSF (ReaderT r m) a b
readerS (MSF m (Time, (a, [Time])) (Event b, [Time])
 -> MSF (ReaderT Time m) (a, [Time]) (Event b, [Time]))
-> MSF m (Time, (a, [Time])) (Event b, [Time])
-> MSF (ReaderT Time m) (a, [Time]) (Event b, [Time])
forall a b. (a -> b) -> a -> b
$ ((Time, (a, [Time])) -> (Event b, [Time]))
-> MSF m (Time, (a, [Time])) (Event b, [Time])
forall b c. (b -> c) -> MSF m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Time, (a, [Time])) -> (Event b, [Time])
forall {a}. (Time, (a, [Time])) -> (Event b, [Time])
occAux)

    -- occAux :: (DTime, (a, [Time])) -> (Event b, [Time])
    occAux :: (Time, (a, [Time])) -> (Event b, [Time])
occAux (Time
_, (a
_, []))    = [Char] -> (Event b, [Time])
forall a. HasCallStack => [Char] -> a
error [Char]
"BearRiver: occasionally: Empty list!"
    occAux (Time
dt, (a
_, Time
r:[Time]
rs)) =
        (if Time
r Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
p then b -> Event b
forall a. a -> Event a
Event b
x else Event b
forall a. Event a
NoEvent, [Time]
rs)
      where
        p :: Time
p = Time
1 Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time -> Time
forall a. Floating a => a -> a
exp (- (Time
dt Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
tAvg)) -- Probability for at least one event.