-- | The Relative Error Quantile (REQ) sketch provides extremely high accuracy at a chosen end of the rank domain. 
-- This is best illustrated with some rank domain accuracy plots that compare the KLL quantiles sketch to the REQ sketch.
--
-- This first plot illustrates the typical error behavior of the KLL sketch (also the quantiles/DoublesSketch). 
-- The error is flat for all ranks (0, 1). The green and yellow lines correspond to +/- one RSE at 68% confidence; 
-- the blue and red lines, +/- two RSE at 95% confidence; and, the purple and brown lines +/- 3 RSE at 99% confidence. 
-- The reason all the curves pinch at 0 and 1.0, is because the sketch knows with certainty that a request for a quantile at 
-- rank = 0 is the minimum value of the stream; and a request for a quantiles at rank = 1.0, is the maximum value of the stream. 
-- Both of which the sketch tracks.
--
-- ![KLL Gaussian Error Quantiles](docs/images/KllErrorK100SL11.png)
--
-- The next plot is the exact same data and queries fed to the REQ sketch set for High Rank Accuracy (HRA) mode. 
-- In this plot, starting at a rank of about 0.3, the contour lines start converging and actually reach zero error at 
-- rank 1.0. Therefore the error (the inverse of accuracy) is relative to the requested rank, thus the name of the sketch. 
-- This means that the user can perform getQuantile(rank) queries, where rank = .99999 and get accurate results.
--
-- ![ReqSketch Gaussian Error Quantiles - HighRankAccuracy](docs/images/ReqErrorHraK12SL11_LT.png)
--
-- This next plot is also the same data and queries, except the REQ sketch was configured for Low Rank Accuracy (LRA). In this case the user can perform getQuantiles(rank) queries, where rank = .00001 and get accurate results.
--
-- ![ReqSketch Gaussian Error Quantiles - LowRankAccuracy](docs/images/ReqErrorLraK12SL11_LE.png)

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveGeneric #-}
module DataSketches.Quantiles.RelativeErrorQuantile (
  -- * Construction
    ReqSketch (criterion)
  , mkReqSketch
  -- ** Configuration settings
  , RankAccuracy(..)
  , Criterion(..)
  -- * Sketch summaries
  , count
  , null
  , sum
  , maximum
  , minimum
  , retainedItemCount
  , relativeStandardError
  , countWithCriterion
  , probabilityMassFunction
  , quantile
  , quantiles
  , rank
  , rankLowerBound
  , ranks
  , rankUpperBound
  , cumulativeDistributionFunction
  , getK
  -- * Updating the sketch
  , merge
  , insert
  , rankAccuracy
  , isEstimationMode
  , isLessThanOrEqual
  -- | If you see this error, please file an issue in the GitHub repository.
  , CumulativeDistributionInvariants(..)
  ) where

import Control.Monad (when, unless, foldM, foldM_)
import Control.Monad.Primitive ( PrimMonad(PrimState) )
import Data.Bits (shiftL)
import Data.Vector ((!), imapM_)
import qualified Data.Vector as Vector
import Data.Primitive.MutVar
    ( modifyMutVar', newMutVar, readMutVar, writeMutVar )
import Data.Word ( Word32, Word64 )
import DataSketches.Quantiles.RelativeErrorQuantile.Internal.Constants
    ( fixRseFactor, initNumberOfSections, relRseFactor )
import DataSketches.Quantiles.RelativeErrorQuantile.Types
    ( Criterion(..), RankAccuracy(..) )
import DataSketches.Quantiles.RelativeErrorQuantile.Internal.Compactor (ReqCompactor)
import DataSketches.Quantiles.RelativeErrorQuantile.Internal.Auxiliary (ReqAuxiliary)
import DataSketches.Quantiles.RelativeErrorQuantile.Internal
    ( count,
      retainedItemCount,
      CumulativeDistributionInvariants(..),
      ReqSketch(..),
      computeTotalRetainedItems,
      getCompactors )
import qualified DataSketches.Quantiles.RelativeErrorQuantile.Internal.Auxiliary as Auxiliary
import qualified DataSketches.Quantiles.RelativeErrorQuantile.Internal.Compactor as Compactor
import qualified DataSketches.Quantiles.RelativeErrorQuantile.Internal.DoubleBuffer as DoubleBuffer
import DataSketches.Core.Internal.URef
    ( modifyURef, newURef, readURef, writeURef )
import Data.Maybe (isNothing)
import qualified Data.Foldable
import qualified Data.List
import GHC.Exception.Type (Exception)
import Control.Exception (throw, assert)
import System.Random.MWC (Gen, create)
import qualified Data.Vector.Generic.Mutable as MG
import Prelude hiding (sum, minimum, maximum, null)

-- | The K parameter can be increased to trade increased space efficiency for higher accuracy in rank and quantile
-- calculations. Due to the way the compaction algorithm works, it must be an even number between 4 and 1024.
--
-- A good starting number when in doubt is 6.
mkReqSketch :: forall m. (PrimMonad m)
  => Word32 -- ^ K
  -> RankAccuracy
  -> m (ReqSketch (PrimState m))
mkReqSketch :: forall (m :: * -> *).
PrimMonad m =>
Word32 -> RankAccuracy -> m (ReqSketch (PrimState m))
mkReqSketch Word32
k RankAccuracy
rank = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32 -> Bool
forall a. Integral a => a -> Bool
even Word32
k Bool -> Bool -> Bool
&& Word32
k Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
4 Bool -> Bool -> Bool
&& Word32
k Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
1024) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"k must be divisible by 2, and satisfy 4 <= k <= 1024"
  r <- Word32
