git.iko.soy/reflex-dom
on develop help sign in
add inhomogeneous version
2c128d2Greg Hale
src/Reflex/Dom/Time.hs+51
compare with develop
unifiedsplit
@@ -1,3 +1,6 @@
1+{-# LANGUAGe ScopedTypeVariables #-}
2+{-# LANGUAGE TypeFamilies #-}
3+
1module Reflex.Dom.Time where
4module Reflex.Dom.Time where
2
5
3import Reflex
6import Reflex
@@ -78,6 +81,7 @@ poissonLossyFrom rnd rate t0 e = performEventAsync $ fmap callAtNextInterval e
78 void $ cb $ TickInfo t n alreadyElapsed
81 void $ cb $ TickInfo t n alreadyElapsed
79 go nextGen cb
82 go nextGen cb
80
83
84+
81-- | Send events with Poisson timing with the given basis and rate
85-- | Send events with Poisson timing with the given basis and rate
82-- Each occurence of the resulting event will contain the index of
86-- Each occurence of the resulting event will contain the index of
83-- the current interval, with 0 representing the basis time.
87-- the current interval, with 0 representing the basis time.
@@ -91,3 +95,50 @@ poissonLossy
91 -- ^ Baseline time for events
95 -- ^ Baseline time for events
92 -> m (Event t TickInfo)
96 -> m (Event t TickInfo)
93poissonLossy rnd rate t0 = poissonLossyFrom rnd rate t0 =<< getPostBuild
97poissonLossy 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