@@ -1,3 +1,6 @@
1+{-# LANGUAGe ScopedTypeVariables #-}
2+{-# LANGUAGE TypeFamilies #-}
3+
14module Reflex.Dom.Time where
25
36import Reflex
@@ -78,6 +81,7 @@ poissonLossyFrom rnd rate t0 e = performEventAsync $ fmap callAtNextInterval e
7881 void $ cb $ TickInfo t n alreadyElapsed
7982 go nextGen cb
8083
84+
8185-- | Send events with Poisson timing with the given basis and rate
8286-- Each occurence of the resulting event will contain the index of
8387-- the current interval, with 0 representing the basis time.
@@ -91,3 +95,50 @@ poissonLossy
9195 -- ^ Baseline time for events
9296 -> m (Event t TickInfo)
9397poissonLossy rnd rate t0 = poissonLossyFrom rnd rate t0 =<< getPostBuild
98+
99+-- | Send events with inhomogeneous Poisson timing with the given basis
100+-- and variable rate. Provide a maxRate that you expect to support.
101+inhomogeneousPoissonFrom
102+ :: (RandomGen g, MonadWidget t m)
103+ => g
104+ -> Behavior t Double
105+ -> Double
106+ -> UTCTime
107+ -> Event t a
108+ -> m (Event t TickInfo)
109+inhomogeneousPoissonFrom rnd rate maxRate t0 e = do
110+ ticksWithRateRand <- performEventAsync $
111+ fmap callAtNextInterval e
112+ return $ attachWithMaybe filterFun rate ticksWithRateRand
113+
114+ where
115+
116+ filterFun :: Double -> (TickInfo, Double) -> Maybe TickInfo
117+ filterFun r (tInfo, p)
118+ | r >= p = Just tInfo
119+ | otherwise = Nothing
120+
121+ callAtNextInterval _ cb = void $ liftIO $ forkIO $ go rnd cb
122+
123+ go lastGen cb = do
124+ t <- getCurrentTime
125+ let (u, nextGen) = randomR (0,1) lastGen
126+ (p :: Double, nextGen') = randomR (0,maxRate) nextGen
127+ dt = realToFrac $ -1 * log(u)/maxRate :: NominalDiffTime
128+ offset = t `diffUTCTime` t0
129+ (n, alreadyElapsed) = offset `divMod'` dt
130+ threadDelay $ ceiling $ (dt - alreadyElapsed) * 1000000
131+ void $ cb $ (TickInfo t n alreadyElapsed, p)
132+ go nextGen' cb
133+
134+-- | Send events with inhomogeneous Poisson timing with the given basis
135+-- and variable rate. Provide a maxRate that you expect to support
136+inhomogeneousPoisson
137+ :: (RandomGen g, MonadWidget t m)
138+ => g
139+ -> Behavior t Double
140+ -> Double
141+ -> UTCTime
142+ -> m (Event t TickInfo)
143+inhomogeneousPoisson rnd rate maxRate t0 =
144+ inhomogeneousPoissonFrom rnd rate maxRate t0 =<< getPostBuild