module FRP.NetWire.Analyze
(
diff,
avg,
avgAll,
avgFps,
highPeak,
lowPeak,
peakBy,
)
where
import qualified Data.Vector.Unboxed.Mutable as V
import Control.DeepSeq
import Data.Vector.Unboxed.Mutable (IOVector, Unbox)
import FRP.NetWire.Wire
avg :: forall v. (Fractional v, NFData v, Unbox v) => Int -> Wire v v
avg n =
mkGen $ \_ x -> do
samples <- V.replicate n (x/d)
return (Just x, avg' samples x 0)
where
avg' :: IOVector v -> v -> Int -> Wire 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' <- V.read samples cur
V.write samples cur x
let s = s' x' + x
s `deepseq` return (Just s, avg' samples s cur)
d :: v
d = realToFrac n
avgAll :: forall v. (Fractional v, NFData v) => Wire v v
avgAll = mkGen $ \_ x -> return (Just x, avgAll' 1 x)
where
avgAll' :: v -> v -> Wire v v
avgAll' n' a' =
mkGen $ \_ x ->
let n = n' + 1
a = a' a'/n + x/n in
n `deepseq` a `deepseq` return (Just a, avgAll' n a)
avgFps :: forall a. Int -> Wire a Double
avgFps = avgFps' . avg
where
avgFps' :: Wire Double Double -> Wire a Double
avgFps' w' =
mkGen $ \ws@(wsDTime -> dt) _ -> do
(ma, w) <- toGen w' ws dt
return (fmap recip ma, avgFps' w)
diff :: forall a. Eq a => Wire a (Event (a, Time))
diff =
mkGen $ \(wsDTime -> dt) x' ->
return (Just Nothing, diff' dt x')
where
diff' :: Time -> a -> Wire a (Event (a, Time))
diff' t' x' =
mkGen $ \(wsDTime -> dt) x ->
let t = t' + dt in
if x' == x
then return (Just Nothing, diff' t x')
else return (Just (Just (x', t)), diff' 0 x)
highPeak :: (NFData a, Ord a) => Wire a a
highPeak = peakBy compare
lowPeak :: (NFData a, Ord a) => Wire a a
lowPeak = peakBy (flip compare)
peakBy :: forall a. NFData a => (a -> a -> Ordering) -> Wire a a
peakBy comp = mkGen $ \_ x -> return (Just x, peakBy' x)
where
peakBy' :: a -> Wire a a
peakBy' p' =
mkGen $ \_ x -> do
let p = if comp x p' == GT then x else p'
p `deepseq` return (Just p, peakBy' p)