module Network.Mux.DeltaQ.TraceStats
( step
, OneWayDeltaQSample (..)
, constructSample
, StatsA
, initialStatsA
) where
import Data.IntMap.Strict (IntMap)
import Data.IntMap.Strict qualified as IM
import Data.Word (Word32)
import Control.Monad.Class.MonadTime.SI
import Network.Mux.DeltaQ.TraceStatsSupport
import Network.Mux.DeltaQ.TraceTypes
import Network.Mux.Types
step :: RemoteClockModel
-> Time
-> Int
-> StatsA
-> (Maybe OneWayDeltaQSample, StatsA)
step :: RemoteClockModel
-> Time -> Key -> StatsA -> (Maybe OneWayDeltaQSample, StatsA)
step RemoteClockModel
remoteTS Time
localTS Key
obsSize StatsA
s =
case StatsA -> Maybe (Word32, Time)
referenceTimePoint StatsA
s of
Maybe (Word32, Time)
Nothing ->
RemoteClockModel
-> Time -> Key -> StatsA -> (Maybe OneWayDeltaQSample, StatsA)
step RemoteClockModel
remoteTS Time
localTS Key
obsSize
(StatsA
s { referenceTimePoint = Just $! (unRemoteClockModel remoteTS, localTS)
, nextSampleAt = sampleInterval `addTime` localTS
, timeLastObs = localTS
})
Just (Word32, Time)
refTimePoint | Time
localTS Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= StatsA -> Time
nextSampleAt StatsA
s ->
let transitTime :: SISec
transitTime = (Word32, Time) -> RemoteClockModel -> Time -> SISec
calcTransitTime (Word32, Time)
refTimePoint RemoteClockModel
remoteTS Time
localTS
in (Maybe OneWayDeltaQSample
forall a. Maybe a
Nothing, StatsA -> Time -> Key -> SISec -> StatsA
recordObservation StatsA
s Time
localTS Key
obsSize SISec
transitTime)
Maybe (Word32, Time)
_ ->
let sample :: OneWayDeltaQSample
sample = StatsA -> OneWayDeltaQSample
constructSample StatsA
s
(Maybe OneWayDeltaQSample
_, StatsA
s') = RemoteClockModel
-> Time -> Key -> StatsA -> (Maybe OneWayDeltaQSample, StatsA)
step RemoteClockModel
remoteTS Time
localTS Key
obsSize StatsA
initialStatsA
in (OneWayDeltaQSample -> Maybe OneWayDeltaQSample
forall a. a -> Maybe a
Just OneWayDeltaQSample
sample, StatsA
s')
calcTransitTime :: (Word32, Time)
-> RemoteClockModel
-> Time
-> SISec
calcTransitTime :: (Word32, Time) -> RemoteClockModel -> Time -> SISec
calcTransitTime (Word32
remoteRefTS, Time
localRefTS) RemoteClockModel
remoteTS' Time
localTS
= let remoteTS :: Word32
remoteTS
= RemoteClockModel -> Word32
unRemoteClockModel RemoteClockModel
remoteTS'
remoteClockDiffAsTimeDiff :: Word32 -> DiffTime
remoteClockDiffAsTimeDiff
= (DiffTime
remoteClockPrecision DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
*) (DiffTime -> DiffTime)
-> (Word32 -> DiffTime) -> Word32 -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> DiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> DiffTime)
-> (Word32 -> Rational) -> Word32 -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
correctedEmitTime :: Time
correctedEmitTime
| Word32
remoteTS Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
remoteRefTS
= (Word32 -> DiffTime
remoteClockDiffAsTimeDiff (Word32 -> DiffTime) -> Word32 -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word32
remoteTS Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
remoteRefTS)
DiffTime -> Time -> Time
`addTime` Time
localRefTS
| Bool
otherwise
= (Word32 -> DiffTime
remoteClockDiffAsTimeDiff (Word32 -> DiffTime) -> Word32 -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word32
forall a. Bounded a => a
maxBound Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- (Word32
remoteRefTS Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
remoteTS))
DiffTime -> Time -> Time
`addTime` Time
localRefTS
in Float -> SISec
S (Float -> SISec) -> Float -> SISec
forall a b. (a -> b) -> a -> b
$! Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (DiffTime -> Rational
forall a. Real a => a -> Rational
toRational (Time
localTS Time -> Time -> DiffTime
`diffTime` Time
correctedEmitTime))
recordObservation :: StatsA -> Time -> Int -> SISec -> StatsA
recordObservation :: StatsA -> Time -> Key -> SISec -> StatsA
recordObservation StatsA
s Time
obsTime Key
obsSize SISec
transitTime
= let f :: Maybe PerSizeRecord -> Maybe PerSizeRecord
f Maybe PerSizeRecord
Nothing = PerSizeRecord -> Maybe PerSizeRecord
forall a. a -> Maybe a
Just (PerSizeRecord -> Maybe PerSizeRecord)
-> PerSizeRecord -> Maybe PerSizeRecord
forall a b. (a -> b) -> a -> b
$! SISec -> PerSizeRecord
makePerSizeRecord SISec
transitTime
f (Just PerSizeRecord
a) = PerSizeRecord -> Maybe PerSizeRecord
forall a. a -> Maybe a
Just (PerSizeRecord -> Maybe PerSizeRecord)
-> PerSizeRecord -> Maybe PerSizeRecord
forall a b. (a -> b) -> a -> b
$! SISec -> PerSizeRecord
makePerSizeRecord SISec
transitTime PerSizeRecord -> PerSizeRecord -> PerSizeRecord
forall a. Semigroup a => a -> a -> a
<> PerSizeRecord
a
in StatsA
s { timeLastObs = obsTime
, numObservations = succ (numObservations s)
, observables = IM.alter f obsSize (observables s)
}
constructSample :: StatsA -> OneWayDeltaQSample
constructSample :: StatsA -> OneWayDeltaQSample
constructSample StatsA
sa = OneWaySample
{ duration :: Double
duration = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double)
-> (DiffTime -> Rational) -> DiffTime -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Rational
forall a. Real a => a -> Rational
toRational (DiffTime -> Double) -> DiffTime -> Double
forall a b. (a -> b) -> a -> b
$
DiffTime
-> ((Word32, Time) -> DiffTime) -> Maybe (Word32, Time) -> DiffTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DiffTime
0 (\(Word32
_,Time
a) -> StatsA -> Time
timeLastObs StatsA
sa Time -> Time -> DiffTime
`diffTime` Time
a)
(StatsA -> Maybe (Word32, Time)
referenceTimePoint StatsA
sa)
, sumPackets :: Key
sumPackets = Key
population
, sumTotalSDU :: Key
sumTotalSDU = Key
totalSDUOctets
, estDeltaQS :: Double
estDeltaQS = Double -> Double
normCheck Double
dQSEst
, estDeltaQVMean :: Double
estDeltaQVMean = Double -> Double
normCheck (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
vSum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pop
, estDeltaQVVar :: Double
estDeltaQVVar = Double -> Double
normCheck (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ (Double
vSum2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vSum Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
vSum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pop) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pop
, estR :: Double
estR = Double -> Double
normCheck Double
rEst
, sizeDist :: String
sizeDist = [(Key, Key, Float)] -> String
forall a. Show a => a -> String
show [ (Key
a,PerSizeRecord -> Key
count PerSizeRecord
b, let S Float
mtt = PerSizeRecord -> SISec
minTransitTime PerSizeRecord
b in Float
mtt)
| (Key
a, PerSizeRecord
b) <- IntMap PerSizeRecord -> [(Key, PerSizeRecord)]
forall a. IntMap a -> [(Key, a)]
IM.toAscList (StatsA -> IntMap PerSizeRecord
observables StatsA
sa)
, PerSizeRecord -> Key
count PerSizeRecord
b Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
0]
}
where
population :: Key
population = StatsA -> Key
numObservations StatsA
sa
pop :: Double
pop = Key -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
population
normCheck :: Double -> Double
normCheck Double
x
| IntMap PerSizeRecord -> Key
forall a. IntMap a -> Key
IM.size (StatsA -> IntMap PerSizeRecord
observables StatsA
sa) Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
1 = Double
x
| Bool
otherwise = Double
nan
(Key
totalSDUOctets, [(Key, SISec)]
minSRev)
= (Key
-> PerSizeRecord -> (Key, [(Key, SISec)]) -> (Key, [(Key, SISec)]))
-> (Key, [(Key, SISec)])
-> IntMap PerSizeRecord
-> (Key, [(Key, SISec)])
forall a b. (Key -> a -> b -> b) -> b -> IntMap a -> b
IM.foldrWithKey Key
-> PerSizeRecord -> (Key, [(Key, SISec)]) -> (Key, [(Key, SISec)])
accum (Key
0, []) (IntMap PerSizeRecord -> (Key, [(Key, SISec)]))
-> IntMap PerSizeRecord -> (Key, [(Key, SISec)])
forall a b. (a -> b) -> a -> b
$ StatsA -> IntMap PerSizeRecord
observables StatsA
sa
accum :: Key
-> PerSizeRecord -> (Key, [(Key, SISec)]) -> (Key, [(Key, SISec)])
accum Key
nOctets PerSizeRecord
psr (Key
sumSize, [(Key, SISec)]
minS)
= ( Key
sumSize Key -> Key -> Key
forall a. Num a => a -> a -> a
+ (PerSizeRecord -> Key
count PerSizeRecord
psr) Key -> Key -> Key
forall a. Num a => a -> a -> a
* Key
nOctets
, (Key
nOctets, PerSizeRecord -> SISec
minTransitTime PerSizeRecord
psr) (Key, SISec) -> [(Key, SISec)] -> [(Key, SISec)]
forall a. a -> [a] -> [a]
: [(Key, SISec)]
minS)
(Double
dQGEst, Double
dQSEst, Double
rEst) = [(Key, SISec)] -> (Double, Double, Double)
estimateGS [(Key, SISec)]
minSRev
normalisedObservations :: IntMap PerSizeRecord
normalisedObservations
= let norm :: a -> SISec
norm a
n = Float -> SISec
S (Float -> SISec) -> (Double -> Float) -> Double -> SISec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Rational -> Float) -> (Double -> Rational) -> Double -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational
(Double -> SISec) -> Double -> SISec
forall a b. (a -> b) -> a -> b
$ Double
dQGEst Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dQSEst
in (Key -> PerSizeRecord -> PerSizeRecord)
-> IntMap PerSizeRecord -> IntMap PerSizeRecord
forall a b. (Key -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\Key
k -> SISec -> PerSizeRecord -> PerSizeRecord
normalisePSR (Key -> SISec
forall {a}. Integral a => a -> SISec
norm Key
k)) (StatsA -> IntMap PerSizeRecord
observables StatsA
sa)
(Double
vSum, Double
vSum2)
= let S Float
v = SISec
vSum'
S2 Float
v2 = SISec2
vSum2'
in (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> (Float -> Rational) -> Float -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Rational
forall a. Real a => a -> Rational
toRational (Float -> Double) -> Float -> Double
forall a b. (a -> b) -> a -> b
$ Float
v, Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> (Float -> Rational) -> Float -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Rational
forall a. Real a => a -> Rational
toRational (Float -> Double) -> Float -> Double
forall a b. (a -> b) -> a -> b
$ Float
v2)
(SISec
vSum', SISec2
vSum2')
= (PerSizeRecord -> (SISec, SISec2) -> (SISec, SISec2))
-> (SISec, SISec2) -> IntMap PerSizeRecord -> (SISec, SISec2)
forall a b. (a -> b -> b) -> b -> IntMap a -> b
IM.foldr PerSizeRecord -> (SISec, SISec2) -> (SISec, SISec2)
vCalc (SISec
0,SISec2
0) IntMap PerSizeRecord
normalisedObservations
vCalc :: PerSizeRecord -> (SISec, SISec2) -> (SISec, SISec2)
vCalc PerSizeRecord
psr (SISec
x, SISec2
x2)
= (SISec
x SISec -> SISec -> SISec
forall a. Num a => a -> a -> a
+ PerSizeRecord -> SISec
sumTransitTime PerSizeRecord
psr, SISec2
x2 SISec2 -> SISec2 -> SISec2
forall a. Num a => a -> a -> a
+ PerSizeRecord -> SISec2
sumTransitTimeSq PerSizeRecord
psr)
data OneWayDeltaQSample = OneWaySample
{ OneWayDeltaQSample -> Double
duration :: Double
, OneWayDeltaQSample -> Key
sumPackets :: Int
, OneWayDeltaQSample -> Key
sumTotalSDU :: Int
, OneWayDeltaQSample -> Double
estDeltaQS :: Double
, OneWayDeltaQSample -> Double
estDeltaQVMean :: Double
, OneWayDeltaQSample -> Double
estDeltaQVVar :: Double
, OneWayDeltaQSample -> Double
estR :: Double
, OneWayDeltaQSample -> String
sizeDist :: String
}
data StatsA = StatsA
{
StatsA -> Maybe (Word32, Time)
referenceTimePoint :: !(Maybe (Word32, Time))
, StatsA -> Time
nextSampleAt :: !Time
, StatsA -> Key
numObservations :: !Int
, StatsA -> Time
timeLastObs :: !Time
, StatsA -> IntMap PerSizeRecord
observables :: !(IntMap PerSizeRecord)
}
data PerSizeRecord = PSR
{ PerSizeRecord -> SISec
minTransitTime :: !SISec
, PerSizeRecord -> Key
count :: !Int
, PerSizeRecord -> SISec
sumTransitTime :: !SISec
, PerSizeRecord -> SISec2
sumTransitTimeSq :: !SISec2
}
instance Semigroup PerSizeRecord where
PerSizeRecord
a <> :: PerSizeRecord -> PerSizeRecord -> PerSizeRecord
<> PerSizeRecord
b = PSR { minTransitTime :: SISec
minTransitTime = (PerSizeRecord -> SISec
minTransitTime PerSizeRecord
a) SISec -> SISec -> SISec
forall a. Ord a => a -> a -> a
`min` (PerSizeRecord -> SISec
minTransitTime PerSizeRecord
b)
, count :: Key
count = PerSizeRecord -> Key
count PerSizeRecord
a Key -> Key -> Key
forall a. Num a => a -> a -> a
+ PerSizeRecord -> Key
count PerSizeRecord
b
, sumTransitTime :: SISec
sumTransitTime = PerSizeRecord -> SISec
sumTransitTime PerSizeRecord
a SISec -> SISec -> SISec
forall a. Num a => a -> a -> a
+ PerSizeRecord -> SISec
sumTransitTime PerSizeRecord
b
, sumTransitTimeSq :: SISec2
sumTransitTimeSq = PerSizeRecord -> SISec2
sumTransitTimeSq PerSizeRecord
a SISec2 -> SISec2 -> SISec2
forall a. Num a => a -> a -> a
+ PerSizeRecord -> SISec2
sumTransitTimeSq PerSizeRecord
b
}
normalisePSR :: SISec -> PerSizeRecord -> PerSizeRecord
normalisePSR :: SISec -> PerSizeRecord -> PerSizeRecord
normalisePSR SISec
norm PerSizeRecord
psr
= let adj :: SISec
adj = (Key -> SISec
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PerSizeRecord -> Key
count PerSizeRecord
psr) SISec -> SISec -> SISec
forall a. Num a => a -> a -> a
* SISec
norm)
stt' :: SISec
stt' = (PerSizeRecord -> SISec
sumTransitTime PerSizeRecord
psr) SISec -> SISec -> SISec
forall a. Num a => a -> a -> a
- SISec
adj
ttt :: SISec -> SISec -> SISec2
ttt (S Float
a) (S Float
b)
= Float -> SISec2
S2 (Float -> SISec2) -> Float -> SISec2
forall a b. (a -> b) -> a -> b
$ Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b
in PerSizeRecord
psr { minTransitTime = minTransitTime psr - norm
, sumTransitTime = stt'
, sumTransitTimeSq = sumTransitTimeSq psr
- norm `ttt` (2 * stt' + norm)
}
initialStatsA :: StatsA
initialStatsA :: StatsA
initialStatsA = StatsA
{ referenceTimePoint :: Maybe (Word32, Time)
referenceTimePoint = Maybe (Word32, Time)
forall a. Maybe a
Nothing
, nextSampleAt :: Time
nextSampleAt = Time
noTime
, numObservations :: Key
numObservations = Key
0
, timeLastObs :: Time
timeLastObs = Time
noTime
, observables :: IntMap PerSizeRecord
observables = IntMap PerSizeRecord
forall a. IntMap a
IM.empty
}
where
noTime :: Time
noTime = DiffTime -> Time
Time DiffTime
0
makePerSizeRecord :: SISec -> PerSizeRecord
makePerSizeRecord :: SISec -> PerSizeRecord
makePerSizeRecord SISec
tt = PSR
{ minTransitTime :: SISec
minTransitTime = SISec
tt
, count :: Key
count = Key
1
, sumTransitTime :: SISec
sumTransitTime = SISec
tt
, sumTransitTimeSq :: SISec2
sumTransitTimeSq = SISec -> SISec2
squareSISec SISec
tt
}
sampleInterval :: DiffTime
sampleInterval :: DiffTime
sampleInterval = DiffTime -> DiffTime
check DiffTime
10
where
check :: DiffTime -> DiffTime
check DiffTime
n
| DiffTime
n DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> DiffTime
0 Bool -> Bool -> Bool
&& DiffTime
n DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime
wrapInterval
= DiffTime
n
| Bool
otherwise
= String -> DiffTime
forall a. HasCallStack => String -> a
error String
"Infeasible sampleInterval"
wrapInterval :: DiffTime
wrapInterval
= DiffTime
remoteClockPrecision DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* (Word32 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> DiffTime) -> Word32 -> DiffTime
forall a b. (a -> b) -> a -> b
$ RemoteClockModel -> Word32
unRemoteClockModel RemoteClockModel
forall a. Bounded a => a
maxBound)
nan :: Double
nan :: Double
nan = Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0