{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-|
Copyright   : Predictable Network Solutions Ltd., 2003-2024
License     : BSD-3-Clause
Description : Methods for analysis and construction.

This module collects common methods
for constructing 'DeltaQ' and analyzing them.
-}
module DeltaQ.Methods
    ( -- * Slack / Hazard
      meetsRequirement
    , SlackOrHazard (..)
    , isSlack
    , isHazard
    ) where

import DeltaQ.Class
    ( DeltaQ (..)
    , Eventually (..)
    , Outcome (..)
    , eventually
    )

{-----------------------------------------------------------------------------
    Methods
    Slack / Hazard
------------------------------------------------------------------------------}
-- | The \"slack or hazard\" represents the distance between
-- a reference point in (time, probability) space
-- and a given 'DeltaQ'.
--
-- * 'Slack' represents the case where the 'DeltaQ' __meets__
--   the performance requirements set by the reference point.
-- * 'Hazard' represents the case where the 'DeltaQ' __fails__ to meet
--   the performance requirements set by the reference point.
--
-- Both cases include information of how far the reference point is
-- away.
data SlackOrHazard o
    = Slack (Duration o) (Probability o)
    -- ^ We have some slack.
    -- Specifically, we have 'Duration' at the same probability as the reference,
    -- and 'Probability' at the same duration as the reference.
    | Hazard (Eventually (Duration o)) (Probability o)
    -- ^ We fail to meet the reference point.
    -- Specifically,
    -- we overshoot by 'Duration' at the same probability as the reference,
    -- and by 'Probability' at the same duration as the reference.

deriving instance (Eq (Duration o), Eq (Probability o))
    => Eq (SlackOrHazard o)

deriving instance (Show (Duration o), Show (Probability o))
    => Show (SlackOrHazard o)

-- | Test whether the given 'SlackOrHazard' is 'Slack'.
isSlack :: SlackOrHazard o -> Bool
isSlack :: forall o. SlackOrHazard o -> Bool
isSlack (Slack Duration o
_ Probability o
_) = Bool
True
isSlack SlackOrHazard o
_ = Bool
False

-- | Test whether the given 'SlackOrHazard' is 'Hazard'.
isHazard :: SlackOrHazard o -> Bool
isHazard :: forall o. SlackOrHazard o -> Bool
isHazard (Hazard Eventually (Duration o)
_ Probability o
_) = Bool
True
isHazard SlackOrHazard o
_ = Bool
False

-- | Compute \"slack or hazard\" with respect to a given reference point.
meetsRequirement
    :: DeltaQ o => o -> (Duration o, Probability o) -> SlackOrHazard o
meetsRequirement :: forall o.
DeltaQ o =>
o -> (Duration o, Probability o) -> SlackOrHazard o
meetsRequirement o
o (Duration o
t,Probability o
p)
    | Probability o
dp Probability o -> Probability o -> Bool
forall a. Ord a => a -> a -> Bool
>= Probability o
0 = Duration o -> Probability o -> SlackOrHazard o
forall o. Duration o -> Probability o -> SlackOrHazard o
Slack Duration o
dt Probability o
dp
    | Eventually (Duration o)
Abandoned <- Eventually (Duration o)
t' = Eventually (Duration o) -> Probability o -> SlackOrHazard o
forall o.
Eventually (Duration o) -> Probability o -> SlackOrHazard o
Hazard Eventually (Duration o)
forall a. Eventually a
Abandoned (Probability o -> Probability o
forall a. Num a => a -> a
negate Probability o
dp)
    | Bool
otherwise = Eventually (Duration o) -> Probability o -> SlackOrHazard o
forall o.
Eventually (Duration o) -> Probability o -> SlackOrHazard o
Hazard (Duration o -> Eventually (Duration o)
forall a. a -> Eventually a
Occurs (Duration o -> Eventually (Duration o))
-> Duration o -> Eventually (Duration o)
forall a b. (a -> b) -> a -> b
$ Duration o -> Duration o
forall a. Num a => a -> a
negate Duration o
dt) (Probability o -> Probability o
forall a. Num a => a -> a
negate Probability o
dp)
  where
    dp :: Probability o
dp = Probability o
p' Probability o -> Probability o -> Probability o
forall a. Num a => a -> a -> a
- Probability o
p
    dt :: Duration o
dt = Duration o
t Duration o -> Duration o -> Duration o
forall a. Num a => a -> a -> a
- Duration o
-> (Duration o -> Duration o)
-> Eventually (Duration o)
-> Duration o
forall b a. b -> (a -> b) -> Eventually a -> b
eventually Duration o
forall {a}. a
err Duration o -> Duration o
forall a. a -> a
id Eventually (Duration o)
t'

    t' :: Eventually (Duration o)
t' = o -> Probability o -> Eventually (Duration o)
forall o. DeltaQ o => o -> Probability o -> Eventually (Duration o)
quantile o
o Probability o
p
    p' :: Probability o
p' = o
o o -> Duration o -> Probability o
forall o. DeltaQ o => o -> Duration o -> Probability o
`successWithin` Duration o
t

    err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"distanceToReference: inconsistency"