module Control.Wire.Prefab.Analyze
(
avg,
avgInt,
avgAll,
avgFps,
avgFpsInt,
highPeak,
lowPeak,
peakBy,
collect,
firstSeen,
lastSeen
)
where
import qualified Data.Map as M
import qualified Data.Sequence as Seq
import Control.Category
import Control.Wire.Prefab.Time
import Control.Wire.Wire
import Data.Map (Map)
import Data.Monoid
import Data.Sequence (Seq, ViewL(..), (|>), viewl)
import Data.VectorSpace
import Prelude hiding ((.), id)
avg ::
forall a m e v.
(Fractional a, VectorSpace v, Scalar v ~ a)
=> Int
-> Wire e m v v
avg n | n <= 0 = error "avg: The number of samples must be positive"
avg n =
mkPure $ \_ x ->
(Right x, avg' (Seq.replicate n (x ^/ d)) x)
where
avg' :: Seq v -> v -> Wire e m v v
avg' samples'' a' =
mkPure $ \_ x ->
let xa = x ^/ d
xa' :< samples' = viewl samples''
samples = samples' |> xa
a = a' ^-^ xa' ^+^ xa
in a `seq` (Right a, avg' samples a)
d :: Scalar v
d = realToFrac n
avgAll ::
forall a m e v.
(Fractional a, VectorSpace v, Scalar v ~ a)
=> Wire e m v v
avgAll = mkPure $ \_ x -> (Right x, avgAll' 1 x)
where
avgAll' :: a -> v -> Wire e m v v
avgAll' n' a' =
mkPure $ \_ x ->
let n = n' + 1
a = a' ^+^ (x ^-^ a') ^/ n
in a' `seq` (Right a, avgAll' n a)
avgFps :: (Monad m) => Int -> Wire e m a Double
avgFps n = recip (avg n) . dtime
avgFpsInt ::
(Monad m)
=> Int
-> Int
-> Wire e m a Double
avgFpsInt int n = recip (avgInt int n) . dtime
avgInt ::
forall a m e v.
(Fractional a, VectorSpace v, Scalar v ~ a)
=> Int
-> Int
-> Wire e m v v
avgInt _ n | n <= 0 = error "avg: The number of samples must be positive"
avgInt int n =
mkPure $ \_ x ->
(Right x, avg' 0 (Seq.replicate n (x ^/ d)) x)
where
avg' :: Int -> Seq v -> v -> Wire e m v v
avg' si samples'' a' | si < int = mkPure $ \_ _ -> (Right a', avg' (si + 1) samples'' a')
avg' _ samples'' a' =
mkPure $ \_ x ->
let xa = x ^/ d
xa' :< samples' = viewl samples''
samples = samples' |> xa
a = a' ^-^ xa' ^+^ xa
in a `seq` (Right a, avg' 0 samples a)
d :: Scalar v
d = realToFrac n
collect :: forall b m e. (Ord b) => Wire e m b (Map b Int)
collect = collect' M.empty
where
collect' :: Map b Int -> Wire e m b (Map b Int)
collect' m' =
mkPure $ \_ x ->
let m = M.insertWith (+) x 1 m' in
m `seq` (Right m, collect' m)
firstSeen :: forall a m e. (Ord a) => Wire e m a Time
firstSeen = seen' 0 M.empty
where
seen' :: Time -> Map a Time -> Wire e m a Time
seen' t' m' =
mkPure $ \dt x ->
let t = t' + dt in
t `seq`
case M.lookup x m' of
Just xt -> (Right xt, seen' t m')
Nothing ->
let m = M.insert x t m' in
m `seq` (Right t, seen' t m)
highPeak :: (Ord b) => Wire e m b b
highPeak = peakBy compare
lastSeen :: forall a m e. (Monoid e, Ord a) => Wire e m a Time
lastSeen = seen' 0 M.empty
where
seen' :: Time -> Map a Time -> Wire e m a Time
seen' t' m' =
mkPure $ \dt x ->
let t = t' + dt
m = M.insert x t m' in
t `seq` m `seq`
case M.lookup x m' of
Just xt -> (Right xt, seen' t m)
Nothing -> (Left mempty, seen' t m)
lowPeak :: (Ord b) => Wire e m b b
lowPeak = peakBy (flip compare)
peakBy :: forall b m e. (b -> b -> Ordering) -> Wire e m b b
peakBy f = mkPure $ \_ x -> (Right x, peak' x)
where
peak' :: b -> Wire e m b b
peak' x' =
mkPure $ \_ x ->
case f x' x of
GT -> (Right x', peak' x')
_ -> (Right x, peak' x)