{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}

module Epidemic.Types.Time
  ( AbsoluteTime(..)
  , TimeDelta(..)
  , Timed(..)
  , timeDelta
  , diracDeltaValue
  , timeAfterDelta
  , nextTime
  , cadlagValue
  , isAscending
  , hasTime
  , allTimes
  , asTimed
  ) where

import qualified Data.Aeson as Json
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import GHC.Generics

-- | Absolute time.
newtype AbsoluteTime =
  AbsoluteTime Double
  deriving ((forall x. AbsoluteTime -> Rep AbsoluteTime x)
-> (forall x. Rep AbsoluteTime x -> AbsoluteTime)
-> Generic AbsoluteTime
forall x. Rep AbsoluteTime x -> AbsoluteTime
forall x. AbsoluteTime -> Rep AbsoluteTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbsoluteTime x -> AbsoluteTime
$cfrom :: forall x. AbsoluteTime -> Rep AbsoluteTime x
Generic, AbsoluteTime -> AbsoluteTime -> Bool
(AbsoluteTime -> AbsoluteTime -> Bool)
-> (AbsoluteTime -> AbsoluteTime -> Bool) -> Eq AbsoluteTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsoluteTime -> AbsoluteTime -> Bool
$c/= :: AbsoluteTime -> AbsoluteTime -> Bool
== :: AbsoluteTime -> AbsoluteTime -> Bool
$c== :: AbsoluteTime -> AbsoluteTime -> Bool
Eq, Int -> AbsoluteTime -> ShowS
[AbsoluteTime] -> ShowS
AbsoluteTime -> String
(Int -> AbsoluteTime -> ShowS)
-> (AbsoluteTime -> String)
-> ([AbsoluteTime] -> ShowS)
-> Show AbsoluteTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsoluteTime] -> ShowS
$cshowList :: [AbsoluteTime] -> ShowS
show :: AbsoluteTime -> String
$cshow :: AbsoluteTime -> String
showsPrec :: Int -> AbsoluteTime -> ShowS
$cshowsPrec :: Int -> AbsoluteTime -> ShowS
Show, Eq AbsoluteTime
Eq AbsoluteTime
-> (AbsoluteTime -> AbsoluteTime -> Ordering)
-> (AbsoluteTime -> AbsoluteTime -> Bool)
-> (AbsoluteTime -> AbsoluteTime -> Bool)
-> (AbsoluteTime -> AbsoluteTime -> Bool)
-> (AbsoluteTime -> AbsoluteTime -> Bool)
-> (AbsoluteTime -> AbsoluteTime -> AbsoluteTime)
-> (AbsoluteTime -> AbsoluteTime -> AbsoluteTime)
-> Ord AbsoluteTime
AbsoluteTime -> AbsoluteTime -> Bool
AbsoluteTime -> AbsoluteTime -> Ordering
AbsoluteTime -> AbsoluteTime -> AbsoluteTime
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
min :: AbsoluteTime -> AbsoluteTime -> AbsoluteTime
$cmin :: AbsoluteTime -> AbsoluteTime -> AbsoluteTime
max :: AbsoluteTime -> AbsoluteTime -> AbsoluteTime
$cmax :: AbsoluteTime -> AbsoluteTime -> AbsoluteTime
>= :: AbsoluteTime -> AbsoluteTime -> Bool
$c>= :: AbsoluteTime -> AbsoluteTime -> Bool
> :: AbsoluteTime -> AbsoluteTime -> Bool
$c> :: AbsoluteTime -> AbsoluteTime -> Bool
<= :: AbsoluteTime -> AbsoluteTime -> Bool
$c<= :: AbsoluteTime -> AbsoluteTime -> Bool
< :: AbsoluteTime -> AbsoluteTime -> Bool
$c< :: AbsoluteTime -> AbsoluteTime -> Bool
compare :: AbsoluteTime -> AbsoluteTime -> Ordering
$ccompare :: AbsoluteTime -> AbsoluteTime -> Ordering
$cp1Ord :: Eq AbsoluteTime
Ord)

instance Json.FromJSON AbsoluteTime

instance Json.ToJSON AbsoluteTime

-- | Predicate for an infinite absolute time
isInfiniteAbsoluteTime :: AbsoluteTime -> Bool
isInfiniteAbsoluteTime :: AbsoluteTime -> Bool
isInfiniteAbsoluteTime (AbsoluteTime Double
t) = Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
t

