module Control.Wire.Prefab.Analyze
(
avg,
avgAll,
avgFps,
avgFpsInt,
highPeak,
lowPeak,
peakBy,
collect,
diff,
firstSeen,
lastSeen
)
where
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Vector.Unboxed as Vu
import qualified Data.Vector.Unboxed.Mutable as Vum
import Control.Arrow
import Control.Monad.Fix
import Control.Monad.ST
import Control.Wire.Trans.Clock
import Control.Wire.Trans.Sample
import Control.Wire.Types
import Data.Map (Map)
import Data.Monoid
import Data.Set (Set)
avg ::
forall e v (>~).
(Fractional v, Vu.Unbox v, WirePure (>~))
=> Int
-> Wire e (>~) v v
avg n = mkPure $ \x -> (Right x, avg' (Vu.replicate n (x/d)) x 0)
where
avg' :: Vu.Vector v -> v -> Int -> Wire e (>~) v v
avg' samples' s' cur' =
mkPure $ \((/d) -> x) ->
let cur = let ncur = succ cur' in
if ncur >= n then 0 else ncur
x' = samples' Vu.! cur
samples =
x' `seq` runST $ do
sam <- Vu.unsafeThaw samples'
Vum.write sam cur x
Vu.unsafeFreeze sam
s = s' x' + x
in cur `seq` s' `seq` (Right s, avg' samples s cur)
d :: v
d = realToFrac n
avgAll :: forall e v (>~). (Fractional v, WirePure (>~)) => Wire e (>~) v v
avgAll = mkPure $ \x -> (Right x, avgAll' 1 x)
where
avgAll' :: v -> v -> Wire e (>~) v v
avgAll' n' a' =
mkPure $ \x ->
let n = n' + 1
a = a' a'/n + x/n
in a' `seq` (Right a, avgAll' n a)
avgFps ::
(Arrow (Wire e (>~)), Fractional t, Vu.Unbox t, WirePure (>~), WWithDT t (>~))
=> Int
-> Wire e (>~) a t
avgFps n = recip ^<< passDT (avg n)
avgFpsInt ::
(Arrow (Wire e (>~)), Fractional t, Vu.Unbox t, WirePure (>~), WSampleInt (>~), WWithDT t (>~))
=> Int
-> Int
-> Wire e (>~) a t
avgFpsInt int n =
proc x' ->
(| sampleInt ((* fromIntegral int) ^<< avgFps n -< x') |) int
collect :: forall b e (>~). (Ord b, WirePure (>~)) => Wire e (>~) b (Set b)
collect = collect' S.empty
where
collect' :: Set b -> Wire e (>~) b (Set b)
collect' ins' =
mkPure $ \x ->
let ins = S.insert x ins'
in (Right ins, collect' ins)
diff :: forall b e (>~). (Eq b, Monoid e, WirePure (>~)) => Wire e (>~) b b
diff = mkPure $ \x -> (Right x, diff' x)
where
diff' :: b -> Wire e (>~) b b
diff' x' =
mkPure $ \x ->
if x' == x
then (Left mempty, diff' x')
else (Right x', diff' x)
firstSeen ::
forall a e t (>~). (Ord a, WirePure (>~), WWithSysTime t (>~))
=> Wire e (>~) a t
firstSeen = withSysTime (firstSeen' M.empty)
where
firstSeen' :: Map a t -> Wire e (>~) (a, t) t
firstSeen' xs' =
fix $ \again ->
mkPure $ \(x, t) ->
case M.lookup x xs' of
Just xt -> (Right xt, again)
Nothing -> (Right t, firstSeen' (M.insert x t xs'))
highPeak :: (Ord b, WirePure (>~)) => Wire e (>~) b b
highPeak = peakBy compare
lastSeen ::
forall a e t (>~). (Monoid e, Ord a, WirePure (>~), WWithSysTime t (>~))
=> Wire e (>~) a t
lastSeen = withSysTime (lastSeen' M.empty)
where
lastSeen' :: Map a t -> Wire e (>~) (a, t) t
lastSeen' xs' =
mkPure $ \(x, t) ->
let xs = M.insert x t xs'
in (maybe (Left mempty) Right $ M.lookup x xs',
lastSeen' xs)
lowPeak :: (Ord b, WirePure (>~)) => Wire e (>~) b b
lowPeak = peakBy (flip compare)
peakBy ::
forall b e (>~). WirePure (>~)
=> (b -> b -> Ordering)
-> Wire e (>~) b b
peakBy comp = mkPure (Right &&& peakBy')
where
peakBy' :: b -> Wire e (>~) b b
peakBy' x'' =
mkPure $ \x' ->
Right &&& peakBy' $ if comp x' x'' == GT then x' else x''