-- | 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"
  ReqSketch (PrimState m)
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
  ReqSketch (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m ()
grow ReqSketch (PrimState m)
r
  ReqSketch (PrimState m) -> m (ReqSketch (PrimState m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReqSketch (PrimState m)
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. 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. 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. 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
  Vector (ReqCompactor (PrimState m))
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 :: Int
numValues = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
values
      numCompactors :: Int
numCompactors = Vector (ReqCompactor (PrimState m)) -> Int
forall a. Vector a -> Int
Vector.length Vector (ReqCompactor (PrimState m))
compactors
      ans :: [Word64]
ans = Int -> Word64 -> [Word64]
forall a. Int -> a -> [a]
replicate Int
numValues Word64
0
  Bool
isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch (PrimState m)
this
  if Bool
isEmpty
    then [Word64] -> m [Word64]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    else ([Word64] -> Int -> ReqCompactor (PrimState m) -> m [Word64])
-> [Word64] -> Vector (ReqCompactor (PrimState m)) -> m [Word64]
forall (m :: * -> *) a b.
Monad m =>
(a -> Int -> b -> m a) -> a -> Vector b -> m a
Vector.ifoldM [Word64] -> Int -> ReqCompactor (PrimState m) -> m [Word64]
doCount [Word64]
ans Vector (ReqCompactor (PrimState m))
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
      DoubleBuffer (PrimState m)
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) -> Word64 -> m Word64
updateCounts DoubleBuffer (PrimState m)
buff Word64
value = do
            Int
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)
            Word64 -> m Word64
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> m Word64) -> Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
value Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count_ Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
wt
      (Word64 -> m Word64) -> [Word64] -> m [Word64]
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 (DoubleBuffer (PrimState m) -> Word64 -> m Word64
updateCounts DoubleBuffer (PrimState m)
buff) [Word64]
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 :: Int
numSplits = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
splits
      numBuckets :: Int
numBuckets = Int
numSplits -- + 1
  [Word64]
splitCounts <- ReqSketch (PrimState m) -> [Double] -> m [Word64]
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> [Double] -> m [Word64]
getCounts ReqSketch (PrimState m)
this [Double]
splits
  Word64
n <- ReqSketch (PrimState m) -> m Word64
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Word64
count ReqSketch (PrimState m)
this
  [Word64] -> m [Word64]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Word64] -> m [Word64]) -> [Word64] -> m [Word64]
forall a b. (a -> b) -> a -> b
$ ([Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ [Word64
n]) ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
numBuckets [Word64]
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
  [Word64]
buckets <- ReqSketch (PrimState m) -> [Double] -> m [Word64]
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> [Double] -> m [Word64]
getPMForCDF ReqSketch (PrimState m)
this [Double]
splitPoints
  Bool
isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch (PrimState m)
this
  if Bool
isEmpty
    then Maybe [Double] -> m (Maybe [Double])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Double]
forall a. Maybe a
Nothing
    else do
      let numBuckets :: Int
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
      Word64
n <- ReqSketch (PrimState m) -> m Word64
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Word64
count ReqSketch (PrimState m)
this
      Maybe [Double] -> m (Maybe [Double])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Double] -> m (Maybe [Double]))
-> Maybe [Double] -> m (Maybe [Double])
forall a b. (a -> b) -> a -> b
$ [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just ([Double] -> Maybe [Double]) -> [Double] -> Maybe [Double]
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) (Double -> Double) -> (Word64 -> Double) -> Word64 -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Double) -> [Word64] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word64]
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
  Bool
empty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
null ReqSketch s
ReqSketch (PrimState m)
s
  if Bool
empty
    then Word64 -> m Word64
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
    else do
      Vector (ReqCompactor s)
compactors <- ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
getCompactors ReqSketch s
ReqSketch (PrimState m)
s
      let go :: Word64 -> ReqCompactor s -> m Word64
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
            DoubleBuffer s
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
            Int
count_ <- DoubleBuffer (PrimState m) -> Double -> Criterion -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> Double -> Criterion -> m Int
DoubleBuffer.getCountWithCriterion DoubleBuffer s
DoubleBuffer (PrimState m)
buf Double
value (ReqSketch s -> Criterion
forall s. ReqSketch s -> Criterion
criterion ReqSketch s
s)
            Word64 -> m Word64
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
accum Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count_ Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
wt))
      (Word64 -> ReqCompactor s -> m Word64)
-> Word64 -> Vector (ReqCompactor s) -> m Word64
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m a
Vector.foldM Word64 -> ReqCompactor s -> m Word64
go Word64
0 Vector (ReqCompactor s)
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
  Bool
isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch (PrimState m)
this
  if Bool
isEmpty
     then [Double] -> m [Double]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
     else do
       let numBuckets :: Int
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
       [Double]
buckets <- (Word64 -> Double) -> [Word64] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word64] -> [Double]) -> m [Word64] -> m [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReqSketch (PrimState m) -> [Double] -> m [Word64]
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> [Double] -> m [Word64]
getPMForCDF ReqSketch (PrimState m)
this [Double]
splitPoints
       Double
total <- Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Double) -> m Word64 -> m Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReqSketch (PrimState m) -> m Word64
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Word64
count ReqSketch (PrimState m)
this
       let computeProb :: (Int, Double) -> Double
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 :: [Double]
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
       [Double] -> m [Double]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Double]
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
  Bool
isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch (PrimState m)
this
  if Bool
isEmpty
     then Double -> m Double
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)
     else do
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
normRank Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 Bool -> Bool -> Bool
|| Double
normRank Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1.0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
         [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Normalized rank must be in the range [0.0, 1.0]: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
normRank
       Maybe ReqAuxiliary
currAuxiliary <- ReqSketch (PrimState m) -> m (Maybe ReqAuxiliary)
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m (Maybe ReqAuxiliary)
getAux ReqSketch (PrimState m)
this
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ReqAuxiliary -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ReqAuxiliary
currAuxiliary) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
         Word64
total <- ReqSketch (PrimState m) -> m Word64
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Word64
count ReqSketch (PrimState m)
this
         Int
retainedItems <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
retainedItemCount ReqSketch (PrimState m)
this
         Vector (ReqCompactor (PrimState m))
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
         ReqAuxiliary
newAuxiliary <- RankAccuracy
-> Word64
-> Int
-> Vector (ReqCompactor (PrimState m))
-> m ReqAuxiliary
forall (m :: * -> *) s.
(PrimMonad m, s ~ PrimState m) =>
RankAccuracy
-> Word64 -> Int -> Vector (ReqCompactor s) -> m ReqAuxiliary
Auxiliary.mkAuxiliary (ReqSketch (PrimState m) -> RankAccuracy
forall s. ReqSketch s -> RankAccuracy
rankAccuracySetting ReqSketch (PrimState m)
this) Word64
total Int
retainedItems Vector (ReqCompactor (PrimState m))
compactors
         MutVar (PrimState m) (Maybe ReqAuxiliary)
-> Maybe ReqAuxiliary -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (ReqSketch (PrimState m)
-> MutVar (PrimState m) (Maybe ReqAuxiliary)
forall s. ReqSketch s -> MutVar s (Maybe ReqAuxiliary)
aux ReqSketch (PrimState m)
this) (ReqAuxiliary -> Maybe ReqAuxiliary
forall a. a -> Maybe a
Just ReqAuxiliary
newAuxiliary)
       Maybe ReqAuxiliary
mAuxiliary <- ReqSketch (PrimState m) -> m (Maybe ReqAuxiliary)
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m (Maybe ReqAuxiliary)
getAux ReqSketch (PrimState m)
this
       case Maybe ReqAuxiliary
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
  Bool
isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch (PrimState m)
this
  if Bool
isEmpty
     then [Double] -> m [Double]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
     else (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
quantile ReqSketch (PrimState m)
this) [Double]
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
  Bool
isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
null ReqSketch (PrimState m)
s
  if Bool
isEmpty
    then Double -> m Double
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0) -- NaN
    else do
      Word64
nnCount <- ReqSketch (PrimState m) -> Double -> m Word64
forall (m :: * -> *) s.
(PrimMonad m, s ~ PrimState m) =>
ReqSketch s -> Double -> m Word64
countWithCriterion ReqSketch (PrimState m)
s Double
value
      Word64
total <- 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)
-> URef (PrimState m) Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ ReqSketch (PrimState m) -> URef (PrimState m) Word64
forall s. ReqSketch s -> URef s Word64
totalN ReqSketch (PrimState m)
s
      Double -> m Double
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nnCount Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
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
  Int
numLevels <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels ReqSketch (PrimState m)
this
  let k :: Int
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
  Word64
total <- ReqSketch (PrimState m) -> m Word64
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Word64
count ReqSketch (PrimState m)
this
  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