-> RankAccuracy
-> Criterion
-> Gen (PrimState m)
-> URef (PrimState m) Word64
-> URef (PrimState m) Double
-> URef (PrimState m) Double
-> URef (PrimState m) Double
-> URef (PrimState m) Int
-> URef (PrimState m) Int
-> MutVar (PrimState m) (Maybe ReqAuxiliary)
-> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
-> ReqSketch (PrimState m)
forall s.
Word32
-> RankAccuracy
-> Criterion
-> Gen s
-> URef s Word64
-> URef s Double
-> URef s Double
-> URef s Double
-> URef s Int
-> URef s Int
-> MutVar s (Maybe ReqAuxiliary)
-> MutVar s (Vector (ReqCompactor s))
-> ReqSketch s
ReqSketch Word32
k RankAccuracy
rank Criterion
(:<)
    (Gen (PrimState m)
 -> URef (PrimState m) Word64
 -> URef (PrimState m) Double
 -> URef (PrimState m) Double
 -> URef (PrimState m) Double
 -> URef (PrimState m) Int
 -> URef (PrimState m) Int
 -> MutVar (PrimState m) (Maybe ReqAuxiliary)
 -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
 -> ReqSketch (PrimState m))
-> m (Gen (PrimState m))
-> m (URef (PrimState m) Word64
      -> URef (PrimState m) Double
      -> URef (PrimState m) Double
      -> URef (PrimState m) Double
      -> URef (PrimState m) Int
      -> URef (PrimState m) Int
      -> MutVar (PrimState m) (Maybe ReqAuxiliary)
      -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
      -> ReqSketch (PrimState m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Gen (PrimState m))
forall (m :: * -> *). PrimMonad m => m (Gen (PrimState m))
create
    m (URef (PrimState m) Word64
   -> URef (PrimState m) Double
   -> URef (PrimState m) Double
   -> URef (PrimState m) Double
   -> URef (PrimState m) Int
   -> URef (PrimState m) Int
   -> MutVar (PrimState m) (Maybe ReqAuxiliary)
   -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
   -> ReqSketch (PrimState m))
-> m (URef (PrimState m) Word64)
-> m (URef (PrimState m) Double
      -> URef (PrimState m) Double
      -> URef (PrimState m) Double
      -> URef (PrimState m) Int
      -> URef (PrimState m) Int
      -> MutVar (PrimState m) (Maybe ReqAuxiliary)
      -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
      -> ReqSketch (PrimState m))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word64 -> m (URef (PrimState m) Word64)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef Word64
0
    m (URef (PrimState m) Double
   -> URef (PrimState m) Double
   -> URef (PrimState m) Double
   -> URef (PrimState m) Int
   -> URef (PrimState m) Int
   -> MutVar (PrimState m) (Maybe ReqAuxiliary)
   -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
   -> ReqSketch (PrimState m))
-> m (URef (PrimState m) Double)
-> m (URef (PrimState m) Double
      -> URef (PrimState m) Double
      -> URef (PrimState m) Int
      -> URef (PrimState m) Int
      -> MutVar (PrimState m) (Maybe ReqAuxiliary)
      -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
      -> ReqSketch (PrimState m))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Double -> m (URef (PrimState m) Double)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef (Double
0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
    m (URef (PrimState m) Double
   -> URef (PrimState m) Double
   -> URef (PrimState m) Int
   -> URef (PrimState m) Int
   -> MutVar (PrimState m) (Maybe ReqAuxiliary)
   -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
   -> ReqSketch (PrimState m))
-> m (URef (PrimState m) Double)
-> m (URef (PrimState m) Double
      -> URef (PrimState m) Int
      -> URef (PrimState m) Int
      -> MutVar (PrimState m) (Maybe ReqAuxiliary)
      -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
      -> ReqSketch (PrimState m))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Double -> m (URef (PrimState m) Double)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef (Double
0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
    m (URef (PrimState m) Double
   -> URef (PrimState m) Int
   -> URef (PrimState m) Int
   -> MutVar (PrimState m) (Maybe ReqAuxiliary)
   -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
   -> ReqSketch (PrimState m))
-> m (URef (PrimState m) Double)
-> m (URef (PrimState m) Int
      -> URef (PrimState m) Int
      -> MutVar (PrimState m) (Maybe ReqAuxiliary)
      -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
      -> ReqSketch (PrimState m))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Double -> m (URef (PrimState m) Double)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef Double
0
    m (URef (PrimState m) Int
   -> URef (PrimState m) Int
   -> MutVar (PrimState m) (Maybe ReqAuxiliary)
   -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
   -> ReqSketch (PrimState m))
-> m (URef (PrimState m) Int)
-> m (URef (PrimState m) Int
      -> MutVar (PrimState m) (Maybe ReqAuxiliary)
      -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
      -> ReqSketch (PrimState m))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> m (URef (PrimState m) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef Int
0
    m (URef (PrimState m) Int
   -> MutVar (PrimState m) (Maybe ReqAuxiliary)
   -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
   -> ReqSketch (PrimState m))
-> m (URef (PrimState m) Int)
-> m (MutVar (PrimState m) (Maybe ReqAuxiliary)
      -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
      -> ReqSketch (PrimState m))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> m (URef (PrimState m) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef Int
0
    m (MutVar (PrimState m) (Maybe ReqAuxiliary)
   -> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
   -> ReqSketch (PrimState m))
-> m (MutVar (PrimState m) (Maybe ReqAuxiliary))
-> m (MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
      -> ReqSketch (PrimState m))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ReqAuxiliary -> m (MutVar (PrimState m) (Maybe ReqAuxiliary))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar Maybe ReqAuxiliary
forall a. Maybe a
Nothing
    m (MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
   -> ReqSketch (PrimState m))
-> m (MutVar (PrimState m) (Vector (ReqCompactor (PrimState m))))
-> m (ReqSketch (PrimState m))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vector (ReqCompactor (PrimState m))
-> m (MutVar (PrimState m) (Vector (ReqCompactor (PrimState m))))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar Vector (ReqCompactor (PrimState m))
forall a. Vector a
Vector.empty
  grow r
  pure r


getAux :: PrimMonad m => ReqSketch (PrimState m) -> m (Maybe ReqAuxiliary)
getAux :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m (Maybe ReqAuxiliary)
getAux = MutVar (PrimState m) (Maybe ReqAuxiliary) -> m (Maybe ReqAuxiliary)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (MutVar (PrimState m) (Maybe ReqAuxiliary)
 -> m (Maybe ReqAuxiliary))
-> (ReqSketch (PrimState m)
    -> MutVar (PrimState m) (Maybe ReqAuxiliary))
-> ReqSketch (PrimState m)
-> m (Maybe ReqAuxiliary)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqSketch (PrimState m)
-> MutVar (PrimState m) (Maybe ReqAuxiliary)
forall s. ReqSketch s -> MutVar s (Maybe ReqAuxiliary)
aux

getNumLevels :: PrimMonad m => ReqSketch (PrimState m) -> m Int
getNumLevels :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels = (Vector (ReqCompactor (PrimState m)) -> Int)
-> m (Vector (ReqCompactor (PrimState m))) -> m Int
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector (ReqCompactor (PrimState m)) -> Int
forall a. Vector a -> Int
Vector.length (m (Vector (ReqCompactor (PrimState m))) -> m Int)
-> (ReqSketch (PrimState m)
    -> m (Vector (ReqCompactor (PrimState m))))
-> ReqSketch (PrimState m)
-> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
getCompactors

getIsEmpty :: PrimMonad m => ReqSketch (PrimState m) -> m Bool
getIsEmpty :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty = (Word64 -> Bool) -> m Word64 -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0) (m Word64 -> m Bool)
-> (ReqSketch (PrimState m) -> m Word64)
-> ReqSketch (PrimState m)
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URef (PrimState m) Word64 -> m Word64
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef (URef (PrimState m) Word64 -> m Word64)
-> (ReqSketch (PrimState m) -> URef (PrimState m) Word64)
-> ReqSketch (PrimState m)
-> m Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqSketch (PrimState m) -> URef (PrimState m) Word64
forall s. ReqSketch s -> URef s Word64
totalN

getK :: ReqSketch s -> Word32
getK :: forall s. ReqSketch s -> Word32
getK = ReqSketch s -> Word32
forall s. ReqSketch s -> Word32
k

getMaxNominalCapacity :: PrimMonad m => ReqSketch (PrimState m) -> m Int
getMaxNominalCapacity :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getMaxNominalCapacity = URef (PrimState m) Int -> m Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef (URef (PrimState m) Int -> m Int)
-> (ReqSketch (PrimState m) -> URef (PrimState m) Int)
-> ReqSketch (PrimState m)
-> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqSketch (PrimState m) -> URef (PrimState m) Int
forall s. ReqSketch s -> URef s Int
maxNominalCapacitiesSize

validateSplits :: Monad m => [Double] -> m ()
validateSplits :: forall (m :: * -> *). Monad m => [Double] -> m ()
validateSplits [Double]
splits = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.Foldable.null [Double]
splits) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CumulativeDistributionInvariants -> m ()
forall a e. (HasCallStack, Exception e) => e -> a
throw CumulativeDistributionInvariants
CumulativeDistributionInvariantsSplitsAreEmpty
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite [Double]
splits Bool -> Bool -> Bool
|| (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN [Double]
splits) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CumulativeDistributionInvariants -> m ()
forall a e. (HasCallStack, Exception e) => e -> a
throw CumulativeDistributionInvariants
CumulativeDistributionInvariantsSplitsAreNotFinite
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Double] -> [Double]
forall a. Eq a => [a] -> [a]
Data.List.nub ([Double] -> [Double]
forall a. Ord a => [a] -> [a]
Data.List.sort [Double]
splits) [Double] -> [Double] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Double]
splits) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CumulativeDistributionInvariants -> m ()
forall a e. (HasCallStack, Exception e) => e -> a
throw CumulativeDistributionInvariants
CumulativeDistributionInvariantsSplitsAreNotUniqueAndMontonicallyIncreasing

