{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
-- | A histogram with an exponentially decaying reservoir produces quantiles which are representative of (roughly) the last five minutes of data.
-- It does so by using a forward-decaying priority reservoir with an exponential weighting towards newer data.
-- Unlike the uniform reservoir, an exponentially decaying reservoir represents recent data, allowing you to know very quickly if the distribution of the data has changed.
-- Timers use histograms with exponentially decaying reservoirs by default.
module Data.Metrics.Reservoir.ExponentiallyDecaying (
  ExponentiallyDecayingReservoir,
  standardReservoir,
  reservoir,
  clear,
  size,
  snapshot,
  rescale,
  update
) where
import Control.Lens
import Control.Lens.TH
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Metrics.Internal
import qualified Data.Map as M
import qualified Data.Metrics.Reservoir as R
import Data.Metrics.Snapshot (Snapshot(..), takeSnapshot)
import Data.Primitive.MutVar
import qualified Data.Vector.Unboxed as V
import Data.Word
import System.PosixCompat.Time
import System.Posix.Types
import System.Random.MWC

-- hours in seconds
baseRescaleThreshold :: Word64
baseRescaleThreshold :: Word64
baseRescaleThreshold = Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60

-- | A forward-decaying priority reservoir
--
-- <http://dimacs.rutgers.edu/~graham/pubs/papers/fwddecay.pdf>
data ExponentiallyDecayingReservoir = ExponentiallyDecayingReservoir
  { ExponentiallyDecayingReservoir -> Int
exponentiallyDecayingReservoirInnerSize        :: {-# UNPACK #-} !Int
  , ExponentiallyDecayingReservoir -> Double
exponentiallyDecayingReservoirAlpha            :: {-# UNPACK #-} !Double
  , ExponentiallyDecayingReservoir -> Word64
exponentiallyDecayingReservoirRescaleThreshold :: {-# UNPACK #-} !Word64
  , ExponentiallyDecayingReservoir -> Map Double Double
exponentiallyDecayingReservoirInnerReservoir   :: !(M.Map Double Double)
  , ExponentiallyDecayingReservoir -> Int
exponentiallyDecayingReservoirCount            :: {-# UNPACK #-} !Int
  , ExponentiallyDecayingReservoir -> Word64
exponentiallyDecayingReservoirStartTime        :: {-# UNPACK #-} !Word64
  , ExponentiallyDecayingReservoir -> Word64
exponentiallyDecayingReservoirNextScaleTime    :: {-# UNPACK #-} !Word64
  , ExponentiallyDecayingReservoir -> Seed
exponentiallyDecayingReservoirSeed :: !Seed
  } deriving (Int -> ExponentiallyDecayingReservoir -> ShowS
[ExponentiallyDecayingReservoir] -> ShowS
ExponentiallyDecayingReservoir -> String
(Int -> ExponentiallyDecayingReservoir -> ShowS)
-> (ExponentiallyDecayingReservoir -> String)
-> ([ExponentiallyDecayingReservoir] -> ShowS)
-> Show ExponentiallyDecayingReservoir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExponentiallyDecayingReservoir -> ShowS
showsPrec :: Int -> ExponentiallyDecayingReservoir -> ShowS
$cshow :: ExponentiallyDecayingReservoir -> String
show :: ExponentiallyDecayingReservoir -> String
$cshowList :: [ExponentiallyDecayingReservoir] -> ShowS
showList :: [ExponentiallyDecayingReservoir] -> ShowS
Show)

makeFields ''ExponentiallyDecayingReservoir

-- | An exponentially decaying reservoir with an alpha value of 0.015 and a 1028 sample cap.
--
-- This offers a 99.9% confidence level with a 5% margin of error assuming a normal distribution,
-- and an alpha factor of 0.015, which heavily biases the reservoir to the past 5 minutes of measurements.
standardReservoir :: NominalDiffTime -> Seed -> R.Reservoir
standardReservoir :: NominalDiffTime -> Seed -> Reservoir
standardReservoir = Double -> Int -> NominalDiffTime -> Seed -> Reservoir
reservoir Double
0.015 Int
1028

-- | Create a reservoir with a custom alpha factor and reservoir size.
reservoir :: Double -- ^ alpha value
  -> Int -- ^ max reservoir size
  -> NominalDiffTime -- ^ creation time for the reservoir
  -> Seed -> R.Reservoir
reservoir :: Double -> Int -> NominalDiffTime -> Seed -> Reservoir
reservoir Double
a Int
r NominalDiffTime
t Seed
s = R.Reservoir
  { reservoirClear :: NominalDiffTime
-> ExponentiallyDecayingReservoir -> ExponentiallyDecayingReservoir
R.reservoirClear = NominalDiffTime
-> ExponentiallyDecayingReservoir -> ExponentiallyDecayingReservoir
clear
  , reservoirSize :: ExponentiallyDecayingReservoir -> Int
R.reservoirSize = ExponentiallyDecayingReservoir -> Int
size
  , reservoirSnapshot :: ExponentiallyDecayingReservoir -> Snapshot
R.reservoirSnapshot = ExponentiallyDecayingReservoir -> Snapshot
snapshot
  , reservoirUpdate :: Double
-> NominalDiffTime
-> ExponentiallyDecayingReservoir
-> ExponentiallyDecayingReservoir
R.reservoirUpdate = Double
-> NominalDiffTime
-> ExponentiallyDecayingReservoir
-> ExponentiallyDecayingReservoir
update
  , reservoirState :: ExponentiallyDecayingReservoir
R.reservoirState = Int
-> Double
-> Word64
-> Map Double Double
-> Int
-> Word64
-> Word64
-> Seed
-> ExponentiallyDecayingReservoir
ExponentiallyDecayingReservoir Int
r Double
a Word64
baseRescaleThreshold Map Double Double
forall k a. Map k a
M.empty Int
0 Word64
c Word64
c' Seed
s
  }
  where
    c :: Word64
c = NominalDiffTime -> Word64
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate NominalDiffTime
t
    c' :: Word64
c' = Word64
c Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
baseRescaleThreshold

-- | Reset the reservoir
clear :: NominalDiffTime -> ExponentiallyDecayingReservoir -> ExponentiallyDecayingReservoir
clear :: NominalDiffTime
-> ExponentiallyDecayingReservoir -> ExponentiallyDecayingReservoir
clear = NominalDiffTime
-> ExponentiallyDecayingReservoir -> ExponentiallyDecayingReservoir
forall {a} {b} {b} {b} {k} {a}.
(RealFrac a, Integral b, HasRescaleThreshold b b, HasStartTime b b,
 HasNextScaleTime b b, HasCount b b, HasInnerReservoir b (Map k a),
 Num b) =>
a -> b -> b
go
  where
    go :: a -> b -> b
go a
t b
c = b
c b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (b -> Identity b) -> b -> Identity b
forall s a. HasStartTime s a => Lens' s a
Lens' b b
startTime ((b -> Identity b) -> b -> Identity b) -> b -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
t' b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (b -> Identity b) -> b -> Identity b
forall s a. HasNextScaleTime s a => Lens' s a
Lens' b b
nextScaleTime ((b -> Identity b) -> b -> Identity b) -> b -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
t'' b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (b -> Identity b) -> b -> Identity b
forall s a. HasCount s a => Lens' s a
Lens' b b
count ((b -> Identity b) -> b -> Identity b) -> b -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
0 b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (Map k a -> Identity (Map k a)) -> b -> Identity b
forall s a. HasInnerReservoir s a => Lens' s a
Lens' b (Map k a)
innerReservoir ((Map k a -> Identity (Map k a)) -> b -> Identity b)
-> Map k a -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map k a
forall k a. Map k a
M.empty
      where
        t' :: b
t' = a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate a
t
        t'' :: b
t'' = b
t' b -> b -> b
forall a. Num a => a -> a -> a
+ b
c b -> Getting b b b -> b
forall s a. s -> Getting a s a -> a
^. Getting b b b
forall s a. HasRescaleThreshold s a => Lens' s a
Lens' b b
rescaleThreshold
{-# INLINEABLE clear #-}

-- | Get the current size of the reservoir.
size :: ExponentiallyDecayingReservoir -> Int
size :: ExponentiallyDecayingReservoir -> Int
size = ExponentiallyDecayingReservoir -> Int
forall {s} {a}. (HasInnerSize s a, HasCount s a, Ord a) => s -> a
go
  where
    go :: s -> a
go s
r = a -> a -> a
forall a. Ord a => a -> a -> a
min a
c a
s
      where
        c :: a
c = s
r s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasCount s a => Lens' s a
Lens' s a
count
        s :: a
s = s
r s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasInnerSize s a => Lens' s a
Lens' s a
innerSize
{-# INLINEABLE size #-}

-- | Get a snapshot of the current reservoir
snapshot :: ExponentiallyDecayingReservoir -> Snapshot
snapshot :: ExponentiallyDecayingReservoir -> Snapshot
snapshot ExponentiallyDecayingReservoir
r = (forall s. ST s Snapshot) -> Snapshot
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Snapshot) -> Snapshot)
-> (forall s. ST s Snapshot) -> Snapshot
forall a b. (a -> b) -> a -> b
$ do
  let svals :: Vector Double
svals = [Double] -> Vector Double
forall a. Unbox a => [a] -> Vector a
V.fromList ([Double] -> Vector Double) -> [Double] -> Vector Double
forall a b. (a -> b) -> a -> b
$ Map Double Double -> [Double]
forall k a. Map k a -> [a]
M.elems (Map Double Double -> [Double]) -> Map Double Double -> [Double]
forall a b. (a -> b) -> a -> b
$ ExponentiallyDecayingReservoir
r ExponentiallyDecayingReservoir
-> Getting
     (Map Double Double)
     ExponentiallyDecayingReservoir
     (Map Double Double)
-> Map Double Double
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Double Double)
  ExponentiallyDecayingReservoir
  (Map Double Double)
forall s a. HasInnerReservoir s a => Lens' s a
Lens' ExponentiallyDecayingReservoir (Map Double Double)
innerReservoir
  mvals <- Vector Double -> ST s (MVector (PrimState (ST s)) Double)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw Vector Double
svals
  takeSnapshot mvals
{-# INLINEABLE snapshot #-}

weight :: Double -> Word64 -> Double
weight :: Double -> Word64 -> Double
weight Double
alpha Word64
t = Double -> Double
forall a. Floating a => a -> a
exp (Double
alpha Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t)
{-# INLINE weight #-}

-- | \"A common feature of the above techniques—indeed, the key technique that
-- allows us to track the decayed weights efficiently – is that they maintain
-- counts and other quantities based on g(ti − L), and only scale by g(t − L)
-- at query time. But while g(ti −L)/g(t−L) is guaranteed to lie between zero
-- and one, the intermediate values of g(ti − L) could become very large. For
-- polynomial functions, these values should not grow too large, and should be
-- effectively represented in practice by floating point values without loss of
-- precision. For exponential functions, these values could grow quite large as
-- new values of (ti − L) become large, and potentially exceed the capacity of
-- common floating point types. However, since the values stored by the
-- algorithms are linear combinations of g values (scaled sums), they can be
-- rescaled relative to a new landmark. That is, by the analysis of exponential
-- decay in Section III-A, the choice of L does not affect the final result. We
-- can therefore multiply each value based on L by a factor of exp(−α(L′ − L)),
-- and obtain the correct value as if we had instead computed relative to a new
-- landmark L′ (and then use this new L′ at query time). This can be done with
-- a linear pass over whatever data structure is being used.\"
rescale :: Word64 -> ExponentiallyDecayingReservoir -> ExponentiallyDecayingReservoir
rescale :: Word64
-> ExponentiallyDecayingReservoir -> ExponentiallyDecayingReservoir
rescale Word64
now ExponentiallyDecayingReservoir
c = ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> (ExponentiallyDecayingReservoir
    -> ExponentiallyDecayingReservoir)
-> ExponentiallyDecayingReservoir
forall a b. a -> (a -> b) -> b
& (Word64 -> Identity Word64)
-> ExponentiallyDecayingReservoir
-> Identity ExponentiallyDecayingReservoir
forall s a. HasStartTime s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Word64
startTime ((Word64 -> Identity Word64)
 -> ExponentiallyDecayingReservoir
 -> Identity ExponentiallyDecayingReservoir)
-> Word64
-> ExponentiallyDecayingReservoir
-> ExponentiallyDecayingReservoir
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
now ExponentiallyDecayingReservoir
-> (ExponentiallyDecayingReservoir
    -> ExponentiallyDecayingReservoir)
-> ExponentiallyDecayingReservoir
forall a b. a -> (a -> b) -> b
& (Word64 -> Identity Word64)
-> ExponentiallyDecayingReservoir
-> Identity ExponentiallyDecayingReservoir
forall s a. HasNextScaleTime s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Word64
nextScaleTime ((Word64 -> Identity Word64)
 -> ExponentiallyDecayingReservoir
 -> Identity ExponentiallyDecayingReservoir)
-> Word64
-> ExponentiallyDecayingReservoir
-> ExponentiallyDecayingReservoir
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
st ExponentiallyDecayingReservoir
-> (ExponentiallyDecayingReservoir
    -> ExponentiallyDecayingReservoir)
-> ExponentiallyDecayingReservoir
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int)
-> ExponentiallyDecayingReservoir
-> Identity ExponentiallyDecayingReservoir
forall s a. HasCount s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Int
count ((Int -> Identity Int)
 -> ExponentiallyDecayingReservoir
 -> Identity ExponentiallyDecayingReservoir)
-> Int
-> ExponentiallyDecayingReservoir
-> ExponentiallyDecayingReservoir
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Double Double -> Int
forall k a. Map k a -> Int
M.size Map Double Double
adjustedReservoir ExponentiallyDecayingReservoir
-> (ExponentiallyDecayingReservoir
    -> ExponentiallyDecayingReservoir)
-> ExponentiallyDecayingReservoir
forall a b. a -> (a -> b) -> b
& (Map Double Double -> Identity (Map Double Double))
-> ExponentiallyDecayingReservoir
-> Identity ExponentiallyDecayingReservoir
forall s a. HasInnerReservoir s a => Lens' s a
Lens' ExponentiallyDecayingReservoir (Map Double Double)
innerReservoir ((Map Double Double -> Identity (Map Double Double))
 -> ExponentiallyDecayingReservoir
 -> Identity ExponentiallyDecayingReservoir)
-> Map Double Double
-> ExponentiallyDecayingReservoir
-> ExponentiallyDecayingReservoir
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Double Double
adjustedReservoir
  where
    potentialScaleTime :: Word64
potentialScaleTime = Word64
now Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
baseRescaleThreshold
    currentScaleTime :: Word64
currentScaleTime = ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting Word64 ExponentiallyDecayingReservoir Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 ExponentiallyDecayingReservoir Word64
forall s a. HasNextScaleTime s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Word64
nextScaleTime
    st :: Word64
st = if Word64
potentialScaleTime Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
currentScaleTime then Word64
potentialScaleTime else Word64
currentScaleTime
    diff :: Word64
diff = Word64
now Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting Word64 ExponentiallyDecayingReservoir Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 ExponentiallyDecayingReservoir Word64
forall s a. HasStartTime s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Word64
startTime
    adjustKey :: Double -> Double
adjustKey Double
x = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
exp (-Double
_alpha Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
diff)
    adjustedReservoir :: Map Double Double
adjustedReservoir = (Double -> Double) -> Map Double Double -> Map Double Double
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Double -> Double
adjustKey (Map Double Double -> Map Double Double)
-> Map Double Double -> Map Double Double
forall a b. (a -> b) -> a -> b
$ ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting
     (Map Double Double)
     ExponentiallyDecayingReservoir
     (Map Double Double)
-> Map Double Double
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Double Double)
  ExponentiallyDecayingReservoir
  (Map Double Double)
forall s a. HasInnerReservoir s a => Lens' s a
Lens' ExponentiallyDecayingReservoir (Map Double Double)
innerReservoir
    _alpha :: Double
_alpha = ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting Double ExponentiallyDecayingReservoir Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ExponentiallyDecayingReservoir Double
forall s a. HasAlpha s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Double
alpha
{-# INLINEABLE rescale #-}

-- | Insert a new sample into the reservoir. This may cause old sample values to be evicted
-- based upon the probabilistic weighting given to the key at insertion time.
update :: Double -- ^ new sample value
  -> NominalDiffTime -- ^ time of update
  -> ExponentiallyDecayingReservoir
  -> ExponentiallyDecayingReservoir
update :: Double
-> NominalDiffTime
-> ExponentiallyDecayingReservoir
-> ExponentiallyDecayingReservoir
update Double
v NominalDiffTime
t ExponentiallyDecayingReservoir
c = ExponentiallyDecayingReservoir
rescaled ExponentiallyDecayingReservoir
-> (ExponentiallyDecayingReservoir
    -> ExponentiallyDecayingReservoir)
-> ExponentiallyDecayingReservoir
forall a b. a -> (a -> b) -> b
& (Seed -> Identity Seed)
-> ExponentiallyDecayingReservoir
-> Identity ExponentiallyDecayingReservoir
forall s a. HasSeed s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Seed
seed ((Seed -> Identity Seed)
 -> ExponentiallyDecayingReservoir
 -> Identity ExponentiallyDecayingReservoir)
-> Seed
-> ExponentiallyDecayingReservoir
-> ExponentiallyDecayingReservoir
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seed
s' ExponentiallyDecayingReservoir
-> (ExponentiallyDecayingReservoir
    -> ExponentiallyDecayingReservoir)
-> ExponentiallyDecayingReservoir
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int)
-> ExponentiallyDecayingReservoir
-> Identity ExponentiallyDecayingReservoir
forall s a. HasCount s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Int
count ((Int -> Identity Int)
 -> ExponentiallyDecayingReservoir
 -> Identity ExponentiallyDecayingReservoir)
-> Int
-> ExponentiallyDecayingReservoir
-> ExponentiallyDecayingReservoir
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newCount ExponentiallyDecayingReservoir
-> (ExponentiallyDecayingReservoir
    -> ExponentiallyDecayingReservoir)
-> ExponentiallyDecayingReservoir
forall a b. a -> (a -> b) -> b
& (Map Double Double -> Identity (Map Double Double))
-> ExponentiallyDecayingReservoir
-> Identity ExponentiallyDecayingReservoir
forall s a. HasInnerReservoir s a => Lens' s a
Lens' ExponentiallyDecayingReservoir (Map Double Double)
innerReservoir ((Map Double Double -> Identity (Map Double Double))
 -> ExponentiallyDecayingReservoir
 -> Identity ExponentiallyDecayingReservoir)
-> Map Double Double
-> ExponentiallyDecayingReservoir
-> ExponentiallyDecayingReservoir
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Double Double -> Map Double Double
addValue Map Double Double
r
  where
    rescaled :: ExponentiallyDecayingReservoir
rescaled = if Word64
seconds Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting Word64 ExponentiallyDecayingReservoir Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 ExponentiallyDecayingReservoir Word64
forall s a. HasNextScaleTime s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Word64
nextScaleTime
      then Word64
-> ExponentiallyDecayingReservoir -> ExponentiallyDecayingReservoir
rescale Word64
seconds ExponentiallyDecayingReservoir
c
      else ExponentiallyDecayingReservoir
c
    seconds :: Word64
seconds = NominalDiffTime -> Word64
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate NominalDiffTime
t
    priority :: Double
priority = Double -> Word64 -> Double
weight (ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting Double ExponentiallyDecayingReservoir Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ExponentiallyDecayingReservoir Double
forall s a. HasAlpha s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Double
alpha) (Word64
seconds Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting Word64 ExponentiallyDecayingReservoir Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 ExponentiallyDecayingReservoir Word64
forall s a. HasStartTime s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Word64
startTime) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
priorityDenom
    addValue :: Map Double Double -> Map Double Double
addValue Map Double Double
r = if Int
newCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting Int ExponentiallyDecayingReservoir Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int ExponentiallyDecayingReservoir Int
forall s a. HasInnerSize s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Int
innerSize)
      then Double -> Double -> Map Double Double -> Map Double Double
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Double
priority Double
v Map Double Double
r
      else if Double
firstKey Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
priority
        -- it should be safe to use head here since we are over our reservoir capacity at this point
        -- caveat: reservoir capped at 0 max size
        then Double -> Map Double Double -> Map Double Double
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Double
firstKey (Map Double Double -> Map Double Double)
-> Map Double Double -> Map Double Double
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Double)
-> Double -> Double -> Map Double Double -> Map Double Double
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Double -> Double -> Double
forall a b. a -> b -> a
const Double
priority Double
v Map Double Double
r
        else Map Double Double
r
    r :: Map Double Double
r = ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting
     (Map Double Double)
     ExponentiallyDecayingReservoir
     (Map Double Double)
-> Map Double Double
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Double Double)
  ExponentiallyDecayingReservoir
  (Map Double Double)
forall s a. HasInnerReservoir s a => Lens' s a
Lens' ExponentiallyDecayingReservoir (Map Double Double)
innerReservoir
    firstKey :: Double
firstKey = [Double] -> Double
forall a. HasCallStack => [a] -> a
head ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ Map Double Double -> [Double]
forall k a. Map k a -> [k]
M.keys Map Double Double
r
    newCount :: Int
newCount = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting Int ExponentiallyDecayingReservoir Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int ExponentiallyDecayingReservoir Int
forall s a. HasCount s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Int
count
    (Double
priorityDenom, Seed
s') = (forall s. ST s (Double, Seed)) -> (Double, Seed)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Double, Seed)) -> (Double, Seed))
-> (forall s. ST s (Double, Seed)) -> (Double, Seed)
forall a b. (a -> b) -> a -> b
$ do
      g <- Seed -> ST s (Gen (PrimState (ST s)))
forall (m :: * -> *). PrimMonad m => Seed -> m (Gen (PrimState m))
restore (Seed -> ST s (Gen (PrimState (ST s))))
-> Seed -> ST s (Gen (PrimState (ST s)))
forall a b. (a -> b) -> a -> b
$ ExponentiallyDecayingReservoir
c ExponentiallyDecayingReservoir
-> Getting Seed ExponentiallyDecayingReservoir Seed -> Seed
forall s a. s -> Getting a s a -> a
^. Getting Seed ExponentiallyDecayingReservoir Seed
forall s a. HasSeed s a => Lens' s a
Lens' ExponentiallyDecayingReservoir Seed
seed
      p <- uniform g
      s' <- save g
      return (p :: Double, s')
{-# INLINEABLE update #-}