module FRP.Netwire.Analyze
(
lAvg,
lGraph,
lGraphN,
sAvg,
sGraph,
sGraphN,
highPeak,
highPeakBy,
lowPeak,
lowPeakBy,
avgFps,
framerate
)
where
import Control.Wire
import qualified Data.Foldable as F
import qualified Data.Sequence as Seq
import qualified FRP.Netwire.Utils.Timeline as Tl
import Prelude hiding ((.), id)
avgFps ::
(RealFloat b, HasTime t s)
=> Int
-> Wire s e m a b
avgFps :: forall b t s e (m :: * -> *) a.
(RealFloat b, HasTime t s) =>
Int -> Wire s e m a b
avgFps Int
int | Int
int Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = [Char] -> Wire s e m a b
forall a. HasCallStack => [Char] -> a
error [Char]
"avgFps: Non-positive number of samples"
avgFps Int
int = Seq b -> Wire s e m a b
forall {s} {b} {e} {m :: * -> *} {a}.
HasTime b s =>
Seq b -> Wire s e m a b
loop Seq b
forall a. Seq a
Seq.empty
where
intf :: b
intf = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int
afps :: Seq b -> b
afps = (b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
intf) (b -> b) -> (Seq b -> b) -> Seq b -> b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b -> b -> b) -> b -> Seq b -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' b -> b -> b
forall a. Num a => a -> a -> a
(+) b
0
loop :: Seq b -> Wire s e m a b
loop Seq b
ss' =
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> a -> (b, Wire s e m a b)) -> Wire s e m a b)
-> (s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds a
_ ->
let fps :: b
fps = b -> b
forall a. Fractional a => a -> a
recip (b -> b) -> (s -> b) -> s -> b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (b -> b) -> (s -> b) -> s -> b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> b
forall t s. HasTime t s => s -> t
dtime (s -> b) -> s -> b
forall a b. (a -> b) -> a -> b
$ s
ds
ss :: Seq b
ss = Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
Seq.take Int
int (b
fps b -> Seq b -> Seq b
forall a. a -> Seq a -> Seq a
Seq.<| Seq b
ss')
in if b -> Bool
forall a. RealFloat a => a -> Bool
isInfinite b
fps
then (Seq b -> b
afps Seq b
ss', Seq b -> Wire s e m a b
loop Seq b
ss')
else Seq b
ss Seq b -> (b, Wire s e m a b) -> (b, Wire s e m a b)
`seq` (Seq b -> b
afps Seq b
ss, Seq b -> Wire s e m a b
loop Seq b
ss)
framerate ::
(Eq b, Fractional b, HasTime t s, Monoid e)
=> Wire s e m a b
framerate :: forall b t s e (m :: * -> *) a.
(Eq b, Fractional b, HasTime t s, Monoid e) =>
Wire s e m a b
framerate =
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b)
-> (s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
forall a b. (a -> b) -> a -> b
$ \s
ds a
_ ->
let dt :: b
dt = t -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (s -> t
forall t s. HasTime t s => s -> t
dtime s
ds)
in (if b
dt b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0 then e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty else b -> Either e b
forall a b. b -> Either a b
Right (b -> b
forall a. Fractional a => a -> a
recip b
dt), Wire s e m a b
forall b t s e (m :: * -> *) a.
(Eq b, Fractional b, HasTime t s, Monoid e) =>
Wire s e m a b
framerate)
highPeak :: (Ord a) => Wire s e m a a
highPeak :: forall a s e (m :: * -> *). Ord a => Wire s e m a a
highPeak = (a -> a -> Ordering) -> Wire s e m a a
forall a s e (m :: * -> *). (a -> a -> Ordering) -> Wire s e m a a
highPeakBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
highPeakBy :: (a -> a -> Ordering) -> Wire s e m a a
highPeakBy :: forall a s e (m :: * -> *). (a -> a -> Ordering) -> Wire s e m a a
highPeakBy = Ordering -> (a -> a -> Ordering) -> Wire s e m a a
forall o a s e (m :: * -> *).
Eq o =>
o -> (a -> a -> o) -> Wire s e m a a
peakBy Ordering
GT
lAvg ::
(Fractional a, Fractional t, HasTime t s)
=> t
-> Wire s e m a a
lAvg :: forall a t s e (m :: * -> *).
(Fractional a, Fractional t, HasTime t s) =>
t -> Wire s e m a a
lAvg t
int =
(s -> a -> (a, Wire s e m a a)) -> Wire s e m a a
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> a -> (a, Wire s e m a a)) -> Wire s e m a a)
-> (s -> a -> (a, Wire s e m a a)) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \s
ds a
x ->
let t :: t
t = s -> t
forall t s. HasTime t s => s -> t
dtime s
ds in
(a
x, t -> Timeline t a -> Wire s e m a a
forall {s} {b} {e} {m :: * -> *}.
(HasTime t s, Fractional b) =>
t -> Timeline t b -> Wire s e m b b
loop t
t (t -> a -> Timeline t a
forall t a. t -> a -> Timeline t a
Tl.singleton t
t a
x))
where
loop :: t -> Timeline t b -> Wire s e m b b
loop t
t' Timeline t b
tl' =
(s -> b -> (b, Wire s e m b b)) -> Wire s e m b b
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> b -> (b, Wire s e m b b)) -> Wire s e m b b)
-> (s -> b -> (b, Wire s e m b b)) -> Wire s e m b b
forall a b. (a -> b) -> a -> b
$ \s
ds b
x ->
let t :: t
t = t
t' t -> t -> t
forall a. Num a => a -> a -> a
+ s -> t
forall t s. HasTime t s => s -> t
dtime s
ds
t0 :: t
t0 = t
t t -> t -> t
forall a. Num a => a -> a -> a
- t
int
tl :: Timeline t b
tl = t -> Timeline t b -> Timeline t b
forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> Timeline t a
Tl.linCutL t
t0 (t -> b -> Timeline t b -> Timeline t b
forall t a. Ord t => t -> a -> Timeline t a -> Timeline t a
Tl.insert t
t b
x Timeline t b
tl')
a :: b
a = t -> t -> Timeline t b -> b
forall a t.
(Fractional a, Fractional t, Real t) =>
t -> t -> Timeline t a -> a
Tl.linAvg t
t0 t
t Timeline t b
tl
in (b
a, t -> Timeline t b -> Wire s e m b b
loop t
t Timeline t b
tl)
lGraph ::
(Fractional a, Fractional t, HasTime t s)
=> [t]
-> Wire s e m a [a]
lGraph :: forall a t s e (m :: * -> *).
(Fractional a, Fractional t, HasTime t s) =>
[t] -> Wire s e m a [a]
lGraph [t]
qts =
(s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a]
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a])
-> (s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a]
forall a b. (a -> b) -> a -> b
$ \s
ds a
x ->
let t :: t
t = s -> t
forall t s. HasTime t s => s -> t
dtime s
ds in
(a
x a -> [t] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [t]
qts, t -> Timeline t a -> Wire s e m a [a]
forall {s} {a} {e} {m :: * -> *}.
(HasTime t s, Fractional a) =>
t -> Timeline t a -> Wire s e m a [a]
loop t
t (t -> a -> Timeline t a
forall t a. t -> a -> Timeline t a
Tl.singleton t
t a
x))
where
earliest :: t
earliest = [t] -> t
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((t -> t) -> [t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map t -> t
forall a. Num a => a -> a
abs [t]
qts)
loop :: t -> Timeline t a -> Wire s e m a [a]
loop t
t' Timeline t a
tl' =
(s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a]
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a])
-> (s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a]
forall a b. (a -> b) -> a -> b
$ \s
ds a
x ->
let t :: t
t = t
t' t -> t -> t
forall a. Num a => a -> a -> a
+ s -> t
forall t s. HasTime t s => s -> t
dtime s
ds
tl :: Timeline t a
tl = t -> Timeline t a -> Timeline t a
forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> Timeline t a
Tl.linCutL (t
t t -> t -> t
forall a. Num a => a -> a -> a
- t
earliest) (t -> a -> Timeline t a -> Timeline t a
forall t a. Ord t => t -> a -> Timeline t a -> Timeline t a
Tl.insert t
t a
x Timeline t a
tl')
ps :: [a]
ps = (t -> a) -> [t] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\t
qt -> t -> Timeline t a -> a
forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> a
Tl.linLookup (t
t t -> t -> t
forall a. Num a => a -> a -> a
- t -> t
forall a. Num a => a -> a
abs t
qt) Timeline t a
tl) [t]
qts
in ([a]
ps, t -> Timeline t a -> Wire s e m a [a]
loop t
t Timeline t a
tl)
lGraphN ::
(Fractional a, Fractional t, HasTime t s)
=> t
-> Int
-> Wire s e m a [a]
lGraphN :: forall a t s e (m :: * -> *).
(Fractional a, Fractional t, HasTime t s) =>
t -> Int -> Wire s e m a [a]
lGraphN t
int Int
n
| t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [Char] -> Wire s e m a [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"lGraphN: Non-positive interval"
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> Wire s e m a [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"lGraphN: Non-positive number of data points"
lGraphN t
int Int
n =
let n1 :: Int
n1 = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
f :: a -> a
f a
qt = t -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac t
int a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
qt a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n1
in [t] -> Wire s e m a [a]
forall a t s e (m :: * -> *).
(Fractional a, Fractional t, HasTime t s) =>
[t] -> Wire s e m a [a]
lGraph ((Int -> t) -> [Int] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Int -> t
forall {a} {a}. (Fractional a, Integral a) => a -> a
f [Int
0..Int
n1])
lowPeak :: (Ord a) => Wire s e m a a
lowPeak :: forall a s e (m :: * -> *). Ord a => Wire s e m a a
lowPeak = (a -> a -> Ordering) -> Wire s e m a a
forall a s e (m :: * -> *). (a -> a -> Ordering) -> Wire s e m a a
lowPeakBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
lowPeakBy :: (a -> a -> Ordering) -> Wire s e m a a
lowPeakBy :: forall a s e (m :: * -> *). (a -> a -> Ordering) -> Wire s e m a a
lowPeakBy = Ordering -> (a -> a -> Ordering) -> Wire s e m a a
forall o a s e (m :: * -> *).
Eq o =>
o -> (a -> a -> o) -> Wire s e m a a
peakBy Ordering
LT
peakBy ::
(Eq o)
=> o
-> (a -> a -> o)
-> Wire s e m a a
peakBy :: forall o a s e (m :: * -> *).
Eq o =>
o -> (a -> a -> o) -> Wire s e m a a
peakBy o
o a -> a -> o
comp = (a -> (a, Wire s e m a a)) -> Wire s e m a a
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (a, Wire s e m a a)) -> Wire s e m a a)
-> (a -> (a, Wire s e m a a)) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a
x, a -> Wire s e m a a
forall {s} {e} {m :: * -> *}. a -> Wire s e m a a
loop a
x)
where
loop :: a -> Wire s e m a a
loop a
x' =
(a -> (a, Wire s e m a a)) -> Wire s e m a a
forall a b s e (m :: * -> *).
(a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSFN ((a -> (a, Wire s e m a a)) -> Wire s e m a a)
-> (a -> (a, Wire s e m a a)) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \a
x ->
a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a -> a) -> (a -> Wire s e m a a) -> a -> (a, Wire s e m a a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a -> Wire s e m a a
loop (a -> (a, Wire s e m a a)) -> a -> (a, Wire s e m a a)
forall a b. (a -> b) -> a -> b
$
if a -> a -> o
comp a
x a
x' o -> o -> Bool
forall a. Eq a => a -> a -> Bool
== o
o then a
x else a
x'
sAvg ::
(Fractional a, Fractional t, HasTime t s)
=> t
-> Wire s e m a a
sAvg :: forall a t s e (m :: * -> *).
(Fractional a, Fractional t, HasTime t s) =>
t -> Wire s e m a a
sAvg t
int =
(s -> a -> (a, Wire s e m a a)) -> Wire s e m a a
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> a -> (a, Wire s e m a a)) -> Wire s e m a a)
-> (s -> a -> (a, Wire s e m a a)) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \s
ds a
x ->
let t :: t
t = s -> t
forall t s. HasTime t s => s -> t
dtime s
ds in
(a
x, t -> Timeline t a -> Wire s e m a a
forall {s} {b} {e} {m :: * -> *}.
(HasTime t s, Fractional b) =>
t -> Timeline t b -> Wire s e m b b
loop t
t (t -> a -> Timeline t a
forall t a. t -> a -> Timeline t a
Tl.singleton t
t a
x))
where
loop :: t -> Timeline t b -> Wire s e m b b
loop t
t' Timeline t b
tl' =
(s -> b -> (b, Wire s e m b b)) -> Wire s e m b b
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> b -> (b, Wire s e m b b)) -> Wire s e m b b)
-> (s -> b -> (b, Wire s e m b b)) -> Wire s e m b b
forall a b. (a -> b) -> a -> b
$ \s
ds b
x ->
let t :: t
t = t
t' t -> t -> t
forall a. Num a => a -> a -> a
+ s -> t
forall t s. HasTime t s => s -> t
dtime s
ds
t0 :: t
t0 = t
t t -> t -> t
forall a. Num a => a -> a -> a
- t
int
tl :: Timeline t b
tl = t -> Timeline t b -> Timeline t b
forall t a. Ord t => t -> Timeline t a -> Timeline t a
Tl.scCutL t
t0 (t -> b -> Timeline t b -> Timeline t b
forall t a. Ord t => t -> a -> Timeline t a -> Timeline t a
Tl.insert t
t b
x Timeline t b
tl')
a :: b
a = t -> t -> Timeline t b -> b
forall a t. (Fractional a, Real t) => t -> t -> Timeline t a -> a
Tl.scAvg t
t0 t
t Timeline t b
tl
in (b
a, t -> Timeline t b -> Wire s e m b b
loop t
t Timeline t b
tl)
sGraph ::
(Fractional t, HasTime t s)
=> [t]
-> Wire s e m a [a]
sGraph :: forall t s e (m :: * -> *) a.
(Fractional t, HasTime t s) =>
[t] -> Wire s e m a [a]
sGraph [t]
qts =
(s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a]
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a])
-> (s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a]
forall a b. (a -> b) -> a -> b
$ \s
ds a
x ->
let t :: t
t = s -> t
forall t s. HasTime t s => s -> t
dtime s
ds in
(a
x a -> [t] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [t]
qts, t -> Timeline t a -> Wire s e m a [a]
forall {s} {a} {e} {m :: * -> *}.
HasTime t s =>
t -> Timeline t a -> Wire s e m a [a]
loop t
t (t -> a -> Timeline t a
forall t a. t -> a -> Timeline t a
Tl.singleton t
t a
x))
where
earliest :: t
earliest = [t] -> t
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((t -> t) -> [t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map t -> t
forall a. Num a => a -> a
abs [t]
qts)
loop :: t -> Timeline t a -> Wire s e m a [a]
loop t
t' Timeline t a
tl' =
(s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a]
forall s a b e (m :: * -> *).
Monoid s =>
(s -> a -> (b, Wire s e m a b)) -> Wire s e m a b
mkSF ((s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a])
-> (s -> a -> ([a], Wire s e m a [a])) -> Wire s e m a [a]
forall a b. (a -> b) -> a -> b
$ \s
ds a
x ->
let t :: t
t = t
t' t -> t -> t
forall a. Num a => a -> a -> a
+ s -> t
forall t s. HasTime t s => s -> t
dtime s
ds
tl :: Timeline t a
tl = t -> Timeline t a -> Timeline t a
forall t a. Ord t => t -> Timeline t a -> Timeline t a
Tl.scCutL (t
t t -> t -> t
forall a. Num a => a -> a -> a
- t
earliest) (t -> a -> Timeline t a -> Timeline t a
forall t a. Ord t => t -> a -> Timeline t a -> Timeline t a
Tl.insert t
t a
x Timeline t a
tl')
ps :: [a]
ps = (t -> a) -> [t] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\t
qt -> t -> Timeline t a -> a
forall t a. Ord t => t -> Timeline t a -> a
Tl.scLookup (t
t t -> t -> t
forall a. Num a => a -> a -> a
- t -> t
forall a. Num a => a -> a
abs t
qt) Timeline t a
tl) [t]
qts
in ([a]
ps, t -> Timeline t a -> Wire s e m a [a]
loop t
t Timeline t a
tl)
sGraphN ::
(Fractional t, HasTime t s)
=> t
-> Int
-> Wire s e m a [a]
sGraphN :: forall t s e (m :: * -> *) a.
(Fractional t, HasTime t s) =>
t -> Int -> Wire s e m a [a]
sGraphN t
int Int
n
| t
int t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [Char] -> Wire s e m a [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"sGraphN: Non-positive interval"
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> Wire s e m a [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"sGraphN: Non-positive number of data points"
sGraphN t
int Int
n =
let n1 :: Int
n1 = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
f :: a -> a
f a
qt = t -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac t
int a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
qt a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n1
in [t] -> Wire s e m a [a]
forall t s e (m :: * -> *) a.
(Fractional t, HasTime t s) =>
[t] -> Wire s e m a [a]
sGraph ((Int -> t) -> [Int] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Int -> t
forall {a} {a}. (Fractional a, Integral a) => a -> a
f [Int
0..Int
n1])