getCounts :: (PrimMonad m) => ReqSketch (PrimState m) -> [Double] -> m [Word64]
getCounts :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> [Double] -> m [Word64]
getCounts ReqSketch (PrimState m)
this [Double]
values = do
  compactors <- ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
getCompactors ReqSketch (PrimState m)
this
  let numValues = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
values
      numCompactors = Vector (ReqCompactor (PrimState m)) -> Int
forall a. Vector a -> Int
Vector.length Vector (ReqCompactor (PrimState m))
compactors
      ans = Int -> Word64 -> [Word64]
forall a. Int -> a -> [a]
replicate Int
numValues Word64
0
  isEmpty <- getIsEmpty this
  if isEmpty
    then pure []
    else Vector.ifoldM doCount ans compactors
  where
    doCount :: [Word64] -> Int -> ReqCompactor (PrimState m) -> m [Word64]
doCount [Word64]
acc Int
index ReqCompactor (PrimState m)
compactor = do
      let wt :: Word64
wt = (Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ReqCompactor (PrimState m) -> Word8
forall s. ReqCompactor s -> Word8
Compactor.getLgWeight ReqCompactor (PrimState m)
compactor)) :: Word64
      buff <- ReqCompactor (PrimState m) -> m (DoubleBuffer (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
ReqCompactor (PrimState m) -> m (DoubleBuffer (PrimState m))
Compactor.getBuffer ReqCompactor (PrimState m)
compactor
      let updateCounts DoubleBuffer (PrimState m)
buff Word64
value = do
            count_ <- DoubleBuffer (PrimState m) -> Double -> Criterion -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> Double -> Criterion -> m Int
DoubleBuffer.getCountWithCriterion DoubleBuffer (PrimState m)
buff ([Double]
values [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
index) (ReqSketch (PrimState m) -> Criterion
forall s. ReqSketch s -> Criterion
criterion ReqSketch (PrimState m)
this)
            pure $ fromIntegral value + fromIntegral count_ * wt
      mapM (updateCounts buff) acc

getPMForCDF :: (PrimMonad m) => ReqSketch (PrimState m) -> [Double] -> m [Word64]
getPMForCDF :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> [Double] -> m [Word64]
getPMForCDF ReqSketch (PrimState m)
this [Double]
splits = do
  () <- [Double] -> m ()
forall (m :: * -> *). Monad m => [Double] -> m ()
validateSplits [Double]
splits
  let numSplits = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
splits
      numBuckets = Int
numSplits -- + 1
  splitCounts <- getCounts this splits
  n <- count this
  pure $ (++ [n]) $ take numBuckets splitCounts

-- | Returns an approximation to the Cumulative Distribution Function (CDF), which is the cumulative analog of the PMF, 
-- of the input stream given a set of splitPoint (values).
cumulativeDistributionFunction
  :: (PrimMonad m)
  => ReqSketch (PrimState m)
  -> [Double]
  -- ^ Returns an approximation to the Cumulative Distribution Function (CDF), 
  -- which is the cumulative analog of the PMF, of the input stream given a set of 
  -- splitPoint (values).
  --
  -- The resulting approximations have a probabilistic guarantee that be obtained, 
  -- a priori, from the getRSE(int, double, boolean, long) function.
  --
  -- If the sketch is empty this returns 'Nothing'.
  -> m (Maybe [Double])
cumulativeDistributionFunction :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> [Double] -> m (Maybe [Double])
cumulativeDistributionFunction ReqSketch (PrimState m)
this [Double]
splitPoints = do
  buckets <- ReqSketch (PrimState m) -> [Double] -> m [Word64]
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> [Double] -> m [Word64]
getPMForCDF ReqSketch (PrimState m)
this [Double]
splitPoints
  isEmpty <- getIsEmpty this
  if isEmpty
    then pure Nothing
    else do
      let numBuckets = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
splitPoints Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      n <- count this
      pure $ Just $ (/ fromIntegral n) . fromIntegral <$> buckets

rankAccuracy :: ReqSketch s -> RankAccuracy
rankAccuracy :: forall s. ReqSketch s -> RankAccuracy
rankAccuracy = ReqSketch s -> RankAccuracy
forall s. ReqSketch s -> RankAccuracy
rankAccuracySetting

-- | Returns an a priori estimate of relative standard error (RSE, expressed as a number in [0,1]). Derived from Lemma 12 in https://arxiv.org/abs/2004.01668v2, but the constant factors were modified based on empirical measurements.
relativeStandardError
  :: Int
  -- ^ k - the given value of k
  -> Double
  -- ^ rank - the given normalized rank, a number in [0,1].
  -> RankAccuracy
  -> Word64
  -- ^ totalN - an estimate of the total number of items submitted to the sketch.
  -> Double
  -- ^ an a priori estimate of relative standard error (RSE, expressed as a number in [0,1]).
relativeStandardError :: Int -> Double -> RankAccuracy -> Word64 -> Double
relativeStandardError Int
k Double
rank_ RankAccuracy
hra = Int -> Int -> Double -> Int -> Bool -> Word64 -> Double
getRankUB Int
k Int
2 Double
rank_ Int
1 Bool
isHra
  where
    isHra :: Bool
isHra = case RankAccuracy
hra of
      RankAccuracy
HighRanksAreAccurate -> Bool
True
      RankAccuracy
_ -> Bool
False

-- | Gets the smallest value seen by this sketch
minimum :: PrimMonad m => ReqSketch (PrimState m) -> m Double
minimum :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Double
minimum = URef (PrimState m) Double -> m Double
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef (URef (PrimState m) Double -> m Double)
-> (ReqSketch (PrimState m) -> URef (PrimState m) Double)
-> ReqSketch (PrimState m)
-> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqSketch (PrimState m) -> URef (PrimState m) Double
forall s. ReqSketch s -> URef s Double
minValue

-- | Gets the largest value seen by this sketch
maximum :: PrimMonad m => ReqSketch (PrimState m) -> m Double
maximum :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Double
maximum = URef (PrimState m) Double -> m Double
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef (URef (PrimState m) Double -> m Double)
-> (ReqSketch (PrimState m) -> URef (PrimState m) Double)
-> ReqSketch (PrimState m)
-> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqSketch (PrimState m) -> URef (PrimState m) Double
forall s. ReqSketch s -> URef s Double
maxValue

-- | Returns the approximate count of items satisfying the criterion set in the ReqSketch 'criterion' field.
countWithCriterion :: (PrimMonad m, s ~ PrimState m) => ReqSketch s -> Double -> m Word64
countWithCriterion :: forall (m :: * -> *) s.
(PrimMonad m, s ~ PrimState m) =>
ReqSketch s -> Double -> m Word64
countWithCriterion ReqSketch s
s Double
value = Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> m Word64 -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  empty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
null ReqSketch s
ReqSketch (PrimState m)
s
  if empty
    then pure 0
    else do
      compactors <- getCompactors s
      let go !Word64
accum ReqCompactor s
compactor = do
            let wt :: Word64
wt = (Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ReqCompactor s -> Word8
forall s. ReqCompactor s -> Word8
Compactor.getLgWeight ReqCompactor s
compactor)) :: Word64
            buf <- ReqCompactor (PrimState m) -> m (DoubleBuffer (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
ReqCompactor (PrimState m) -> m (DoubleBuffer (PrimState m))
Compactor.getBuffer ReqCompactor s
ReqCompactor (PrimState m)
compactor
            count_ <- DoubleBuffer.getCountWithCriterion buf value (criterion s)
            pure (accum + (fromIntegral count_ * wt))
      Vector.foldM go 0 compactors

sum :: (PrimMonad m) => ReqSketch (PrimState m) -> m Double
sum :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Double
sum = URef (PrimState m) Double -> m Double
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef (URef (PrimState m) Double -> m Double)
-> (ReqSketch (PrimState m) -> URef (PrimState m) Double)
-> ReqSketch (PrimState m)
-> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqSketch (PrimState m) -> URef (PrimState m) Double
forall s. ReqSketch s -> URef s Double
sumValue

-- | Returns an approximation to the Probability Mass Function (PMF) of the input stream given a set of splitPoints (values).
-- The resulting approximations have a probabilistic guarantee that be obtained, a priori, from the getRSE(int, double, boolean, long) function.
--
-- If the sketch is empty this returns an empty list.
probabilityMassFunction
  :: (PrimMonad m)
  => ReqSketch (PrimState m)
  -> [Double]
  -- ^ splitPoints - an array of m unique, monotonically increasing double values that divide 
  -- the real number line into m+1 consecutive disjoint intervals. The definition of an "interval" 
  -- is inclusive of the left splitPoint (or minimum value) and exclusive of the right splitPoint, 
  -- with the exception that the last interval will include the maximum value. It is not necessary 
  -- to include either the min or max values in these splitpoints.
  -> m [Double]
  -- ^ An array of m+1 doubles each of which is an approximation to the fraction of 
  -- the input stream values (the mass) that fall into one of those intervals. 
  -- The definition of an "interval" is inclusive of the left splitPoint and exclusive 
  -- of the right splitPoint, with the exception that the last interval will 
  -- include maximum value.
probabilityMassFunction :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> [Double] -> m [Double]
probabilityMassFunction ReqSketch (PrimState m)
this [Double]
splitPoints = do
  isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch (PrimState m)
this
  if isEmpty
     then pure []
     else do
       let numBuckets = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
splitPoints Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
       buckets <- fmap fromIntegral <$> getPMForCDF this splitPoints
       total <- fromIntegral <$> count this
       let computeProb (Int
0, Double
bucket) = Double
bucket Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
total
           computeProb (Int
i, Double
bucket) = (Double
prevBucket Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
bucket) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
total
             where prevBucket :: Double
prevBucket = [Double]
buckets [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1
           probs = (Int, Double) -> Double
computeProb ((Int, Double) -> Double) -> [(Int, Double)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Double] -> [(Int, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Double]
buckets
       pure probs

-- | Gets the approximate quantile of the given normalized rank based on the lteq criterion.
quantile
  :: (PrimMonad m)
  => ReqSketch (PrimState m)
  -> Double
  -- ^ normRank - the given normalized rank
  -> m Double
  -- ^ the approximate quantile given the normalized rank.
quantile :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> Double -> m Double
quantile ReqSketch (PrimState m)
this Double
normRank = do
  isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch (PrimState m)
this
  if isEmpty
     then pure (0/0)
     else do
       when (normRank < 0 || normRank > 1.0) $
         error $ "Normalized rank must be in the range [0.0, 1.0]: " ++ show normRank
       currAuxiliary <- getAux this
       when (isNothing currAuxiliary) $ do
         total <- count this
         retainedItems <- retainedItemCount this
         compactors <- getCompactors this
         newAuxiliary <- Auxiliary.mkAuxiliary (rankAccuracySetting this) total retainedItems compactors
         writeMutVar (aux this) (Just newAuxiliary)
       mAuxiliary <- getAux this
       case mAuxiliary of
         Just ReqAuxiliary
auxiliary -> Double -> m Double
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> m Double) -> Double -> m Double
forall a b. (a -> b) -> a -> b
$! ReqAuxiliary -> Double -> Criterion -> Double
Auxiliary.getQuantile ReqAuxiliary
auxiliary Double
normRank (Criterion -> Double) -> Criterion -> Double
forall a b. (a -> b) -> a -> b
$ ReqSketch (PrimState m) -> Criterion
forall s. ReqSketch s -> Criterion
criterion ReqSketch (PrimState m)
this
         Maybe ReqAuxiliary
Nothing -> [Char] -> m Double
forall a. HasCallStack => [Char] -> a
error [Char]
"invariant violated: aux is not set"

-- | Gets an array of quantiles that correspond to the given array of normalized ranks.
quantiles
  :: (PrimMonad m)
  => ReqSketch (PrimState m)
  -> [Double]
  -- ^ normRanks - the given array of normalized ranks.
  -> m [Double]
  -- ^ the array of quantiles that correspond to the given array of normalized ranks.
quantiles :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> [Double] -> m [Double]
quantiles ReqSketch (PrimState m)
this [Double]
normRanks = do
  isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch (PrimState m)
this
  if isEmpty
     then pure []
     else mapM (quantile this) normRanks

-- | Computes the normalized rank of the given value in the stream. The normalized rank is the fraction of values less than the given value; or if lteq is true, the fraction of values less than or equal to the given value.
rank :: (PrimMonad m)
  => ReqSketch (PrimState m)
  -> Double
  -- ^ value - the given value
  -> m Double
  -- ^ the normalized rank of the given value in the stream.
rank :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> Double -> m Double
rank ReqSketch (PrimState m)
s Double
value = do
  isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
null ReqSketch (PrimState m)
s
  if isEmpty
    then pure (0 / 0) -- NaN
    else do
      nnCount <- countWithCriterion s value
      total <- readURef $ totalN s
      pure (fromIntegral nnCount / fromIntegral total)


-- getRankLB k levels rank numStdDev hra totalN = if exactRank k levels rank hra totalN

-- | Returns an approximate lower bound rank of the given normalized rank.
rankLowerBound
  :: (PrimMonad m)
  => ReqSketch (PrimState m)
  -> Double
  -- ^ rank - the given rank, a value between 0 and 1.0.
  -> Int
  -- ^ numStdDev - the number of standard deviations. Must be 1, 2, or 3.
  -> m Double
  -- ^ an approximate lower bound rank.
rankLowerBound :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> Double -> Int -> m Double
rankLowerBound ReqSketch (PrimState m)
this Double
rank Int
numStdDev = do
  numLevels <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels ReqSketch (PrimState m)
this
  let k = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ ReqSketch (PrimState m) -> Word32
forall s. ReqSketch s -> Word32
getK ReqSketch (PrimState m)
this
  total <- count this
  pure $ getRankLB k numLevels rank numStdDev (rankAccuracySetting this == HighRanksAreAccurate) total

-- | Gets an array of normalized ranks that correspond to the given array of values.
-- TODO, make it ifaster
ranks :: (PrimMonad m, s ~ PrimState m) => ReqSketch s -> [Double] -> m [Double]
ranks :: forall (m :: * -> *) s.
(PrimMonad m, s ~ PrimState m) =>
ReqSketch s -> [Double] -> m [Double]
ranks ReqSketch s
s [Double]
values = (Double -> m Double) -> [Double] -> m [Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ReqSketch (PrimState m) -> Double -> m Double
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> Double -> m Double
rank ReqSketch s
ReqSketch (PrimState m)
s) [Double]
values

-- | Returns an approximate upper bound rank of the given rank.
rankUpperBound
  :: (PrimMonad m)
  => ReqSketch (PrimState m)
  -> Double
  -- ^ rank - the given rank, a value between 0 and 1.0.
  -> Int
  -- ^ numStdDev - the number of standard deviations. Must be 1, 2, or 3.
  -> m Double
  -- ^ an approximate upper bound rank.
rankUpperBound :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> Double -> Int -> m Double
rankUpperBound ReqSketch (PrimState m)
this Double
rank Int
numStdDev= do
  numLevels <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels ReqSketch (PrimState m)
this
  let k = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ ReqSketch (PrimState m) -> Word32
forall s. ReqSketch s -> Word32
getK ReqSketch (PrimState m)
this
  total <- count this
  pure $ getRankUB k numLevels rank numStdDev (rankAccuracySetting this == HighRanksAreAccurate) total

-- | Returns true if this sketch is empty.
null :: (PrimMonad m) => ReqSketch (PrimState m) -> m Bool
null :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
null = (Word64 -> Bool) -> m Word64 -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0) (m Word64 -> m Bool)
-> (ReqSketch (PrimState m) -> m Word64)
-> ReqSketch (PrimState m)
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URef (PrimState m) Word64 -> m Word64
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef (URef (PrimState m) Word64 -> m Word64)
-> (ReqSketch (PrimState m) -> URef (PrimState m) Word64)
-> ReqSketch (PrimState m)
-> m Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqSketch (PrimState m) -> URef (PrimState m) Word64
forall s. ReqSketch s -> URef s Word64
totalN

-- | Returns true if this sketch is in estimation mode.
isEstimationMode :: PrimMonad m => ReqSketch (PrimState m) -> m Bool
isEstimationMode :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
isEstimationMode = (Int -> Bool) -> m Int -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m Int -> m Bool)
-> (ReqSketch (PrimState m) -> m Int)
-> ReqSketch (PrimState m)
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels

-- | Returns the current comparison criterion.
isLessThanOrEqual :: ReqSketch s -> Bool
isLessThanOrEqual :: forall s. ReqSketch s -> Bool
isLessThanOrEqual ReqSketch s
s = case ReqSketch s -> Criterion
forall s. ReqSketch s -> Criterion
criterion ReqSketch s
s of
  Criterion
(:<) -> Bool
False
  Criterion
(:<=) -> Bool
True

computeMaxNominalSize :: PrimMonad m => ReqSketch (PrimState m) -> m Int
computeMaxNominalSize :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
computeMaxNominalSize ReqSketch (PrimState m)
this = do
  compactors <- ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
getCompactors ReqSketch (PrimState m)
this
  Vector.foldM countNominalCapacity 0 compactors
  where
    countNominalCapacity :: Int -> ReqCompactor (PrimState m) -> m Int
countNominalCapacity Int
acc ReqCompactor (PrimState m)
compactor = do
      nominalCapacity <- ReqCompactor (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqCompactor (PrimState m) -> m Int
Compactor.getNominalCapacity ReqCompactor (PrimState m)
compactor
      pure $ nominalCapacity + acc

grow :: (PrimMonad m) => ReqSketch (PrimState m) -> m ()
grow :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m ()
grow ReqSketch (PrimState m)
this = do
  lgWeight <- Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> m Int -> m Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels ReqSketch (PrimState m)
this
  let rankAccuracy = ReqSketch (PrimState m) -> RankAccuracy
forall s. ReqSketch s -> RankAccuracy
rankAccuracySetting ReqSketch (PrimState m)
this
      sectionSize = ReqSketch (PrimState m) -> Word32
forall s. ReqSketch s -> Word32
getK ReqSketch (PrimState m)
this
  newCompactor <- Compactor.mkReqCompactor (sketchRng this) lgWeight rankAccuracy sectionSize
  modifyMutVar' (compactors this) (`Vector.snoc` newCompactor)
  maxNominalCapacity <- computeMaxNominalSize this
  writeURef (maxNominalCapacitiesSize this) maxNominalCapacity

compress :: (PrimMonad m) => ReqSketch (PrimState m) -> m ()
compress :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m ()
compress ReqSketch (PrimState m)
this = do
  compactors <- ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
getCompactors ReqSketch (PrimState m)
this
  let compressionStep Int
height ReqCompactor (PrimState m)
compactor = do
        buffSize <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
DoubleBuffer.getCount (DoubleBuffer (PrimState m) -> m Int)
-> m (DoubleBuffer (PrimState m)) -> m Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReqCompactor (PrimState m) -> m (DoubleBuffer (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
ReqCompactor (PrimState m) -> m (DoubleBuffer (PrimState m))
Compactor.getBuffer ReqCompactor (PrimState m)
compactor
        nominalCapacity <- Compactor.getNominalCapacity compactor
        when (buffSize >= nominalCapacity) $ do
          numLevels <- getNumLevels this
          when (height + 1 >= numLevels) $ do
            grow this
          compactors' <- getCompactors this
          cReturn <- Compactor.compact compactor
          let topCompactor = Vector (ReqCompactor (PrimState m))
compactors' Vector (ReqCompactor (PrimState m))
-> Int -> ReqCompactor (PrimState m)
forall a. Vector a -> Int -> a
! (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          buff <- Compactor.getBuffer topCompactor
          DoubleBuffer.mergeSortIn buff $ Compactor.crDoubleBuffer cReturn
          modifyURef (retainedItems this) (+ Compactor.crDeltaRetItems cReturn)
          modifyURef (maxNominalCapacitiesSize this) (+ Compactor.crDeltaNominalSize cReturn)
  imapM_ compressionStep compactors
  writeMutVar (aux this) Nothing

-- | Merge other sketch into this one.
merge
  :: (PrimMonad m, s ~ PrimState m)
  => ReqSketch s
  -> ReqSketch s
  -> m (ReqSketch s)
merge :: forall (m :: * -> *) s.
(PrimMonad m, s ~ PrimState m) =>
ReqSketch s -> ReqSketch s -> m (ReqSketch s)
merge ReqSketch s
this ReqSketch s
other = do
  otherIsEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch s
ReqSketch (PrimState m)
other
  unless otherIsEmpty $ do
    let rankAccuracy = ReqSketch s -> RankAccuracy
forall s. ReqSketch s -> RankAccuracy
rankAccuracySetting ReqSketch s
this
        otherRankAccuracy = ReqSketch s -> RankAccuracy
forall s. ReqSketch s -> RankAccuracy
rankAccuracySetting ReqSketch s
other
    when (rankAccuracy /= otherRankAccuracy) $
      error "Both sketches must have the same HighRankAccuracy setting."
    -- update total
    otherN <- count other
    modifyURef (totalN this) (+ otherN)
    -- update the min and max values
    thisMin <- minimum this
    thisMax <- maximum this
    otherMin <- minimum other
    otherMax <- maximum other
    when (isNaN thisMin || otherMin < thisMin) $ do
      writeURef (minValue this) otherMin
    when (isNaN thisMax || otherMax < thisMax) $ do
      writeURef (maxValue this) otherMax
    -- grow until this has at least as many compactors as other
    numRequiredCompactors <- getNumLevels other
    growUntil numRequiredCompactors
    -- merge the items in all height compactors
    thisCompactors <- getCompactors this
    otherCompactors <- getCompactors other
    Vector.zipWithM_ Compactor.merge thisCompactors otherCompactors
    -- update state
    maxNominalCapacity <- computeMaxNominalSize this
    totalRetainedItems <- computeTotalRetainedItems this
    writeURef (maxNominalCapacitiesSize this) maxNominalCapacity
    writeURef (retainedItems this) totalRetainedItems
    -- compress and check invariants
    when (totalRetainedItems >= maxNominalCapacity) $ do
      compress this
    maxNominalCapacity' <- readURef $ maxNominalCapacitiesSize this
    totalRetainedItems' <- readURef $ retainedItems this
    assert (totalRetainedItems' < maxNominalCapacity') $
      writeMutVar (aux this) Nothing
  pure this
  where
    growUntil :: Int -> m ()
growUntil Int
target = do
      numCompactors <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels ReqSketch s
ReqSketch (PrimState m)
this
      when (numCompactors < target) $
        grow this

-- | Updates this sketch with the given item.
insert :: (PrimMonad m) => ReqSketch (PrimState m) -> Double -> m ()
insert :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> Double -> m ()
insert ReqSketch (PrimState m)
this Double
item = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
item) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch (PrimState m)
this
    if isEmpty
       then do
         writeURef (minValue this) item
         writeURef (maxValue this) item
       else do
         min_ <- minimum this
         max_ <- maximum this
         when (item < min_) $ writeURef (minValue this) item
         when (item > max_) $ writeURef (maxValue this) item
    compactor <- Vector.head <$> getCompactors this
    buff <- Compactor.getBuffer compactor
    DoubleBuffer.append buff item
    modifyURef (retainedItems this) (+1)
    modifyURef (totalN this) (+1)
    modifyURef (sumValue this) (+ item)
    retItems <- retainedItemCount this
    maxNominalCapacity <- getMaxNominalCapacity this
    when (retItems >= maxNominalCapacity) $ do
      DoubleBuffer.sort buff
      compress this
    writeMutVar (aux this) Nothing

-- Private pure bits

getRankLB :: Int -> Int -> Double -> Int -> Bool -> Word64 -> Double
getRankLB :: Int -> Int -> Double -> Int -> Bool -> Word64 -> Double
getRankLB Int
k Int
levels Double
rank Int
numStdDev Bool
hra Word64
totalN = if Int -> Int -> Double -> Bool -> Word64 -> Bool
exactRank Int
k Int
levels Double
rank Bool
hra Word64
totalN
  then Double
rank
  else Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
lbRel Double
lbFix
  where
    relative :: Double
relative = Double
relRseFactor Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* (if Bool
hra then Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rank else Double
rank)
    fixed :: Double
fixed = Double
fixRseFactor Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
    lbRel :: Double
lbRel = Double
rank Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numStdDev Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
relative
    lbFix :: Double
lbFix = Double
rank Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numStdDev Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fixed

getRankUB :: Int -> Int -> Double -> Int -> Bool -> Word64 -> Double
getRankUB :: Int -> Int -> Double -> Int -> Bool -> Word64 -> Double
getRankUB Int
k Int
levels Double
rank Int
numStdDev Bool
hra Word64
totalN = if Int -> Int -> Double -> Bool -> Word64 -> Bool
exactRank Int
k Int
levels Double
rank Bool
hra Word64
totalN
  then Double
rank
  else Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
ubRel Double
ubFix
  where
    relative :: Double
relative = Double
relRseFactor Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* (if Bool
hra then Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rank else Double
rank)
    fixed :: Double
fixed = Double
fixRseFactor Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
    ubRel :: Double
ubRel = Double
rank Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numStdDev Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
relative
    ubFix :: Double
ubFix = Double
rank Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numStdDev Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fixed

exactRank :: Int -> Int -> Double -> Bool -> Word64 -> Bool
exactRank :: Int -> Int -> Double -> Bool -> Word64 -> Bool
exactRank Int
k Int
levels Double
rank Bool
hra Word64
totalN = (Int
levels Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalN Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
baseCap) Bool -> Bool -> Bool
|| (Bool
hra Bool -> Bool -> Bool
&& Double
rank Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
exactRankThresh Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
hra Bool -> Bool -> Bool
&& Double
rank Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
exactRankThresh)
  where
    baseCap :: Int
baseCap = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
initNumberOfSections
    exactRankThresh :: Double
    exactRankThresh :: Double
exactRankThresh = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
baseCap Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalN