diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -15,22 +15,22 @@ main :: IO () main = do - outerSketch <- mkReqSketch @6 HighRanksAreAccurate + outerSketch <- mkReqSketch 6 HighRanksAreAccurate -- let metric = summary (Info "adversarial_input" "woo") defaultQuantiles -- prometheusThing <- register metric - skM <- newMVar =<< mkReqSketch @6 HighRanksAreAccurate + skM <- newMVar =<< mkReqSketch 6 HighRanksAreAccurate -- mapM_ (update outerSketch) [1..10000] defaultMain [ bgroup "ReqSketch" - [ bench "insert/1" $ perRunEnv (mkReqSketch @6 HighRanksAreAccurate) $ \sk -> do + [ bench "insert/1" $ perRunEnv (mkReqSketch 6 HighRanksAreAccurate) $ \sk -> do update sk 1 - , bench "insert/10" $ perRunEnv (mkReqSketch @6 HighRanksAreAccurate) $ \sk -> do + , bench "insert/10" $ perRunEnv (mkReqSketch 6 HighRanksAreAccurate) $ \sk -> do mapM_ (update sk) [1..10] - , bench "insert/100" $ perRunEnv (mkReqSketch @6 HighRanksAreAccurate) $ \sk -> do + , bench "insert/100" $ perRunEnv (mkReqSketch 6 HighRanksAreAccurate) $ \sk -> do mapM_ (update sk) [1..100] - , bench "insert/1000" $ perRunEnv (mkReqSketch @6 HighRanksAreAccurate) $ \sk -> do + , bench "insert/1000" $ perRunEnv (mkReqSketch 6 HighRanksAreAccurate) $ \sk -> do mapM_ (update sk) [1..1000] - , bench "insert/10000" $ perRunEnv (mkReqSketch @6 HighRanksAreAccurate) $ \sk -> do + , bench "insert/10000" $ perRunEnv (mkReqSketch 6 HighRanksAreAccurate) $ \sk -> do mapM_ (update sk) [1..10000] , bench "insert/existing" $ whnfIO $ update outerSketch 1 , bench "insert/mvar" $ whnfIO $ withMVar skM (`update` 1) diff --git a/data-sketches.cabal b/data-sketches.cabal --- a/data-sketches.cabal +++ b/data-sketches.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: data-sketches -version: 0.2.0.1 +version: 0.3.0.0 description: Please see the README on GitHub at homepage: https://github.com/iand675/datasketches-haskell#readme bug-reports: https://github.com/iand675/datasketches-haskell/issues diff --git a/src/DataSketches/Quantiles/RelativeErrorQuantile.hs b/src/DataSketches/Quantiles/RelativeErrorQuantile.hs --- a/src/DataSketches/Quantiles/RelativeErrorQuantile.hs +++ b/src/DataSketches/Quantiles/RelativeErrorQuantile.hs @@ -27,7 +27,6 @@ module DataSketches.Quantiles.RelativeErrorQuantile ( -- * Construction ReqSketch (criterion) - , ValidK , mkReqSketch -- ** Configuration settings , RankAccuracy(..) @@ -49,6 +48,7 @@ , ranks , rankUpperBound , cumulativeDistributionFunction + , getK -- * Updating the sketch , merge , insert @@ -124,8 +124,9 @@ - The Python prototype only implemented a comparison criterion of "<". This implementation allows the user to switch back and forth between the "<=" criterion and the "<=" criterion. -} -data ReqSketch (k :: Nat) s = ReqSketch - { rankAccuracySetting :: !RankAccuracy +data ReqSketch s = ReqSketch + { k :: !Word32 + , rankAccuracySetting :: !RankAccuracy , criterion :: !Criterion , sketchRng :: {-# UNPACK #-} !(Gen s) , totalN :: {-# UNPACK #-} !(URef s Word64) @@ -138,11 +139,11 @@ , compactors :: {-# UNPACK #-} !(MutVar s (Vector.Vector (ReqCompactor s))) } deriving (Generic) -instance NFData (ReqSketch k s) where +instance NFData (ReqSketch s) where rnf !rs = () -instance TakeSnapshot (ReqSketch k) where - data Snapshot (ReqSketch k) = ReqSketchSnapshot +instance TakeSnapshot ReqSketch where + data Snapshot ReqSketch = ReqSketchSnapshot { snapshotRankAccuracySetting :: !RankAccuracy , snapshotCriterion :: !Criterion , snapshotTotalN :: !Word64 @@ -161,15 +162,19 @@ <*> readURef maxNominalCapacitiesSize <*> (readMutVar compactors >>= mapM takeSnapshot) -deriving instance Show (Snapshot (ReqSketch k)) +deriving instance Show (Snapshot ReqSketch) -- | 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. -type ValidK k = (4 <= k, k <= 1024, (k `Mod` 2) ~ 0) - -mkReqSketch :: forall k m. (PrimMonad m, ValidK k, KnownNat k) => RankAccuracy -> m (ReqSketch k (PrimState m)) -mkReqSketch rank = do - r <- ReqSketch rank (:<) +-- +-- A good starting number when in doubt is 6. +mkReqSketch :: forall m. (PrimMonad m) + => Word32 -- ^ K + -> RankAccuracy + -> m (ReqSketch (PrimState m)) +mkReqSketch k rank = do + unless (even k && k >= 4 && k <= 1024) $ error "k must be divisible by 2, and satisfy 4 <= k <= 1024" + r <- ReqSketch k rank (:<) <$> create <*> newURef 0 <*> newURef (0 / 0) @@ -182,32 +187,32 @@ grow r pure r -mkAuxiliaryFromReqSketch :: PrimMonad m => ReqSketch k (PrimState m) -> m ReqAuxiliary +mkAuxiliaryFromReqSketch :: PrimMonad m => ReqSketch (PrimState m) -> m ReqAuxiliary mkAuxiliaryFromReqSketch this = do total <- count this retainedItems <- retainedItemCount this compactors <- getCompactors this Auxiliary.mkAuxiliary (rankAccuracySetting this) total retainedItems compactors -getAux :: PrimMonad m => ReqSketch k (PrimState m) -> m (Maybe ReqAuxiliary) +getAux :: PrimMonad m => ReqSketch (PrimState m) -> m (Maybe ReqAuxiliary) getAux = readMutVar . aux -getCompactors :: PrimMonad m => ReqSketch k (PrimState m) -> m (Vector.Vector (ReqCompactor (PrimState m))) +getCompactors :: PrimMonad m => ReqSketch (PrimState m) -> m (Vector.Vector (ReqCompactor (PrimState m))) getCompactors = readMutVar . compactors -getNumLevels :: PrimMonad m => ReqSketch k (PrimState m) -> m Int +getNumLevels :: PrimMonad m => ReqSketch (PrimState m) -> m Int getNumLevels = fmap Vector.length . getCompactors -getIsEmpty :: PrimMonad m => ReqSketch k (PrimState m) -> m Bool +getIsEmpty :: PrimMonad m => ReqSketch (PrimState m) -> m Bool getIsEmpty = fmap (== 0) . readURef . totalN -getK :: forall k s. KnownNat k => ReqSketch k s -> Word32 -getK _ = fromIntegral (natVal (Proxy :: Proxy k)) +getK :: ReqSketch s -> Word32 +getK = k -retainedItemCount :: PrimMonad m => ReqSketch k (PrimState m) -> m Int +retainedItemCount :: PrimMonad m => ReqSketch (PrimState m) -> m Int retainedItemCount = readURef . retainedItems -getMaxNominalCapacity :: PrimMonad m => ReqSketch k (PrimState m) -> m Int +getMaxNominalCapacity :: PrimMonad m => ReqSketch (PrimState m) -> m Int getMaxNominalCapacity = readURef . maxNominalCapacitiesSize data CumulativeDistributionInvariants @@ -227,7 +232,7 @@ when (Data.List.nub (Data.List.sort splits) /= splits) $ do throw CumulativeDistributionInvariantsSplitsAreNotUniqueAndMontonicallyIncreasing -getCounts :: (PrimMonad m, KnownNat k) => ReqSketch k (PrimState m) -> [Double] -> m [Word64] +getCounts :: (PrimMonad m) => ReqSketch (PrimState m) -> [Double] -> m [Word64] getCounts this values = do compactors <- getCompactors this let numValues = length values @@ -246,7 +251,7 @@ pure $ fromIntegral value + fromIntegral count_ * wt mapM (updateCounts buff) acc -getPMForCDF :: (PrimMonad m, KnownNat k) => ReqSketch k (PrimState m) -> [Double] -> m [Word64] +getPMForCDF :: (PrimMonad m) => ReqSketch (PrimState m) -> [Double] -> m [Word64] getPMForCDF this splits = do () <- validateSplits splits let numSplits = length splits @@ -258,8 +263,8 @@ -- | 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, KnownNat k) - => ReqSketch k (PrimState m) + :: (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 @@ -280,7 +285,7 @@ n <- count this pure $ Just $ (/ fromIntegral n) . fromIntegral <$> buckets -rankAccuracy :: ReqSketch s k -> RankAccuracy +rankAccuracy :: ReqSketch s -> RankAccuracy 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. @@ -301,19 +306,19 @@ _ -> False -- | Gets the smallest value seen by this sketch -minimum :: PrimMonad m => ReqSketch k (PrimState m) -> m Double +minimum :: PrimMonad m => ReqSketch (PrimState m) -> m Double minimum = readURef . minValue -- | Gets the largest value seen by this sketch -maximum :: PrimMonad m => ReqSketch k (PrimState m) -> m Double +maximum :: PrimMonad m => ReqSketch (PrimState m) -> m Double maximum = readURef . maxValue -- | Get the total number of items inserted into the sketch -count :: PrimMonad m => ReqSketch k (PrimState m) -> m Word64 +count :: PrimMonad m => ReqSketch (PrimState m) -> m Word64 count = readURef . totalN -- | Returns the approximate count of items satisfying the criterion set in the ReqSketch 'criterion' field. -countWithCriterion :: (PrimMonad m, s ~ PrimState m, KnownNat k) => ReqSketch k s -> Double -> m Word64 +countWithCriterion :: (PrimMonad m, s ~ PrimState m) => ReqSketch s -> Double -> m Word64 countWithCriterion s value = fromIntegral <$> do empty <- null s if empty @@ -327,7 +332,7 @@ pure (accum + (fromIntegral count_ * wt)) Vector.foldM go 0 compactors -sum :: (PrimMonad m) => ReqSketch k (PrimState m) -> m Double +sum :: (PrimMonad m) => ReqSketch (PrimState m) -> m Double sum = readURef . sumValue -- | Returns an approximation to the Probability Mass Function (PMF) of the input stream given a set of splitPoints (values). @@ -335,8 +340,8 @@ -- -- If the sketch is empty this returns an empty list. probabilityMassFunction - :: (PrimMonad m, KnownNat k) - => ReqSketch k (PrimState m) + :: (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" @@ -365,8 +370,8 @@ -- | Gets the approximate quantile of the given normalized rank based on the lteq criterion. quantile - :: (PrimMonad m, KnownNat k) - => ReqSketch k (PrimState m) + :: (PrimMonad m) + => ReqSketch (PrimState m) -> Double -- ^ normRank - the given normalized rank -> m Double @@ -392,8 +397,8 @@ -- | Gets an array of quantiles that correspond to the given array of normalized ranks. quantiles - :: (PrimMonad m, KnownNat k) - => ReqSketch k (PrimState m) + :: (PrimMonad m) + => ReqSketch (PrimState m) -> [Double] -- ^ normRanks - the given array of normalized ranks. -> m [Double] @@ -405,8 +410,8 @@ 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, KnownNat k) - => ReqSketch k (PrimState m) +rank :: (PrimMonad m) + => ReqSketch (PrimState m) -> Double -- ^ value - the given value -> m Double @@ -425,8 +430,8 @@ -- | Returns an approximate lower bound rank of the given normalized rank. rankLowerBound - :: (PrimMonad m, KnownNat k) - => ReqSketch k (PrimState m) + :: (PrimMonad m) + => ReqSketch (PrimState m) -> Double -- ^ rank - the given rank, a value between 0 and 1.0. -> Int @@ -441,13 +446,13 @@ -- | Gets an array of normalized ranks that correspond to the given array of values. -- TODO, make it ifaster -ranks :: (PrimMonad m, s ~ PrimState m, KnownNat k) => ReqSketch k s -> [Double] -> m [Double] +ranks :: (PrimMonad m, s ~ PrimState m) => ReqSketch s -> [Double] -> m [Double] ranks s values = mapM (rank s) values -- | Returns an approximate upper bound rank of the given rank. rankUpperBound - :: (PrimMonad m, KnownNat k) - => ReqSketch k (PrimState m) + :: (PrimMonad m) + => ReqSketch (PrimState m) -> Double -- ^ rank - the given rank, a value between 0 and 1.0. -> Int @@ -461,20 +466,20 @@ pure $ getRankUB k numLevels rank numStdDev (rankAccuracySetting this == HighRanksAreAccurate) total -- | Returns true if this sketch is empty. -null :: (PrimMonad m) => ReqSketch k (PrimState m) -> m Bool +null :: (PrimMonad m) => ReqSketch (PrimState m) -> m Bool null = fmap (== 0) . readURef . totalN -- | Returns true if this sketch is in estimation mode. -isEstimationMode :: PrimMonad m => ReqSketch k (PrimState m) -> m Bool +isEstimationMode :: PrimMonad m => ReqSketch (PrimState m) -> m Bool isEstimationMode = fmap (> 1) . getNumLevels -- | Returns the current comparison criterion. -isLessThanOrEqual :: ReqSketch s k -> Bool +isLessThanOrEqual :: ReqSketch s -> Bool isLessThanOrEqual s = case criterion s of (:<) -> False (:<=) -> True -computeMaxNominalSize :: PrimMonad m => ReqSketch k (PrimState m) -> m Int +computeMaxNominalSize :: PrimMonad m => ReqSketch (PrimState m) -> m Int computeMaxNominalSize this = do compactors <- getCompactors this Vector.foldM countNominalCapacity 0 compactors @@ -483,7 +488,7 @@ nominalCapacity <- Compactor.getNominalCapacity compactor pure $ nominalCapacity + acc -computeTotalRetainedItems :: PrimMonad m => ReqSketch k (PrimState m) -> m Int +computeTotalRetainedItems :: PrimMonad m => ReqSketch (PrimState m) -> m Int computeTotalRetainedItems this = do compactors <- getCompactors this Vector.foldM countBuffer 0 compactors @@ -493,7 +498,7 @@ buffSize <- DoubleBuffer.getCount buff pure $ buffSize + acc -grow :: (PrimMonad m, KnownNat k) => ReqSketch k (PrimState m) -> m () +grow :: (PrimMonad m) => ReqSketch (PrimState m) -> m () grow this = do lgWeight <- fromIntegral <$> getNumLevels this let rankAccuracy = rankAccuracySetting this @@ -503,7 +508,7 @@ maxNominalCapacity <- computeMaxNominalSize this writeURef (maxNominalCapacitiesSize this) maxNominalCapacity -compress :: (PrimMonad m, KnownNat k) => ReqSketch k (PrimState m) -> m () +compress :: (PrimMonad m) => ReqSketch (PrimState m) -> m () compress this = do compactors <- getCompactors this let compressionStep height compactor = do @@ -525,10 +530,10 @@ -- | Merge other sketch into this one. merge - :: (PrimMonad m, s ~ PrimState m, KnownNat k) - => ReqSketch k s - -> ReqSketch k s - -> m (ReqSketch k s) + :: (PrimMonad m, s ~ PrimState m) + => ReqSketch s + -> ReqSketch s + -> m (ReqSketch s) merge this other = do otherIsEmpty <- getIsEmpty other unless otherIsEmpty $ do @@ -575,7 +580,7 @@ grow this -- | Updates this sketch with the given item. -insert :: (PrimMonad m, KnownNat k) => ReqSketch k (PrimState m) -> Double -> m () +insert :: (PrimMonad m) => ReqSketch (PrimState m) -> Double -> m () insert this item = do unless (isNaN item) $ do isEmpty <- getIsEmpty this diff --git a/test/ProofCheckSpec.hs b/test/ProofCheckSpec.hs --- a/test/ProofCheckSpec.hs +++ b/test/ProofCheckSpec.hs @@ -9,7 +9,6 @@ import Test.QuickCheck import Control.Monad.ST import Control.Monad.Primitive -import GHC.TypeLits import Control.Monad import Debug.Trace @@ -21,7 +20,7 @@ compareRealToApproximate = do let realQuantiles = quantiles spss [50, 90, 95, 99] 100 sampleData -- print realQuantiles - sk <- mkReqSketch @6 HighRanksAreAccurate + sk <- mkReqSketch 6 HighRanksAreAccurate mapM_ (update sk) sampleData let ranks = [0.01, 0.02 .. 0.99] rankInts = map (floor . (* 100)) ranks @@ -32,7 +31,7 @@ assert (actual >= l && actual <= u) -} -upperAndLowerBound :: (PrimMonad m, KnownNat k) => SK.ReqSketch k (Control.Monad.Primitive.PrimState m) +upperAndLowerBound :: (PrimMonad m) => SK.ReqSketch (Control.Monad.Primitive.PrimState m) -> Double -> m (Double, Double, Double) upperAndLowerBound sk r = do l <- SK.rankLowerBound sk r 3 @@ -46,7 +45,7 @@ specify "quantile ranks should fall within advertised upper and lower bounds" $ property $ forAll sampleInputGen $ \(NonEmpty doubles) -> runST $ do let sampleData = V.fromList doubles - sk <- mkReqSketch @6 HighRanksAreAccurate + sk <- mkReqSketch 6 HighRanksAreAccurate mapM_ (insert sk) sampleData let ranks = [0.01, 0.02 .. 0.99] rankInts = map (floor . (* 100)) ranks @@ -59,7 +58,7 @@ specify "values at quantiles should be close to real quantile" $ property $ forAll sampleInputGen $ \(NonEmpty doubles) -> runST $ do let sampleData = V.fromList doubles - sk <- mkReqSketch @6 HighRanksAreAccurate + sk <- mkReqSketch 6 HighRanksAreAccurate mapM_ (update sk) sampleData let ranks = [0.01, 0.02 .. 0.99] rankInts = map (floor . (* 100)) ranks diff --git a/test/RelativeErrorQuantileSpec.hs b/test/RelativeErrorQuantileSpec.hs --- a/test/RelativeErrorQuantileSpec.hs +++ b/test/RelativeErrorQuantileSpec.hs @@ -11,8 +11,7 @@ import DataSketches.Quantiles.RelativeErrorQuantile.Internal.Auxiliary import Data.List hiding (insert) import Data.Maybe (fromJust, isJust) -import Data.Proxy -import GHC.TypeLits +import Data.Word import Test.Hspec import DataSketches.Quantiles.RelativeErrorQuantile.Internal.DoubleBuffer (DoubleIsNonFiniteException(..)) import Text.Show.Pretty @@ -20,23 +19,23 @@ spec :: Spec spec = do specify "non finite PMF/CDF should throw" $ asIO $ do - sk <- mkReqSketch @6 HighRanksAreAccurate + sk <- mkReqSketch 6 HighRanksAreAccurate insert sk 1 cumulativeDistributionFunction sk [0 / 0] `shouldThrow` (== CumulativeDistributionInvariantsSplitsAreNotFinite) specify "updating a sketch with NaN should ignore it" $ asIO $ do - sk <- mkReqSketch @6 HighRanksAreAccurate + sk <- mkReqSketch 6 HighRanksAreAccurate insert sk (0 / 0) isEmpty <- DataSketches.Quantiles.RelativeErrorQuantile.null sk isEmpty `shouldBe` True specify "non finite rank should throw" $ asIO $ do let infinity = read "Infinity"::Double - sk <- mkReqSketch @6 HighRanksAreAccurate + sk <- mkReqSketch 6 HighRanksAreAccurate insert sk 1 (rank sk infinity >>= print) `shouldThrow` (\(DoubleIsNonFiniteException _) -> True) specify "big merge doesn't explode" $ asIO $ do - sk1 <- mkReqSketch @6 HighRanksAreAccurate + sk1 <- mkReqSketch 6 HighRanksAreAccurate mapM_ (insert sk1) [5..10] - sk2 <- mkReqSketch @6 HighRanksAreAccurate + sk2 <- mkReqSketch 6 HighRanksAreAccurate merge sk1 sk2 mapM_ (insert sk2) [1..15] merge sk1 sk2 @@ -54,11 +53,11 @@ let lessThanRs = [0.0, 0.0, 0.0, 0.3, 0.3, 0.3, 0.6, 0.7, 0.7, 0.7] let lessThanEqRs = [0.3, 0.3, 0.3, 0.6, 0.6, 0.6, 0.7, 1.0, 1.0, 1.0] let simpleTestSetup = do - sk <- mkReqSketch @50 HighRanksAreAccurate + sk <- mkReqSketch 50 HighRanksAreAccurate mapM_ (insert sk) simpleTestValues pure sk specify "lots of repeat values should work" $ asIO $ do - sk <- mkReqSketch @6 HighRanksAreAccurate + sk <- mkReqSketch 6 HighRanksAreAccurate replicateM_ 10_000 (insert sk 1 >> retainedItemCount sk) print =<< retainedItemCount sk @@ -71,7 +70,7 @@ actualRanks <- mapM (rank sk) simpleTestValues actualRanks `shouldBe` lessThanRs describe "<=" $ do - let mkSk' sk = sk { criterion = (:<=) } :: ReqSketch 50 (PrimState IO) + let mkSk' sk = sk { criterion = (:<=) } :: ReqSketch (PrimState IO) specify "ranks function should match lessThanRs" $ \sk -> do let sk' = mkSk' sk actualRanks <- ranks sk' simpleTestValues @@ -87,17 +86,17 @@ - -- k min max hra lteq low-to-high or high-to-low - bigTest Proxy 1 200 HighRanksAreAccurate (:<=) True - bigTest Proxy 1 200 LowRanksAreAccurate (:<=) True - bigTest Proxy 1 200 HighRanksAreAccurate (:<) False - bigTest Proxy 1 200 LowRanksAreAccurate (:<) True + -- k min max hra lteq low-to-high or high-to-low + bigTest 6 1 200 HighRanksAreAccurate (:<=) True + bigTest 6 1 200 LowRanksAreAccurate (:<=) True + bigTest 6 1 200 HighRanksAreAccurate (:<) False + bigTest 6 1 200 LowRanksAreAccurate (:<) True mergeSpec describe "quantiles" $ do it "should be reasonable" $ asIO $ do - sk <- mkReqSketch @6 HighRanksAreAccurate + sk <- mkReqSketch 6 HighRanksAreAccurate insert sk 1 insert sk 1 insert sk 1 @@ -105,10 +104,10 @@ r `shouldBe` 1.0 -bigTest :: Proxy 6 -> Int -> Int -> RankAccuracy -> Criterion -> Bool -> Spec +bigTest :: Word32 -> Int -> Int -> RankAccuracy -> Criterion -> Bool -> Spec bigTest k min_ max_ hra crit up = do let testName = unwords - [ "k=" <> show (natVal k) + [ "k=" <> show k , "min=" <> show min_ , "max=" <> show max_ , "hra=" <> show hra @@ -132,28 +131,28 @@ mergeSpec :: Spec mergeSpec = specify "merge works" $ asIO $ do - s1 <- mkReqSketch HighRanksAreAccurate :: IO (ReqSketch 12 (PrimState IO)) + s1 <- mkReqSketch 6 HighRanksAreAccurate :: IO (ReqSketch (PrimState IO)) mapM_ (insert s1) [0..40] - s2 <- mkReqSketch HighRanksAreAccurate :: IO (ReqSketch 12 (PrimState IO)) + s2 <- mkReqSketch 6 HighRanksAreAccurate :: IO (ReqSketch (PrimState IO)) mapM_ (insert s2) [0..40] - s3 <- mkReqSketch HighRanksAreAccurate :: IO (ReqSketch 12 (PrimState IO)) + s3 <- mkReqSketch 6 HighRanksAreAccurate :: IO (ReqSketch (PrimState IO)) mapM_ (insert s3) [0..40] - s <- mkReqSketch HighRanksAreAccurate :: IO (ReqSketch 12 (PrimState IO)) + s <- mkReqSketch 6 HighRanksAreAccurate :: IO (ReqSketch (PrimState IO)) s `merge` s1 s `merge` s2 s `merge` s3 pure () -loadSketch :: forall n. (KnownNat n, ValidK n) => Proxy n -> Int -> Int -> RankAccuracy -> Criterion -> Bool -> IO (ReqSketch n (PrimState IO)) +loadSketch :: Word32 -> Int -> Int -> RankAccuracy -> Criterion -> Bool -> IO (ReqSketch (PrimState IO)) loadSketch k min_ max_ hra ltEq up = do - sk <- mkReqSketch hra :: IO (ReqSketch n (PrimState IO)) + sk <- mkReqSketch k hra :: IO (ReqSketch (PrimState IO)) -- This just seems geared at making sure that ranks come out right regardless of order mapM_ (insert sk . fromIntegral) $ if up then [min_ .. max_] else reverse [min_ .. max_ {- + 1 -}] pure sk -checkAux :: ReqSketch n (PrimState IO) -> IO () +checkAux :: ReqSketch (PrimState IO) -> IO () checkAux sk = do auxiliary <- mkAuxiliaryFromReqSketch sk totalCount <- computeTotalRetainedItems sk @@ -171,7 +170,7 @@ initialRow otherRows -checkGetRank :: KnownNat n => ReqSketch n (PrimState IO) -> Int -> Int -> IO () +checkGetRank :: ReqSketch (PrimState IO) -> Int -> Int -> IO () checkGetRank sk min_ max_ = do let (v : spArr) = evenlySpacedFloats 0 (fromIntegral max_) 11 initialRank <- rank sk v @@ -185,18 +184,18 @@ (v, initialRank) spArr -checkGetRanks :: KnownNat n => ReqSketch n (PrimState IO) -> Int -> IO () +checkGetRanks :: ReqSketch (PrimState IO) -> Int -> IO () checkGetRanks sk max_ = do let sp = evenlySpacedFloats 0 (fromIntegral max_) 11 void $ ranks sk sp -checkGetCDF :: KnownNat n => ReqSketch n (PrimState IO) -> IO () +checkGetCDF :: ReqSketch (PrimState IO) -> IO () checkGetCDF sk = do let spArr = [20, 40 .. 180] r <- cumulativeDistributionFunction sk spArr r `shouldSatisfy` isJust -checkGetPMF :: KnownNat n => ReqSketch n (PrimState IO) -> IO () +checkGetPMF :: ReqSketch (PrimState IO) -> IO () checkGetPMF sk = do let spArr = [20, 40 .. 180] r <- probabilityMassFunction sk spArr @@ -210,7 +209,7 @@ checkGetRankConcreteExample :: RankAccuracy -> Criterion -> IO () checkGetRankConcreteExample ra crit = do - sk <- loadSketch (Proxy :: Proxy 12) 1 1000 ra crit True + sk <- loadSketch 12 1 1000 ra crit True rLB <- rankLowerBound sk 0.5 1 rLB `shouldSatisfy` (> 0) rLB <- case ra of @@ -230,8 +229,7 @@ checkGetQuantiles - :: KnownNat n - => ReqSketch n (PrimState IO) + :: ReqSketch (PrimState IO) -> IO () checkGetQuantiles sk = do let rArr = [0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1]