$ Int -> Int -> Double -> Int -> Bool -> Word64 -> Double
getRankLB Int
k Int
numLevels Double
rank Int
numStdDev (ReqSketch (PrimState m) -> RankAccuracy
forall s. ReqSketch s -> RankAccuracy
rankAccuracySetting ReqSketch (PrimState m)
this RankAccuracy -> RankAccuracy -> Bool
forall a. Eq a => a -> a -> Bool
== RankAccuracy
HighRanksAreAccurate) Word64
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
  Int
numLevels <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels ReqSketch (PrimState m)
this
  let k :: Int
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
  Word64
total <- ReqSketch (PrimState m) -> m Word64
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Word64
count ReqSketch (PrimState m)
this
  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
$ Int -> Int -> Double -> Int -> Bool -> Word64 -> Double
getRankUB Int
k Int
numLevels Double
rank Int
numStdDev (ReqSketch (PrimState m) -> RankAccuracy
forall s. ReqSketch s -> RankAccuracy
rankAccuracySetting ReqSketch (PrimState m)
this RankAccuracy -> RankAccuracy -> Bool
forall a. Eq a => a -> a -> Bool
== RankAccuracy
HighRanksAreAccurate) Word64
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
  Vector (ReqCompactor (PrimState m))
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
  (Int -> ReqCompactor (PrimState m) -> m Int)
-> Int -> Vector (ReqCompactor (PrimState m)) -> m Int
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m a
Vector.foldM Int -> ReqCompactor (PrimState m) -> m Int
forall {m :: * -> *}.
PrimMonad m =>
Int -> ReqCompactor (PrimState m) -> m Int
countNominalCapacity Int
0 Vector (ReqCompactor (PrimState m))
compactors
  where
    countNominalCapacity :: Int -> ReqCompactor (PrimState m) -> m Int
countNominalCapacity Int
acc ReqCompactor (PrimState m)
compactor = do
      Int