-- | Duration of time between two absolute times.
newtype TimeDelta =
  TimeDelta Double
  deriving ((forall x. TimeDelta -> Rep TimeDelta x)
-> (forall x. Rep TimeDelta x -> TimeDelta) -> Generic TimeDelta
forall x. Rep TimeDelta x -> TimeDelta
forall x. TimeDelta -> Rep TimeDelta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeDelta x -> TimeDelta
$cfrom :: forall x. TimeDelta -> Rep TimeDelta x
Generic, TimeDelta -> TimeDelta -> Bool
(TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool) -> Eq TimeDelta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeDelta -> TimeDelta -> Bool
$c/= :: TimeDelta -> TimeDelta -> Bool
== :: TimeDelta -> TimeDelta -> Bool
$c== :: TimeDelta -> TimeDelta -> Bool
Eq, Int -> TimeDelta -> ShowS
[TimeDelta] -> ShowS
TimeDelta -> String
(Int -> TimeDelta -> ShowS)
-> (TimeDelta -> String)
-> ([TimeDelta] -> ShowS)
-> Show TimeDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeDelta] -> ShowS
$cshowList :: [TimeDelta] -> ShowS
show :: TimeDelta -> String
$cshow :: TimeDelta -> String
showsPrec :: Int -> TimeDelta -> ShowS
$cshowsPrec :: Int -> TimeDelta -> ShowS
Show, Eq TimeDelta
Eq TimeDelta
-> (TimeDelta -> TimeDelta -> Ordering)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> TimeDelta)
-> (TimeDelta -> TimeDelta -> TimeDelta)
-> Ord TimeDelta
TimeDelta -> TimeDelta -> Bool
TimeDelta -> TimeDelta -> Ordering
TimeDelta -> TimeDelta -> TimeDelta
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
min :: TimeDelta -> TimeDelta -> TimeDelta
$cmin :: TimeDelta -> TimeDelta -> TimeDelta
max :: TimeDelta -> TimeDelta -> TimeDelta
$cmax :: TimeDelta -> TimeDelta -> TimeDelta
>= :: TimeDelta -> TimeDelta -> Bool
$c>= :: TimeDelta -> TimeDelta -> Bool
> :: TimeDelta -> TimeDelta -> Bool
$c> :: TimeDelta -> TimeDelta -> Bool
<= :: TimeDelta -> TimeDelta -> Bool
$c<= :: TimeDelta -> TimeDelta -> Bool
< :: TimeDelta -> TimeDelta -> Bool
$c< :: TimeDelta -> TimeDelta -> Bool
compare :: TimeDelta -> TimeDelta -> Ordering
$ccompare :: TimeDelta -> TimeDelta -> Ordering
$cp1Ord :: Eq TimeDelta
Ord)

instance Json.FromJSON TimeDelta

instance Json.ToJSON TimeDelta

-- | The duration of time between two absolute times
--
-- >>> timeDelta (AbsoluteTime 1) (AbsoluteTime 2.5)
-- TimeDelta 1.5
--
timeDelta ::
     AbsoluteTime -- ^ start
  -> AbsoluteTime -- ^ finish
  -> TimeDelta
timeDelta :: AbsoluteTime -> AbsoluteTime -> TimeDelta
timeDelta (AbsoluteTime Double
t0) (AbsoluteTime Double
t1) = Double -> TimeDelta
TimeDelta (Double
t1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0)

-- | The time after a given delay
--
-- >>> timeAfterDelta (AbsoluteTime 1) (TimeDelta 2.5)
-- AbsoluteTime 3.5
--
timeAfterDelta :: AbsoluteTime -> TimeDelta -> AbsoluteTime
timeAfterDelta :: AbsoluteTime -> TimeDelta -> AbsoluteTime
timeAfterDelta (AbsoluteTime Double
t0) (TimeDelta Double
d) = Double -> AbsoluteTime
AbsoluteTime (Double
t0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
d)

-- | Type containing values at times. The times are increasing as required by
-- @asTimed@.
newtype Timed a =
  Timed [(AbsoluteTime, a)]
  deriving ((forall x. Timed a -> Rep (Timed a) x)
-> (forall x. Rep (Timed a) x -> Timed a) -> Generic (Timed a)
forall x. Rep (Timed a) x -> Timed a
forall x. Timed a -> Rep (Timed a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Timed a) x -> Timed a
forall a x. Timed a -> Rep (Timed a) x
$cto :: forall a x. Rep (Timed a) x -> Timed a
$cfrom :: forall a x. Timed a -> Rep (Timed a) x
Generic, Timed a -> Timed a -> Bool
(Timed a -> Timed a -> Bool)
-> (Timed a -> Timed a -> Bool) -> Eq (Timed a)
forall a. Eq a => Timed a -> Timed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timed a -> Timed a -> Bool
$c/= :: forall a. Eq a => Timed a -> Timed a -> Bool
== :: Timed a -> Timed a -> Bool
$c== :: forall a. Eq a => Timed a -> Timed a -> Bool
Eq, Int -> Timed a -> ShowS
[Timed a] -> ShowS
Timed a -> String
(Int -> Timed a -> ShowS)
-> (Timed a -> String) -> ([Timed a] -> ShowS) -> Show (Timed a)
forall a. Show a => Int -> Timed a -> ShowS
forall a. Show a => [Timed a] -> ShowS
forall a. Show a => Timed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timed a] -> ShowS
$cshowList :: forall a. Show a => [Timed a] -> ShowS
show :: Timed a -> String
$cshow :: forall a. Show a => Timed a -> String
showsPrec :: Int -> Timed a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Timed a -> ShowS
Show)

