-- | -- Module: FRP.NetWire.Analyze -- Copyright: (c) 2011 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez <es@ertes.de> -- -- Signal analysis. module FRP.NetWire.Analyze ( -- * Changes diff, -- * Statistics -- ** Average avg, avgAll, avgFps, -- ** Misc collect, lastSeen, -- ** Peak highPeak, lowPeak, peakBy ) where import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as UM import Control.DeepSeq import Control.Monad.ST import Data.Map (Map) import Data.Set (Set) import FRP.NetWire.Wire -- | Calculate the average of the signal over the given number of last -- samples. This wire has O(n) space complexity and O(1) time -- complexity. -- -- If you need an average over all samples ever produced, consider using -- 'avgAll' instead. -- -- Never inhibits. Feedback by delay. 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 -- | Calculate the average of the signal over all samples. -- -- Please note that somewhat surprisingly this wire runs in constant -- space and is generally faster than 'avg', but most applications will -- benefit from averages over only the last few samples. -- -- Never inhibits. Feedback by delay. 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) -- | Calculate the average number of frames per virtual second for the -- last given number of frames. -- -- Please note that this wire uses the clock, which you give the network -- using the stepping functions in "FRP.NetWire.Session". If this clock -- doesn't represent real time, then the output of this wire won't -- either. -- -- Never inhibits. 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) -- | Collects all the inputs ever received. This wire uses O(n) memory -- and runs in O(log n) time, where n is the number of inputs collected -- so far. -- -- Never inhibits. Feedback by delay. collect :: forall a m. (Ord a, Monad m) => Wire m a (Set a) collect = collect' S.empty where collect' :: Set a -> Wire m a (Set a) collect' s' = mkGen $ \_ x -> let s = S.insert x s' in s `seq` return (Right s, collect' s) -- | Emits an event, whenever the input signal changes. The event -- contains the last input value and the time elapsed since the last -- change. -- -- Inhibits on no change. 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) -- | Return the high peak. -- -- Never inhibits. Feedback by delay. highPeak :: (Monad m, NFData a, Ord a) => Wire m a a highPeak = peakBy compare -- | Returns the time delta between now and when the input signal was -- last seen. This wire uses O(n) memory and runs in O(log n) time, -- where n is the number of inputs collected so far. -- -- Inhibits, when a signal is seen for the first time. lastSeen :: forall a m. (Ord a, Monad m) => Wire m a Time lastSeen = lastSeen' M.empty 0 where lastSeen' :: Map a Time -> Time -> Wire m a Time lastSeen' tm' t' = mkGen $ \(wsDTime -> dt) x -> do let t = t' + dt let mx = case M.lookup x tm' of Nothing -> Left (inhibitEx "Signal seen for the first time") Just lt -> Right (t - lt) let tm = t `seq` M.insert x t tm' tm `seq` return (mx, lastSeen' tm t) -- | Return the low peak. -- -- Never inhibits. Feedback by delay. lowPeak :: (Monad m, NFData a, Ord a) => Wire m a a lowPeak = peakBy (flip compare) -- | Return the high peak with the given comparison function. -- -- Never inhibits. Feedback by delay. 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)