nominalCapacity <- ReqCompactor (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqCompactor (PrimState m) -> m Int
Compactor.getNominalCapacity ReqCompactor (PrimState m)
compactor
      Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int
nominalCapacity Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acc

grow :: (PrimMonad m) => ReqSketch (PrimState m) -> m ()
grow :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m ()
grow ReqSketch (PrimState m)
this = do
  Word8
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 :: RankAccuracy
rankAccuracy = ReqSketch (PrimState m) -> RankAccuracy
forall s. ReqSketch s -> RankAccuracy
rankAccuracySetting ReqSketch (PrimState m)
this
      sectionSize :: Word32
sectionSize = ReqSketch (PrimState m) -> Word32
forall s. ReqSketch s -> Word32
getK ReqSketch (PrimState m)
this
  ReqCompactor (PrimState m)
newCompactor <- Gen (PrimState m)
-> Word8
-> RankAccuracy
-> Word32
-> m (ReqCompactor (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Gen (PrimState m)
-> Word8
-> RankAccuracy
-> Word32
-> m (ReqCompactor (PrimState m))
Compactor.mkReqCompactor (ReqSketch (PrimState m) -> Gen (PrimState m)
forall s. ReqSketch s -> Gen s
sketchRng ReqSketch (PrimState m)
this) Word8
lgWeight RankAccuracy
rankAccuracy Word32
sectionSize
  MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
-> (Vector (ReqCompactor (PrimState m))
    -> Vector (ReqCompactor (PrimState m)))
-> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar' (ReqSketch (PrimState m)
-> MutVar (PrimState m) (Vector (ReqCompactor (PrimState m)))
forall s. ReqSketch s -> MutVar s (Vector (ReqCompactor s))
compactors ReqSketch (PrimState m)
this) (Vector (ReqCompactor (PrimState m))
-> ReqCompactor (PrimState m)
-> Vector (ReqCompactor (PrimState m))
forall a. Vector a -> a -> Vector a
`Vector.snoc` ReqCompactor (PrimState m)
newCompactor)
  Int
maxNominalCapacity <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
computeMaxNominalSize ReqSketch (PrimState m)
this
  URef (PrimState m) Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef (ReqSketch (PrimState m) -> URef (PrimState m) Int
forall s. ReqSketch s -> URef s Int
maxNominalCapacitiesSize ReqSketch (PrimState m)
this) Int
maxNominalCapacity

compress :: (PrimMonad m) => ReqSketch (PrimState m) -> m ()
compress :: forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m ()
compress ReqSketch (PrimState m)
this = do
  Vector (ReqCompactor (PrimState m))
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 -> ReqCompactor (PrimState m) -> m ()
compressionStep Int
height ReqCompactor (PrimState m)
compactor = do
        Int
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
        Int
nominalCapacity <- ReqCompactor (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqCompactor (PrimState m) -> m Int
Compactor.getNominalCapacity ReqCompactor (PrimState m)
compactor
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
buffSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nominalCapacity) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          Int
numLevels <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels ReqSketch (PrimState m)
this
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
numLevels) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            ReqSketch (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m ()
grow ReqSketch (PrimState m)
this
          Vector (ReqCompactor (PrimState m))
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
          CompactorReturn (PrimState m)
cReturn <- ReqCompactor (PrimState m) -> m (CompactorReturn (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
ReqCompactor (PrimState m) -> m (CompactorReturn (PrimState m))
Compactor.compact ReqCompactor (PrimState m)
compactor
          let topCompactor :: ReqCompactor (PrimState m)
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)
          DoubleBuffer (PrimState m)
buff <- ReqCompactor (PrimState m) -> m (DoubleBuffer (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
ReqCompactor (PrimState m) -> m (DoubleBuffer (PrimState m))
Compactor.getBuffer ReqCompactor (PrimState m)
topCompactor
          DoubleBuffer (PrimState m) -> DoubleBuffer (PrimState m) -> m ()
forall (m :: * -> *).
(PrimMonad m, HasCallStack) =>
DoubleBuffer (PrimState m) -> DoubleBuffer (PrimState m) -> m ()
DoubleBuffer.mergeSortIn DoubleBuffer (PrimState m)
buff (DoubleBuffer (PrimState m) -> m ())
-> DoubleBuffer (PrimState m) -> m ()
forall a b. (a -> b) -> a -> b
$ CompactorReturn (PrimState m) -> DoubleBuffer (PrimState m)
forall s. CompactorReturn s -> DoubleBuffer s
Compactor.crDoubleBuffer CompactorReturn (PrimState m)
cReturn
          URef (PrimState m) Int -> (Int -> Int) -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> (a -> a) -> m ()
modifyURef (ReqSketch (PrimState m) -> URef (PrimState m) Int
forall s. ReqSketch s -> URef s Int
retainedItems ReqSketch (PrimState m)
this) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CompactorReturn (PrimState m) -> Int
forall s. CompactorReturn s -> Int
Compactor.crDeltaRetItems CompactorReturn (PrimState m)
cReturn)
          URef (PrimState m) Int -> (Int -> Int) -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> (a -> a) -> m ()
modifyURef (ReqSketch (PrimState m) -> URef (PrimState m) Int
forall s. ReqSketch s -> URef s Int
maxNominalCapacitiesSize ReqSketch (PrimState m)
this) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CompactorReturn (PrimState m) -> Int
forall s. CompactorReturn s -> Int
Compactor.crDeltaNominalSize CompactorReturn (PrimState m)
cReturn)
  (Int -> ReqCompactor (PrimState m) -> m ())
-> Vector (ReqCompactor (PrimState m)) -> m ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
imapM_ Int -> ReqCompactor (PrimState m) -> m ()
compressionStep Vector (ReqCompactor (PrimState m))
compactors
  MutVar (PrimState m) (Maybe ReqAuxiliary)
-> Maybe ReqAuxiliary -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (ReqSketch (PrimState m)
-> MutVar (PrimState m) (Maybe ReqAuxiliary)
forall s. ReqSketch s -> MutVar s (Maybe ReqAuxiliary)
aux ReqSketch (PrimState m)
this) Maybe ReqAuxiliary
forall a. Maybe a
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
  Bool
otherIsEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch s
ReqSketch (PrimState m)
other
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
otherIsEmpty (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let rankAccuracy :: RankAccuracy
rankAccuracy = ReqSketch s -> RankAccuracy
forall s. ReqSketch s -> RankAccuracy
rankAccuracySetting ReqSketch s
this
        otherRankAccuracy :: RankAccuracy
otherRankAccuracy = ReqSketch s -> RankAccuracy
forall s. ReqSketch s -> RankAccuracy
rankAccuracySetting ReqSketch s
other
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RankAccuracy
rankAccuracy RankAccuracy -> RankAccuracy -> Bool
forall a. Eq a => a -> a -> Bool
/= RankAccuracy
otherRankAccuracy) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Both sketches must have the same HighRankAccuracy setting."
    -- update total
    Word64
otherN <- ReqSketch (PrimState m) -> m Word64
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Word64
count ReqSketch s
ReqSketch (PrimState m)
other
    URef (PrimState m) Word64 -> (Word64 -> Word64) -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> (a -> a) -> m ()
modifyURef (ReqSketch s -> URef s Word64
forall s. ReqSketch s -> URef s Word64
totalN ReqSketch s
this) (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
otherN)
    -- update the min and max values
    Double
thisMin <- ReqSketch (PrimState m) -> m Double
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Double
minimum ReqSketch s
ReqSketch (PrimState m)
this
    Double
thisMax <- ReqSketch (PrimState m) -> m Double
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Double
maximum ReqSketch s
ReqSketch (PrimState m)
this
    Double
otherMin <- ReqSketch (PrimState m) -> m Double
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Double
minimum ReqSketch s
ReqSketch (PrimState m)
other
    Double
otherMax <- ReqSketch (PrimState m) -> m Double
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Double
maximum ReqSketch s
ReqSketch (PrimState m)
other
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
thisMin Bool -> Bool -> Bool
|| Double
otherMin Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
thisMin) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      URef (PrimState m) Double -> Double -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef (ReqSketch s -> URef s Double
forall s. ReqSketch s -> URef s Double
minValue ReqSketch s
this) Double
otherMin
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
thisMax Bool -> Bool -> Bool
|| Double
otherMax Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
thisMax) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      URef (PrimState m) Double -> Double -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef (ReqSketch s -> URef s Double
forall s. ReqSketch s -> URef s Double
maxValue ReqSketch s
this) Double
otherMax
    -- grow until this has at least as many compactors as other
    Int
numRequiredCompactors <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels ReqSketch s
ReqSketch (PrimState m)
other
    Int -> m ()
growUntil Int
numRequiredCompactors
    -- merge the items in all height compactors
    Vector (ReqCompactor s)
thisCompactors <- ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
getCompactors ReqSketch s
ReqSketch (PrimState m)
this
    Vector (ReqCompactor s)
otherCompactors <- ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m (Vector (ReqCompactor (PrimState m)))
getCompactors ReqSketch s
ReqSketch (PrimState m)
other
    (ReqCompactor s -> ReqCompactor s -> m (ReqCompactor s))
-> Vector (ReqCompactor s) -> Vector (ReqCompactor s) -> m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Vector a -> Vector b -> m ()
Vector.zipWithM_ ReqCompactor s -> ReqCompactor s -> m (ReqCompactor s)
ReqCompactor (PrimState m)
-> ReqCompactor (PrimState m) -> m (ReqCompactor s)
forall (m :: * -> *) s.
(PrimMonad m, s ~ PrimState m) =>
ReqCompactor (PrimState m)
-> ReqCompactor (PrimState m) -> m (ReqCompactor s)
Compactor.merge Vector (ReqCompactor s)
thisCompactors Vector (ReqCompactor s)
otherCompactors
    -- update state
    Int
maxNominalCapacity <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
computeMaxNominalSize ReqSketch s
ReqSketch (PrimState m)
this
    Int
totalRetainedItems <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
computeTotalRetainedItems ReqSketch s
ReqSketch (PrimState m)
this
    URef (PrimState m) Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef (ReqSketch s -> URef s Int
forall s. ReqSketch s -> URef s Int
maxNominalCapacitiesSize ReqSketch s
this) Int
maxNominalCapacity
    URef (PrimState m) Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef (ReqSketch s -> URef s Int
forall s. ReqSketch s -> URef s Int
retainedItems ReqSketch s
this) Int
totalRetainedItems
    -- compress and check invariants
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
totalRetainedItems Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxNominalCapacity) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      ReqSketch (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m ()
compress ReqSketch s
ReqSketch (PrimState m)
this
    Int
maxNominalCapacity' <- 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)
-> URef (PrimState m) Int -> m Int
forall a b. (a -> b) -> a -> b
$ ReqSketch s -> URef s Int
forall s. ReqSketch s -> URef s Int
maxNominalCapacitiesSize ReqSketch s
this
    Int
totalRetainedItems' <- 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)
-> URef (PrimState m) Int -> m Int
forall a b. (a -> b) -> a -> b
$ ReqSketch s -> URef s Int
forall s. ReqSketch s -> URef s Int
retainedItems ReqSketch s
this
    Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
totalRetainedItems' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxNominalCapacity') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      MutVar (PrimState m) (Maybe ReqAuxiliary)
-> Maybe ReqAuxiliary -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (ReqSketch s -> MutVar s (Maybe ReqAuxiliary)
forall s. ReqSketch s -> MutVar s (Maybe ReqAuxiliary)
aux ReqSketch s
this) Maybe ReqAuxiliary
forall a. Maybe a
Nothing
  ReqSketch s -> m (ReqSketch s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReqSketch s
this
  where
    growUntil :: Int -> m ()
growUntil Int
target = do
      Int
numCompactors <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getNumLevels ReqSketch s
ReqSketch (PrimState m)
this
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
numCompactors Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
target) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        ReqSketch (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m ()
grow ReqSketch s
ReqSketch (PrimState m)
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
    Bool
isEmpty <- ReqSketch (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Bool
getIsEmpty ReqSketch (PrimState m)
this
    if Bool
isEmpty
       then do
         URef (PrimState m) Double -> Double -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef (ReqSketch (PrimState m) -> URef (PrimState m) Double
forall s. ReqSketch s -> URef s Double
minValue ReqSketch (PrimState m)
this) Double
item
         URef (PrimState m) Double -> Double -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef (ReqSketch (PrimState m) -> URef (PrimState m) Double
forall s. ReqSketch s -> URef s Double
maxValue ReqSketch (PrimState m)
this) Double
item
       else do
         Double
min_ <- ReqSketch (PrimState m) -> m Double
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Double
minimum ReqSketch (PrimState m)
this
         Double
max_ <- ReqSketch (PrimState m) -> m Double
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Double
maximum ReqSketch (PrimState m)
this
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
item Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
min_) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ URef (PrimState m) Double -> Double -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef (ReqSketch (PrimState m) -> URef (PrimState m) Double
forall s. ReqSketch s -> URef s Double
minValue ReqSketch (PrimState m)
this) Double
item
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
item Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
max_) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ URef (PrimState m) Double -> Double -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef (ReqSketch (PrimState m) -> URef (PrimState m) Double
forall s. ReqSketch s -> URef s Double
maxValue ReqSketch (PrimState m)
this) Double
item
    ReqCompactor (PrimState m)
