module FRP.NetWire.Analyze
(
diff,
avg,
avgAll,
avgFps,
highPeak,
lowPeak,
peakBy,
)
where
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import Control.DeepSeq
import Control.Monad.ST
import FRP.NetWire.Wire
avg :: forall m v. (Fractional v, Monad m, NFData v, U.Unbox v) => Int -> Wire m v v
avg n = mkGen $ \_ x -> return (Right x, avg' (U.replicate n (x/d)) x 0)
where
avg' :: U.Vector v -> v -> Int -> Wire m v v
avg' samples' s' cur' =
mkGen $ \_ ((/d) -> x) -> do
let cur = let cur = succ cur' in if cur >= n then 0 else cur
x' = samples' U.! cur
samples =
x' `deepseq` runST $ do
s <- U.unsafeThaw samples'
UM.write s cur x
U.unsafeFreeze s
let s = s' x' + x
s' `deepseq` cur `seq` return (Right s, avg' samples s cur)
d :: v
d = realToFrac n
avgAll :: forall m v. (Fractional v, Monad m, NFData v) => Wire m v v
avgAll = mkGen $ \_ x -> return (Right x, avgAll' 1 x)
where
avgAll' :: v -> v -> Wire m v v
avgAll' n' a' =
mkGen $ \_ x ->
let n = n' + 1
a = a' a'/n + x/n in
n `deepseq` a' `deepseq` return (Right a, avgAll' n a)
avgFps :: forall a m. Monad m => Int -> Wire m a Double
avgFps = avgFps' . avg
where
avgFps' :: Wire m Double Double -> Wire m a Double
avgFps' w' =
mkGen $ \ws@(wsDTime -> dt) _ -> do
(ma, w) <- toGen w' ws dt
return (fmap recip ma, avgFps' w)
diff :: forall a m. (Eq a, Monad m) => Wire m a (a, Time)
diff =
mkGen $ \(wsDTime -> dt) x' ->
return (Left noEvent, diff' dt x')
where
diff' :: Time -> a -> Wire m a (a, Time)
diff' t' x' =
mkGen $ \(wsDTime -> dt) x ->
let t = t' + dt in
if x' == x
then return (Left noEvent, diff' t x')
else return (Right (x', t), diff' 0 x)
highPeak :: (Monad m, NFData a, Ord a) => Wire m a a
highPeak = peakBy compare
lowPeak :: (Monad m, NFData a, Ord a) => Wire m a a
lowPeak = peakBy (flip compare)
peakBy :: forall a m. (Monad m, NFData a) => (a -> a -> Ordering) -> Wire m a a
peakBy comp = mkGen $ \_ x -> return (Right x, peakBy' x)
where
peakBy' :: a -> Wire m a a
peakBy' p' =
mkGen $ \_ x -> do
let p = if comp x p' == GT then x else p'
p' `deepseq` return (Right p, peakBy' p)