instance Json.FromJSON a => Json.FromJSON (Timed a)

instance Json.ToJSON a => Json.ToJSON (Timed a)

instance Semigroup (Timed a) where
  (Timed [(AbsoluteTime, a)]
x) <> :: Timed a -> Timed a -> Timed a
<> (Timed [(AbsoluteTime, a)]
y) = [(AbsoluteTime, a)] -> Timed a
forall a. [(AbsoluteTime, a)] -> Timed a
Timed ([(AbsoluteTime, a)] -> Timed a) -> [(AbsoluteTime, a)] -> Timed a
forall a b. (a -> b) -> a -> b
$ ((AbsoluteTime, a) -> AbsoluteTime)
-> [(AbsoluteTime, a)] -> [(AbsoluteTime, a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (AbsoluteTime, a) -> AbsoluteTime
forall a b. (a, b) -> a
fst ([(AbsoluteTime, a)]
x [(AbsoluteTime, a)] -> [(AbsoluteTime, a)] -> [(AbsoluteTime, a)]
forall a. [a] -> [a] -> [a]
++ [(AbsoluteTime, a)]
y)

-- | Construct a timed list if possible.
asTimed ::
     Num a
  => [(AbsoluteTime, a)] -- ^ list of ascending times and values
  -> Maybe (Timed a)
asTimed :: [(AbsoluteTime, a)] -> Maybe (Timed a)
asTimed [(AbsoluteTime, a)]
tas =
  if [AbsoluteTime] -> Bool
forall a. Ord a => [a] -> Bool
isAscending ([AbsoluteTime] -> Bool) -> [AbsoluteTime] -> Bool
forall a b. (a -> b) -> a -> b
$ ((AbsoluteTime, a) -> AbsoluteTime)
-> [(AbsoluteTime, a)] -> [AbsoluteTime]
forall a b. (a -> b) -> [a] -> [b]
map (AbsoluteTime, a) -> AbsoluteTime
forall a b. (a, b) -> a
fst [(AbsoluteTime, a)]
tas
    then Timed a -> Maybe (Timed a)
forall a. a -> Maybe a
Just ([(AbsoluteTime, a)] -> Timed a
forall a. [(AbsoluteTime, a)] -> Timed a
Timed ([(AbsoluteTime, a)] -> Timed a) -> [(AbsoluteTime, a)] -> Timed a
forall a b. (a -> b) -> a -> b
$ [(AbsoluteTime, a)]
tas [(AbsoluteTime, a)] -> [(AbsoluteTime, a)] -> [(AbsoluteTime, a)]
forall a. [a] -> [a] -> [a]
++ [(Double -> AbsoluteTime
AbsoluteTime (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0), -a
1)])
    else Maybe (Timed a)
forall a. Maybe a
Nothing

-- | Predicate to check if a list of orderable objects is in ascending order.
isAscending :: Ord a => [a] -> Bool
isAscending :: [a] -> Bool
isAscending [a]
xs =
  case [a]
xs of
    [] -> Bool
True
    [a
_] -> Bool
True
    (a
x:a
y:[a]
xs') -> a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&& [a] -> Bool
forall a. Ord a => [a] -> Bool
isAscending (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs')

-- | Evaluate the timed object treating it as a cadlag function
cadlagValue :: Timed a -> AbsoluteTime -> Maybe a
cadlagValue :: Timed a -> AbsoluteTime -> Maybe a
cadlagValue (Timed [(AbsoluteTime, a)]
txs) = [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
cadlagValue' [(AbsoluteTime, a)]
txs

cadlagValue' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
cadlagValue' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
cadlagValue' [] AbsoluteTime
_ = Maybe a
forall a. Maybe a
Nothing
cadlagValue' ((AbsoluteTime
t, a
x):[(AbsoluteTime, a)]
txs) AbsoluteTime
q =
  if AbsoluteTime
q AbsoluteTime -> AbsoluteTime -> Bool
forall a. Ord a => a -> a -> Bool
< AbsoluteTime
t
    then Maybe a
forall a. Maybe a
Nothing
    else let nextCLV :: Maybe a
nextCLV = [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
cadlagValue' [(AbsoluteTime, a)]
txs AbsoluteTime
q
          in if Maybe a -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe a
nextCLV
               then a -> Maybe a
forall a. a -> Maybe a
Just a
x
               else Maybe a
nextCLV

-- | Evaluate the timed object treating it as a direct delta function
diracDeltaValue :: Timed a -> AbsoluteTime -> Maybe a
diracDeltaValue :: Timed a -> AbsoluteTime -> Maybe a
diracDeltaValue (Timed [(AbsoluteTime, a)]
txs) = [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
diracDeltaValue' [(AbsoluteTime, a)]
txs

diracDeltaValue' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
diracDeltaValue' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
diracDeltaValue' [(AbsoluteTime, a)]
txs AbsoluteTime
q =
  case [(AbsoluteTime, a)]
txs of
    ((AbsoluteTime
t, a
x):[(AbsoluteTime, a)]
txs') ->
      if AbsoluteTime
t AbsoluteTime -> AbsoluteTime -> Bool
forall a. Eq a => a -> a -> Bool
== AbsoluteTime
q
        then a -> Maybe a
forall a. a -> Maybe a
Just a
x
        else [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe a
diracDeltaValue' [(AbsoluteTime, a)]
txs' AbsoluteTime
q
    [] -> Maybe a
forall a. Maybe a
Nothing

-- | Check if there exists a pair with a particular time index.
hasTime :: Timed a -> AbsoluteTime -> Bool
hasTime :: Timed a -> AbsoluteTime -> Bool
hasTime (Timed [(AbsoluteTime, a)]
txs) = [(AbsoluteTime, a)] -> AbsoluteTime -> Bool
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Bool
hasTime' [(AbsoluteTime, a)]
txs

hasTime' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Bool
hasTime' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Bool
hasTime' [(AbsoluteTime, a)]
txs AbsoluteTime
q =
  case [(AbsoluteTime, a)]
txs of
    ((AbsoluteTime
t, a
_):[(AbsoluteTime, a)]
txs') -> AbsoluteTime
t AbsoluteTime -> AbsoluteTime -> Bool
forall a. Eq a => a -> a -> Bool
== AbsoluteTime
q Bool -> Bool -> Bool
|| [(AbsoluteTime, a)] -> AbsoluteTime -> Bool
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Bool
hasTime' [(AbsoluteTime, a)]
txs' AbsoluteTime
q
    [] -> Bool
False

-- | Return the value of the next time if possible or an exact match if it
-- exists.
nextTime :: Timed a -> AbsoluteTime -> Maybe AbsoluteTime
nextTime :: Timed a -> AbsoluteTime -> Maybe AbsoluteTime
nextTime (Timed [(AbsoluteTime, a)]
txs) = [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
nextTime' [(AbsoluteTime, a)]
txs

nextTime' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
nextTime' :: [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
nextTime' [(AbsoluteTime, a)]
txs AbsoluteTime
q =
  case [(AbsoluteTime, a)]
txs of
    ((AbsoluteTime
t, a
_):[(AbsoluteTime, a)]
txs') ->
      if AbsoluteTime
q AbsoluteTime -> AbsoluteTime -> Bool
forall a. Ord a => a -> a -> Bool
< AbsoluteTime
t
        then AbsoluteTime -> Maybe AbsoluteTime
forall a. a -> Maybe a
Just AbsoluteTime
t
        else [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
forall a. [(AbsoluteTime, a)] -> AbsoluteTime -> Maybe AbsoluteTime
nextTime' [(AbsoluteTime, a)]
txs' AbsoluteTime
q
    [] -> Maybe AbsoluteTime
forall a. Maybe a
Nothing

-- | Return a list of the (finite) absolute times that the step function changes
-- value.
--
-- >>> let demoMaybeTimed = asTimed [(AbsoluteTime 1,2),(AbsoluteTime 1.5,1)]
-- >>> liftM allTimes demoMaybeTimed
-- Just [AbsoluteTime 1.0,AbsoluteTime 1.5]
--
allTimes :: Timed a -> [AbsoluteTime]
allTimes :: Timed a -> [AbsoluteTime]
allTimes (Timed [(AbsoluteTime, a)]
txs) = [AbsoluteTime
t | (AbsoluteTime
t, a
_) <- [(AbsoluteTime, a)]
txs, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AbsoluteTime -> Bool
isInfiniteAbsoluteTime AbsoluteTime
t]