module Reflex.Dom.Contrib.Time (
poissonLossyFrom
, poissonLossy
, inhomogeneousPoissonFrom
, inhomogeneousPoisson
) where
import Reflex
import Reflex.Dom.Class
import Reflex.Dom.Time
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Data.Time.Clock
import System.Random
poissonLossyFrom
:: (RandomGen g, MonadWidget t m)
=> g
-> Double
-> UTCTime
-> Event t a
-> m (Event t TickInfo)
poissonLossyFrom rnd rate t0 t =
inhomogeneousPoissonFrom rnd (current $ constDyn rate) rate t0 t
poissonLossy
:: (RandomGen g, MonadWidget t m)
=> g
-> Double
-> UTCTime
-> m (Event t TickInfo)
poissonLossy rnd rate t0 = poissonLossyFrom rnd rate t0 =<< getPostBuild
inhomogeneousPoissonFrom
:: (RandomGen g, MonadWidget t m)
=> g
-> Behavior t Double
-> Double
-> UTCTime
-> Event t a
-> m (Event t TickInfo)
inhomogeneousPoissonFrom rnd rate maxRate t0 e = do
ticksWithRateRand <- performEventAsync $
fmap callAtNextInterval e
return $ attachWithMaybe filterFun rate ticksWithRateRand
where
filterFun :: Double -> (TickInfo, Double) -> Maybe TickInfo
filterFun r (tInfo, p)
| r >= p = Just tInfo
| otherwise = Nothing
callAtNextInterval _ cb = void $ liftIO $ forkIO $ go t0 rnd cb 0
go tTargetLast lastGen cb lastN = do
t <- getCurrentTime
let (u, nextGen) = randomR (0,1) lastGen
(p :: Double, nextGen') = randomR (0,maxRate) nextGen
let dt = realToFrac $ 1 * log(u)/maxRate :: NominalDiffTime
nEvents = lastN + 1
alreadyElapsed = diffUTCTime t tTargetLast
tTarget = addUTCTime dt tTargetLast
thisDelay = realToFrac $ diffUTCTime tTarget t :: Double
threadDelay $ ceiling $ thisDelay * 1000000
void $ cb $ (TickInfo t nEvents alreadyElapsed, p)
go tTarget nextGen' cb nEvents
inhomogeneousPoisson
:: (RandomGen g, MonadWidget t m)
=> g
-> Behavior t Double
-> Double
-> UTCTime
-> m (Event t TickInfo)
inhomogeneousPoisson rnd rate maxRate t0 =
inhomogeneousPoissonFrom rnd rate maxRate t0 =<< getPostBuild