-- |
-- Module:     FRP.Netwire.Utils.Timeline
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>

{-# LANGUAGE DeriveDataTypeable #-}

module FRP.Netwire.Utils.Timeline
    ( -- * Time lines for statistics wires
      Timeline,

      -- * Constructing time lines
      insert,
      singleton,
      union,

      -- * Linear sampling
      linAvg,
      linCutL,
      linCutR,
      linLookup,

      -- * Staircase sampling
      scAvg,
      scCutL,
      scCutR,
      scLookup
    )
    where

import Control.Applicative
import Data.Data
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M


-- | A time line is a non-empty set of samples together with time
-- information.

newtype Timeline t a =
    Timeline {
      forall t a. Timeline t a -> Map t a
timeline :: Map t a
    }
    deriving (Typeable (Timeline t a)
Typeable (Timeline t a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Timeline t a -> c (Timeline t a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Timeline t a))
-> (Timeline t a -> Constr)
-> (Timeline t a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Timeline t a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Timeline t a)))
-> ((forall b. Data b => b -> b) -> Timeline t a -> Timeline t a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Timeline t a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Timeline t a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Timeline t a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Timeline t a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a))
-> Data (Timeline t a)
Timeline t a -> Constr
Timeline t a -> DataType
(forall b. Data b => b -> b) -> Timeline t a -> Timeline t a
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Timeline t a -> u
forall u. (forall d. Data d => d -> u) -> Timeline t a -> [u]
forall {t} {a}. (Data t, Data a, Ord t) => Typeable (Timeline t a)
forall t a. (Data t, Data a, Ord t) => Timeline t a -> Constr
forall t a. (Data t, Data a, Ord t) => Timeline t a -> DataType
forall t a.
(Data t, Data a, Ord t) =>
(forall b. Data b => b -> b) -> Timeline t a -> Timeline t a
forall t a u.
(Data t, Data a, Ord t) =>
Int -> (forall d. Data d => d -> u) -> Timeline t a -> u
forall t a u.
(Data t, Data a, Ord t) =>
(forall d. Data d => d -> u) -> Timeline t a -> [u]
forall t a r r'.
(Data t, Data a, Ord t) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timeline t a -> r
forall t a r r'.
(Data t, Data a, Ord t) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timeline t a -> r
forall t a (m :: * -> *).
(Data t, Data a, Ord t, Monad m) =>
(forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a)
forall t a (m :: * -> *).
(Data t, Data a, Ord t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a)
forall t a (c :: * -> *).
(Data t, Data a, Ord t) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Timeline t a)
forall t a (c :: * -> *).
(Data t, Data a, Ord t) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timeline t a -> c (Timeline t a)
forall t a (t :: * -> *) (c :: * -> *).
(Data t, Data a, Ord t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Timeline t a))
forall t a (t :: * -> * -> *) (c :: * -> *).
(Data t, Data a, Ord t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Timeline t a))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timeline t a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timeline t a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Timeline t a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timeline t a -> c (Timeline t a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Timeline t a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Timeline t a))
$cgfoldl :: forall t a (c :: * -> *).
(Data t, Data a, Ord t) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timeline t a -> c (Timeline t a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Timeline t a -> c (Timeline t a)
$cgunfold :: forall t a (c :: * -> *).
(Data t, Data a, Ord t) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Timeline t a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Timeline t a)
$ctoConstr :: forall t a. (Data t, Data a, Ord t) => Timeline t a -> Constr
toConstr :: Timeline t a -> Constr
$cdataTypeOf :: forall t a. (Data t, Data a, Ord t) => Timeline t a -> DataType
dataTypeOf :: Timeline t a -> DataType
$cdataCast1 :: forall t a (t :: * -> *) (c :: * -> *).
(Data t, Data a, Ord t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Timeline t a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Timeline t a))
$cdataCast2 :: forall t a (t :: * -> * -> *) (c :: * -> *).
(Data t, Data a, Ord t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Timeline t a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Timeline t a))
$cgmapT :: forall t a.
(Data t, Data a, Ord t) =>
(forall b. Data b => b -> b) -> Timeline t a -> Timeline t a
gmapT :: (forall b. Data b => b -> b) -> Timeline t a -> Timeline t a
$cgmapQl :: forall t a r r'.
(Data t, Data a, Ord t) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timeline t a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Timeline t a -> r
$cgmapQr :: forall t a r r'.
(Data t, Data a, Ord t) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timeline t a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Timeline t a -> r
$cgmapQ :: forall t a u.
(Data t, Data a, Ord t) =>
(forall d. Data d => d -> u) -> Timeline t a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Timeline t a -> [u]
$cgmapQi :: forall t a u.
(Data t, Data a, Ord t) =>
Int -> (forall d. Data d => d -> u) -> Timeline t a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Timeline t a -> u
$cgmapM :: forall t a (m :: * -> *).
(Data t, Data a, Ord t, Monad m) =>
(forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a)
$cgmapMp :: forall t a (m :: * -> *).
(Data t, Data a, Ord t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a)
$cgmapMo :: forall t a (m :: * -> *).
(Data t, Data a, Ord t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Timeline t a -> m (Timeline t a)
Data, Timeline t a -> Timeline t a -> Bool
(Timeline t a -> Timeline t a -> Bool)
-> (Timeline t a -> Timeline t a -> Bool) -> Eq (Timeline t a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t a. (Eq t, Eq a) => Timeline t a -> Timeline t a -> Bool
$c== :: forall t a. (Eq t, Eq a) => Timeline t a -> Timeline t a -> Bool
== :: Timeline t a -> Timeline t a -> Bool
$c/= :: forall t a. (Eq t, Eq a) => Timeline t a -> Timeline t a -> Bool
/= :: Timeline t a -> Timeline t a -> Bool
Eq, Eq (Timeline t a)
Eq (Timeline t a)
-> (Timeline t a -> Timeline t a -> Ordering)
-> (Timeline t a -> Timeline t a -> Bool)
-> (Timeline t a -> Timeline t a -> Bool)
-> (Timeline t a -> Timeline t a -> Bool)
-> (Timeline t a -> Timeline t a -> Bool)
-> (Timeline t a -> Timeline t a -> Timeline t a)
-> (Timeline t a -> Timeline t a -> Timeline t a)
-> Ord (Timeline t a)
Timeline t a -> Timeline t a -> Bool
Timeline t a -> Timeline t a -> Ordering
Timeline t a -> Timeline t a -> Timeline t a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {t} {a}. (Ord t, Ord a) => Eq (Timeline t a)
forall t a. (Ord t, Ord a) => Timeline t a -> Timeline t a -> Bool
forall t a.
(Ord t, Ord a) =>
Timeline t a -> Timeline t a -> Ordering
forall t a.
(Ord t, Ord a) =>
Timeline t a -> Timeline t a -> Timeline t a
$ccompare :: forall t a.
(Ord t, Ord a) =>
Timeline t a -> Timeline t a -> Ordering
compare :: Timeline t a -> Timeline t a -> Ordering
$c< :: forall t a. (Ord t, Ord a) => Timeline t a -> Timeline t a -> Bool
< :: Timeline t a -> Timeline t a -> Bool
$c<= :: forall t a. (Ord t, Ord a) => Timeline t a -> Timeline t a -> Bool
<= :: Timeline t a -> Timeline t a -> Bool
$c> :: forall t a. (Ord t, Ord a) => Timeline t a -> Timeline t a -> Bool
> :: Timeline t a -> Timeline t a -> Bool
$c>= :: forall t a. (Ord t, Ord a) => Timeline t a -> Timeline t a -> Bool
>= :: Timeline t a -> Timeline t a -> Bool
$cmax :: forall t a.
(Ord t, Ord a) =>
Timeline t a -> Timeline t a -> Timeline t a
max :: Timeline t a -> Timeline t a -> Timeline t a
$cmin :: forall t a.
(Ord t, Ord a) =>
Timeline t a -> Timeline t a -> Timeline t a
min :: Timeline t a -> Timeline t a -> Timeline t a
Ord, ReadPrec [Timeline t a]
ReadPrec (Timeline t a)
Int -> ReadS (Timeline t a)
ReadS [Timeline t a]
(Int -> ReadS (Timeline t a))
-> ReadS [Timeline t a]
-> ReadPrec (Timeline t a)
-> ReadPrec [Timeline t a]
-> Read (Timeline t a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall t a. (Ord t, Read t, Read a) => ReadPrec [Timeline t a]
forall t a. (Ord t, Read t, Read a) => ReadPrec (Timeline t a)
forall t a. (Ord t, Read t, Read a) => Int -> ReadS (Timeline t a)
forall t a. (Ord t, Read t, Read a) => ReadS [Timeline t a]
$creadsPrec :: forall t a. (Ord t, Read t, Read a) => Int -> ReadS (Timeline t a)
readsPrec :: Int -> ReadS (Timeline t a)
$creadList :: forall t a. (Ord t, Read t, Read a) => ReadS [Timeline t a]
readList :: ReadS [Timeline t a]
$creadPrec :: forall t a. (Ord t, Read t, Read a) => ReadPrec (Timeline t a)
readPrec :: ReadPrec (Timeline t a)
$creadListPrec :: forall t a. (Ord t, Read t, Read a) => ReadPrec [Timeline t a]
readListPrec :: ReadPrec [Timeline t a]
Read, Int -> Timeline t a -> ShowS
[Timeline t a] -> ShowS
Timeline t a -> String
(Int -> Timeline t a -> ShowS)
-> (Timeline t a -> String)
-> ([Timeline t a] -> ShowS)
-> Show (Timeline t a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t a. (Show t, Show a) => Int -> Timeline t a -> ShowS
forall t a. (Show t, Show a) => [Timeline t a] -> ShowS
forall t a. (Show t, Show a) => Timeline t a -> String
$cshowsPrec :: forall t a. (Show t, Show a) => Int -> Timeline t a -> ShowS
showsPrec :: Int -> Timeline t a -> ShowS
$cshow :: forall t a. (Show t, Show a) => Timeline t a -> String
show :: Timeline t a -> String
$cshowList :: forall t a. (Show t, Show a) => [Timeline t a] -> ShowS
showList :: [Timeline t a] -> ShowS
Show, Typeable)

instance Functor (Timeline t) where
    fmap :: forall a b. (a -> b) -> Timeline t a -> Timeline t b
fmap a -> b
f (Timeline Map t a
m) = Map t b -> Timeline t b
forall t a. Map t a -> Timeline t a
Timeline ((a -> b) -> Map t a -> Map t b
forall a b k. (a -> b) -> Map k a -> Map k b
M.map a -> b
f Map t a
m)


-- | Insert the given data point.

insert :: (Ord t) => t -> a -> Timeline t a -> Timeline t a
insert :: forall t a. Ord t => t -> a -> Timeline t a -> Timeline t a
insert t
t a
x (Timeline Map t a
m) = Map t a -> Timeline t a
forall t a. Map t a -> Timeline t a
Timeline (t -> a -> Map t a -> Map t a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert t
t a
x Map t a
m)


-- | Linearly interpolate the points in the time line, integrate the
-- given time interval of the graph, divide by the interval length.

linAvg ::
    (Fractional a, Fractional t, Real t)
    => t -> t -> Timeline t a -> a
linAvg :: forall a t.
(Fractional a, Fractional t, Real t) =>
t -> t -> Timeline t a -> a
linAvg t
t0 t
t1
    | t
t0 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
t1 = a -> Timeline t a -> a
forall a b. a -> b -> a
const (String -> a
forall a. HasCallStack => String -> a
error String
"linAvg: Invalid interval")
    | t
t0 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
t1 = t -> Timeline t a -> a
forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> a
linLookup t
t0
linAvg t
t0 t
t1 = a -> [(t, a)] -> a
forall {a} {b}. (Real a, Fractional b) => b -> [(a, b)] -> b
avg a
0 ([(t, a)] -> a) -> (Timeline t a -> [(t, a)]) -> Timeline t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map t a -> [(t, a)]
forall k a. Map k a -> [(k, a)]
M.assocs (Map t a -> [(t, a)])
-> (Timeline t a -> Map t a) -> Timeline t a -> [(t, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timeline t a -> Map t a
forall t a. Timeline t a -> Map t a
timeline (Timeline t a -> Map t a)
-> (Timeline t a -> Timeline t a) -> Timeline t a -> Map t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Timeline t a -> Timeline t a
forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> Timeline t a
linCutR t
t1 (Timeline t a -> Timeline t a)
-> (Timeline t a -> Timeline t a) -> Timeline t a -> Timeline t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Timeline t a -> Timeline t a
forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> Timeline t a
linCutL t
t0
    where
    avg :: b -> [(a, b)] -> b
avg b
a' ((a
t', b
y1) : xs :: [(a, b)]
xs@((a
t, b
y2) : [(a, b)]
_)) =
        let dt :: b
dt = a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (a
t a -> a -> a
forall a. Num a => a -> a -> a
- a
t')
            a :: b
a  = b
a' b -> b -> b
forall a. Num a => a -> a -> a
+ b
dtb -> b -> b
forall a. Num a => a -> a -> a
*(b
y1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
y2)b -> b -> b
forall a. Fractional a => a -> a -> a
/b
2
        in b
a b -> b -> b
forall a b. a -> b -> b
`seq` b -> [(a, b)] -> b
avg b
a [(a, b)]
xs
    avg b
a' [(a, b)]
_ = b
a' b -> b -> b
forall a. Fractional a => a -> a -> a
/ t -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (t
t1 t -> t -> t
forall a. Num a => a -> a -> a
- t
t0)


-- | Cut the timeline at the given point in time @t@, such that all
-- samples up to but not including @t@ are forgotten.  The most recent
-- sample before @t@ is moved and interpolated accordingly.

linCutL ::
    (Fractional a, Fractional t, Real t)
    => t -> Timeline t a -> Timeline t a
linCutL :: forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> Timeline t a
linCutL t
t tl :: Timeline t a
tl@(Timeline Map t a
m) =
    Map t a -> Timeline t a
forall t a. Map t a -> Timeline t a
Timeline (Map t a -> Timeline t a) -> Map t a -> Timeline t a
forall a b. (a -> b) -> a -> b
$
    case t -> Map t a -> (Map t a, Maybe a, Map t a)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
M.splitLookup t
t Map t a
m of
      (Map t a
_, Just a
x, Map t a
mr) -> t -> a -> Map t a -> Map t a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert t
t a
x Map t a
mr
      (Map t a
_, Maybe a
_, Map t a
mr)      -> t -> a -> Map t a -> Map t a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert t
t (t -> Timeline t a -> a
forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> a
linLookup t
t Timeline t a
tl) Map t a
mr


-- | Cut the timeline at the given point in time @t@, such that all
-- samples later than @t@ are forgotten.  The most recent sample after
-- @t@ is moved and interpolated accordingly.

linCutR ::
    (Fractional a, Fractional t, Real t)
    => t -> Timeline t a -> Timeline t a
linCutR :: forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> Timeline t a
linCutR t
t tl :: Timeline t a
tl@(Timeline Map t a
m) =
    Map t a -> Timeline t a
forall t a. Map t a -> Timeline t a
Timeline (Map t a -> Timeline t a) -> Map t a -> Timeline t a
forall a b. (a -> b) -> a -> b
$
    case t -> Map t a -> (Map t a, Maybe a, Map t a)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
M.splitLookup t
t Map t a
m of
      (Map t a
ml, Just a
x, Map t a
_) -> t -> a -> Map t a -> Map t a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert t
t a
x Map t a
ml
      (Map t a
ml, Maybe a
_, Map t a
_)      -> t -> a -> Map t a -> Map t a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert t
t (t -> Timeline t a -> a
forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> a
linLookup t
t Timeline t a
tl) Map t a
ml


-- | Look up with linear sampling.

linLookup :: (Fractional a, Fractional t, Real t) => t -> Timeline t a -> a
linLookup :: forall a t.
(Fractional a, Fractional t, Real t) =>
t -> Timeline t a -> a
linLookup t
t (Timeline Map t a
m) =
    case t -> Map t a -> (Map t a, Maybe a, Map t a)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
M.splitLookup t
t Map t a
m of
      (Map t a
_, Just a
x, Map t a
_) -> a
x
      (Map t a
ml, Maybe a
_, Map t a
mr)    ->
          case (((t, a), Map t a) -> (t, a)
forall a b. (a, b) -> a
fst (((t, a), Map t a) -> (t, a))
-> Maybe ((t, a), Map t a) -> Maybe (t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map t a -> Maybe ((t, a), Map t a)
forall k a. Map k a -> Maybe ((k, a), Map k a)
M.maxViewWithKey Map t a
ml, ((t, a), Map t a) -> (t, a)
forall a b. (a, b) -> a
fst (((t, a), Map t a) -> (t, a))
-> Maybe ((t, a), Map t a) -> Maybe (t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map t a -> Maybe ((t, a), Map t a)
forall k a. Map k a -> Maybe ((k, a), Map k a)
M.minViewWithKey Map t a
mr) of
            (Just (t
t1, a
x1), Just (t
t2, a
x2)) ->
                let f :: a
f = t -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac ((t
t t -> t -> t
forall a. Num a => a -> a -> a
- t
t1) t -> t -> t
forall a. Fractional a => a -> a -> a
/ (t
t2 t -> t -> t
forall a. Num a => a -> a -> a
- t
t1))
                in a
x1a -> a -> a
forall a. Num a => a -> a -> a
*(a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
f) a -> a -> a
forall a. Num a => a -> a -> a
+ a
x2a -> a -> a
forall a. Num a => a -> a -> a
*a
f
            (Just (t
_, a
x), Maybe (t, a)
_) -> a
x
            (Maybe (t, a)
_, Just (t
_, a
x)) -> a
x
            (Maybe (t, a), Maybe (t, a))
_                -> String -> a
forall a. HasCallStack => String -> a
error String
"linLookup: BUG: querying empty Timeline"


-- | Integrate the given time interval of the staircase, divide by the
-- interval length.

scAvg :: (Fractional a, Real t) => t -> t -> Timeline t a -> a
scAvg :: forall a t. (Fractional a, Real t) => t -> t -> Timeline t a -> a
scAvg t
t0 t
t1
    | t
t0 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
t1 = a -> Timeline t a -> a
forall a b. a -> b -> a
const (String -> a
forall a. HasCallStack => String -> a
error String
"scAvg: Invalid interval")
    | t
t0 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
t1 = t -> Timeline t a -> a
forall t a. Ord t => t -> Timeline t a -> a
scLookup t
t0
scAvg t
t0 t
t1 = a -> [(t, a)] -> a
forall {a} {b}. (Real a, Fractional b) => b -> [(a, b)] -> b
avg a
0 ([(t, a)] -> a) -> (Timeline t a -> [(t, a)]) -> Timeline t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map t a -> [(t, a)]
forall k a. Map k a -> [(k, a)]
M.assocs (Map t a -> [(t, a)])
-> (Timeline t a -> Map t a) -> Timeline t a -> [(t, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timeline t a -> Map t a
forall t a. Timeline t a -> Map t a
timeline (Timeline t a -> Map t a)
-> (Timeline t a -> Timeline t a) -> Timeline t a -> Map t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Timeline t a -> Timeline t a
forall t a. Ord t => t -> Timeline t a -> Timeline t a
scCutR t
t1 (Timeline t a -> Timeline t a)
-> (Timeline t a -> Timeline t a) -> Timeline t a -> Timeline t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Timeline t a -> Timeline t a
forall t a. Ord t => t -> Timeline t a -> Timeline t a
scCutL t
t0
    where
    avg :: b -> [(a, b)] -> b
avg b
a' ((a
t', b
y) : xs :: [(a, b)]
xs@((a
t, b
_) : [(a, b)]
_)) =
        let dt :: b
dt = a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (a
t a -> a -> a
forall a. Num a => a -> a -> a
- a
t')
            a :: b
a  = b
a' b -> b -> b
forall a. Num a => a -> a -> a
+ b
dtb -> b -> b
forall a. Num a => a -> a -> a
*b
y
        in b
a b -> b -> b
forall a b. a -> b -> b
`seq` b -> [(a, b)] -> b
avg b
a [(a, b)]
xs
    avg b
a' [(a, b)]
_ = b
a' b -> b -> b
forall a. Fractional a => a -> a -> a
/ t -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (t
t1 t -> t -> t
forall a. Num a => a -> a -> a
- t
t0)


-- | Cut the timeline at the given point in time @t@, such that all
-- samples up to but not including @t@ are forgotten.  The most recent
-- sample before @t@ is moved accordingly.

scCutL :: (Ord t) => t -> Timeline t a -> Timeline t a
scCutL :: forall t a. Ord t => t -> Timeline t a -> Timeline t a
scCutL t
t tl :: Timeline t a
tl@(Timeline Map t a
m) =
    Map t a -> Timeline t a
forall t a. Map t a -> Timeline t a
Timeline (Map t a -> Timeline t a) -> Map t a -> Timeline t a
forall a b. (a -> b) -> a -> b
$
    case t -> Map t a -> (Map t a, Maybe a, Map t a)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
M.splitLookup t
t Map t a
m of
      (Map t a
_, Just a
x, Map t a
mr) -> t -> a -> Map t a -> Map t a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert t
t a
x Map t a
mr
      (Map t a
_, Maybe a
_, Map t a
mr)      -> t -> a -> Map t a -> Map t a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert t
t (t -> Timeline t a -> a
forall t a. Ord t => t -> Timeline t a -> a
scLookup t
t Timeline t a
tl) Map t a
mr


-- | Cut the timeline at the given point in time @t@, such that all
-- samples later than @t@ are forgotten.  The earliest sample after @t@
-- is moved accordingly.

scCutR :: (Ord t) => t -> Timeline t a -> Timeline t a
scCutR :: forall t a. Ord t => t -> Timeline t a -> Timeline t a
scCutR t
t tl :: Timeline t a
tl@(Timeline Map t a
m) =
    Map t a -> Timeline t a
forall t a. Map t a -> Timeline t a
Timeline (Map t a -> Timeline t a) -> Map t a -> Timeline t a
forall a b. (a -> b) -> a -> b
$
    case t -> Map t a -> (Map t a, Maybe a, Map t a)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
M.splitLookup t
t Map t a
m of
      (Map t a
ml, Just a
x, Map t a
_) -> t -> a -> Map t a -> Map t a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert t
t a
x Map t a
ml
      (Map t a
ml, Maybe a
_, Map t a
_)      -> t -> a -> Map t a -> Map t a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert t
t (t -> Timeline t a -> a
forall t a. Ord t => t -> Timeline t a -> a
scLookup t
t Timeline t a
tl) Map t a
ml


-- | Look up on staircase.

scLookup :: (Ord t) => t -> Timeline t a -> a
scLookup :: forall t a. Ord t => t -> Timeline t a -> a
scLookup t
t (Timeline Map t a
m) =
    case (t -> Map t a -> Maybe (t, a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
M.lookupLE t
t Map t a
m, t -> Map t a -> Maybe (t, a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
M.lookupGE t
t Map t a
m) of
      (Just (t
_, a
x), Maybe (t, a)
_) -> a
x
      (Maybe (t, a)
_, Just (t
_, a
x)) -> a
x
      (Maybe (t, a), Maybe (t, a))
_                -> String -> a
forall a. HasCallStack => String -> a
error String
"linLookup: BUG: querying empty Timeline"


-- | Singleton timeline with the given point.

singleton :: t -> a -> Timeline t a
singleton :: forall t a. t -> a -> Timeline t a
singleton t
t = Map t a -> Timeline t a
forall t a. Map t a -> Timeline t a
Timeline (Map t a -> Timeline t a) -> (a -> Map t a) -> a -> Timeline t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> a -> Map t a
forall k a. k -> a -> Map k a
M.singleton t
t


-- | Union of two time lines.  Right-biased.

union :: (Ord t) => Timeline t a -> Timeline t a -> Timeline t a
union :: forall t a. Ord t => Timeline t a -> Timeline t a -> Timeline t a
union (Timeline Map t a
m1) (Timeline Map t a
m2) = Map t a -> Timeline t a
forall t a. Map t a -> Timeline t a
Timeline (Map t a -> Map t a -> Map t a
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map t a
m2 Map t a
m1)