```-- |
-- Module:     Control.Wire.Prefab.Analyze
-- Copyright:  (c) 2012 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Signal analysis wires.

module Control.Wire.Prefab.Analyze
( -- * Statistics
-- ** Average
avg,
avgInt,
avgAll,
avgFps,
avgFpsInt,
-- ** Peak
highPeak,
lowPeak,
peakBy,

-- * Monitoring
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)

-- | Calculate the average of the signal over the given number of last
-- samples.  If you need an average over all samples ever produced,
-- consider using 'avgAll' instead.
--
-- * Complexity: O(n) space wrt number of samples.
--
-- * Depends: current instant.

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

-- | Calculate the average of the input signal over all samples.  This
-- is usually not what you want.  In most cases the 'avg' wire is
-- preferable.
--
-- * Depends: current instant.

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)

-- | Calculate the average number of instants per second for the last
-- given number of instants.  In a continuous game or simulation this
-- corresponds to the average number of frames per second, hence the
-- name.
--
-- * Complexity:  O(n) space wrt number of samples.
--
-- * Depends: time.

avgFps :: (Monad m) => Int -> Wire e m a Double
avgFps n = recip (avg n) . dtime

-- | Like 'avgFps', but sample in discrete intervals only.  This can
-- greatly enhance the performance, when you have an inefficient clock
-- source.
--
-- * Complexity:  O(n) space wrt number of samples.
--
-- * Depends: time.

avgFpsInt ::
(Monad m)
=> Int  -- ^ Sampling interval.
-> Int  -- ^ Number of samples.
-> Wire e m a Double
avgFpsInt int n = recip (avgInt int n) . dtime

-- | Same as 'avg', but with a sampling interval.  This can be used to
-- increase the performance, if the input is complicated.
--
-- * Complexity: O(n) space wrt number of samples.
--
-- * Depends: current instant.

avgInt ::
forall a m e v.
(Fractional a, VectorSpace v, Scalar v ~ a)
=> Int  -- ^ Sampling interval.
-> Int  -- ^ Number of samples.
-> 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 all distinct inputs ever received together with a count.
-- Elements not appearing in the map have not been observed yet.
--
-- * Complexity: O(n) space.
--
-- * Depends: current instant.

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)

-- | Outputs the first local time the input was seen.
--
-- * Complexity: O(n) space, O(log n) time wrt number of samples so far.
--
-- * Depends: current instant, time.

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)

-- | High peak.
--
-- * Depends: current instant.

highPeak :: (Ord b) => Wire e m b b
highPeak = peakBy compare

-- | Outputs the local time the input was previously seen.
--
-- * Complexity: O(n) space, O(log n) time wrt number of samples so far.
--
-- * Depends: current instant, time.
--
-- * Inhibits: if this is the first time the input is seen.

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)

-- | Low peak.
--
-- * Depends: current instant.

lowPeak :: (Ord b) => Wire e m b b
lowPeak = peakBy (flip compare)

-- | Output the peak with respect to the given comparison function.
--
-- * Depends: current instant.

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)
```