compactor <- Vector (ReqCompactor (PrimState m)) -> ReqCompactor (PrimState m)
forall a. Vector a -> a
Vector.head (Vector (ReqCompactor (PrimState m)) -> ReqCompactor (PrimState m))
-> m (Vector (ReqCompactor (PrimState m)))
-> m (ReqCompactor (PrimState m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
    DoubleBuffer (PrimState m)
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
    DoubleBuffer (PrimState m) -> Double -> m ()
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> Double -> m ()
DoubleBuffer.append DoubleBuffer (PrimState m)
buff Double
item
    URef (PrimState m) Int -> (Int -> Int) -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> (a -> a) -> m ()
modifyURef (ReqSketch (PrimState m) -> URef (PrimState m) Int
forall s. ReqSketch s -> URef s Int
retainedItems ReqSketch (PrimState m)
this) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    URef (PrimState m) Word64 -> (Word64 -> Word64) -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> (a -> a) -> m ()
modifyURef (ReqSketch (PrimState m) -> URef (PrimState m) Word64
forall s. ReqSketch s -> URef s Word64
totalN ReqSketch (PrimState m)
this) (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1)
    URef (PrimState m) Double -> (Double -> Double) -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> (a -> a) -> m ()
modifyURef (ReqSketch (PrimState m) -> URef (PrimState m) Double
forall s. ReqSketch s -> URef s Double
sumValue ReqSketch (PrimState m)
this) (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
item)
    Int
retItems <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
retainedItemCount ReqSketch (PrimState m)
this
    Int
maxNominalCapacity <- ReqSketch (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Int
getMaxNominalCapacity ReqSketch (PrimState m)
this
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
retItems Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxNominalCapacity) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      DoubleBuffer (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m ()
DoubleBuffer.sort DoubleBuffer (PrimState m)
buff
      ReqSketch (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m ()
compress ReqSketch (PrimState m)
this
    MutVar (PrimState m) (Maybe ReqAuxiliary)
-> Maybe ReqAuxiliary -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (ReqSketch (PrimState m)
-> MutVar (PrimState m) (Maybe ReqAuxiliary)
forall s. ReqSketch s -> MutVar s (Maybe ReqAuxiliary)
aux ReqSketch (PrimState m)
this) Maybe ReqAuxiliary
forall a. Maybe a
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