cuckoo (empty) → 0.1.0.0
raw patch · 10 files changed
+1545/−0 lines, 10 filesdep +QuickCheckdep +basedep +bytestring
Dependencies added: QuickCheck, base, bytestring, criterion, cryptonite, cuckoo, hashable, memory, mwc-random, pcg-random, primitive, random, stopwatch, vector
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +23/−0
- bench/Internal.hs +125/−0
- bench/SpellChecker.hs +90/−0
- cuckoo.cabal +155/−0
- lib/random/System/Random/Internal.hs +94/−0
- src/Data/Cuckoo.hs +577/−0
- src/Data/Cuckoo/Internal.hs +219/−0
- test/Main.hs +227/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for cuckoo++## 0.1.0.0 -- 2019-08-06++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Lars Kuhtz <lakuhtz@gmail.com>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Lars Kuhtz nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,23 @@+[](https://travis-ci.org/larskuhtz/cuckoo)++Haskell implementation of Cuckoo filters as described in++[B. Fan, D.G. Anderson, M. Kaminsky, M.D. Mitzenmacher. Cuckoo Filter:+Practically Better Than Bloom. In Proc. CoNEXT,+2014.](https://www.cs.cmu.edu/~dga/papers/cuckoo-conext2014.pdf)++Cuckoo filters are a data structure for probabilistic set membership. They+support insertion, deletion, and membership queries for set elements.++Membership queries may return false positive results. But queries don't return+false negative results.++Unlike Bloom filters, Cuckoo filters maintain an upper bound on the false+positive rate that is independent of the load of the filter. However, insertion+of new elements in the filter can fail. For typical configurations this+probability is very small for load factors smaller than 90 percent.++The implementation allows the user to specify the bucket size and the fingerprint+size in addition to the capacity of the filter. The user can also provide custom+functions for computing the primary hash and fingerprint.+
+ bench/Internal.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: Main+-- Copyright: Copyright © 2019 Lars Kuhtz <lakuhtz@gmail.com>+-- License: BSD3+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+module Main+( main++-- * checks+, prop_fit+, prop_p2+) where++import Criterion+import Criterion.Main++import Data.Bits++import Test.QuickCheck++-- internal modules++import Data.Cuckoo.Internal++-- -------------------------------------------------------------------------- --+-- Main++main :: IO ()+main = do+ quickCheck prop_fit+ quickCheck prop_p2+ defaultMain+ [ bgroup "fit"+ [ fitBench "floating" floatingFit+ , fitBench "integral-0" integralFit_0+ , fitBench "integral-1" integralFit_1+ ]+ , bgroup "nextPowerOfTwo"+ [ p2Bench "floating" floatingP2+ , p2Bench "integral-0" integralP2_0+ , p2Bench "integral-1" integralP2_1+ , p2Bench "integral-2" integralP2_2+ ]+ ]++-- -------------------------------------------------------------------------- --+-- Fit++fitBench :: String -> (Int -> Int -> Int) -> Benchmark+fitBench l f = bgroup l+ [ bench "1" $ whnf (f 64) 8+ , bench "2" $ whnf (f 67) 4+ , bench "3" $ whnf (f 1024) 10+ , bench "4" $ whnf (f 1234567) 3456+ ]++floatingFit :: Int -> Int -> Int+floatingFit = fit+{-# INLINE floatingFit #-}++integralFit_0 :: Int -> Int -> Int+integralFit_0 a b = let (x,y) = a `divMod` b in x + signum y+{-# INLINE integralFit_0 #-}++integralFit_1 :: Int -> Int -> Int+integralFit_1 a b = 1 + (a - 1) `div` b+{-# INLINE integralFit_1 #-}++prop_fit :: Int -> Positive Int -> Property+prop_fit x (Positive y)+ = floatingFit x y === integralFit_0 x y+ .&&. floatingFit x y === integralFit_1 x y++-- -------------------------------------------------------------------------- --+-- PowerOfTwo++p2Bench :: String -> (Int -> Int) -> Benchmark+p2Bench l f = bgroup l $ go <$> [1,4,5,64,78,1232343467]+ where+ go i = bench (show i) $ whnf f i++floatingP2 :: Int -> Int+floatingP2 = nextPowerOfTwo+{-# INLINE floatingP2 #-}++-- popCount seems to profite a lot form using @-mbmi2 -msse4.2@+--+integralP2_0 :: Int -> Int+integralP2_0 0 = 1+integralP2_0 x = 1 `unsafeShiftL` (highestBit + signum (popCount x - 1))+ where+ highestBit = finiteBitSize x - countLeadingZeros x - 1+{-# INLINE integralP2_0 #-}++integralP2_1 :: Int -> Int+integralP2_1 0 = 1+integralP2_1 x = 1 `unsafeShiftL` (finiteBitSize x - countLeadingZeros (x - 1))+{-# INLINE integralP2_1 #-}++-- popCount seems to profite a lot form using @-mbmi2 -msse4.2@+--+integralP2_2 :: Int -> Int+integralP2_2 0 = 1+integralP2_2 x+ | popCount x == 1 = x+ | otherwise = 1 `unsafeShiftL` (finiteBitSize x - countLeadingZeros (x - 1))+{-# INLINE integralP2_2 #-}++-- Ignore negative values+--+prop_p2 :: NonNegative Int -> Property+prop_p2 (NonNegative x)+ = floatingP2 x === integralP2_0 x+ .&&. floatingP2 x === integralP2_1 x+ .&&. floatingP2 x === integralP2_2 x+
+ bench/SpellChecker.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module: Main+-- Copyright: Copyright © 2019 Lars Kuhtz <lakuhtz@gmail.com>+-- License: BSD3+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+-- This code is an adaptation of the respective code from Chris Coffey's cuckoo filter package,+-- which in turn is borrowed from Bryan O'Sullivan's bloom filter package.+--+module Main+( main+, runSpellCheck+) where++import Control.Monad (filterM, unless)+import Control.StopWatch++import Data.ByteArray ()+import qualified Data.ByteString.Char8 as B+import qualified Data.Cuckoo as C+import Data.List ((\\))++import Prelude hiding (words)++-- Just changing the salt isn't enough to make the hash functions independent+-- enough.+--+-- instance C.CuckooFilterHash B.ByteString where+-- cuckooHash (C.Salt s) a = fromIntegral $! hashWithSalt s a+-- cuckooFingerprint (C.Salt s) a = fromIntegral $! hashWithSalt (s + 23) a+-- {-# INLINE cuckooHash #-}+-- {-# INLINE cuckooFingerprint #-}++instance C.CuckooFilterHash B.ByteString where+ cuckooHash (C.Salt s) = C.fnv1a_bytes s+ cuckooFingerprint (C.Salt s) = C.sip_bytes s+ {-# INLINE cuckooHash #-}+ {-# INLINE cuckooFingerprint #-}++main :: IO ()+main = runSpellCheck++dict :: String+dict = "/usr/share/dict/words"++runSpellCheck :: IO ()+runSpellCheck = do+ -- read and count words+ (words, t0) <- stopWatch $ do+ words <- B.lines `fmap` B.readFile dict+ putStrLn $ show (length words) ++ " words"+ return words++ putStrLn $ show t0 <> "s to count words"++ ((f, failed), t1) <- stopWatch $ do+ f <- C.newCuckooFilter @IO @4 @8 0 500000+ failed <- filterM (fmap not . C.insert f) words+ return (f, failed)++ putStrLn $ show t1 ++ "s to construct filter"++ -- check words+ (missing, t2) <- stopWatch $+ filterM (fmap not . C.member f) words++ putStrLn $ show t2 ++ "s to query every element"++ -- report results++ unless (null failed) $+ putStrLn $ "failed inserts: " <> show (length failed)++ let unexpectedMissing = missing \\ failed+ unless (null $ unexpectedMissing) $+ putStrLn $ "FAILURE: missing " <> show (length unexpectedMissing)++ let falsePositives = failed \\ missing+ unless (null $ falsePositives) $+ putStrLn $ "false positives: " <> show (length falsePositives)++ lf <- C.loadFactor f+ putStrLn $ "load factor: " <> show lf+
+ cuckoo.cabal view
@@ -0,0 +1,155 @@+cabal-version: 2.2+name: cuckoo+version: 0.1.0.0+synopsis: Haskell Implementation of Cuckoo Filters+Description:+ Haskell implementation of Cuckoo filters as described in+ .+ <https://www.cs.cmu.edu/~dga/papers/cuckoo-conext2014.pdf B. Fan, D.G. Anderson, M. Kaminsky, M.D. Mitzenmacher. Cuckoo Filter: Practically Better Than Bloom. In Proc. CoNEXT, 2014.>+ .+ Cuckoo filters are a data structure for probabilistic set membership. They+ support insertion, deletion, and membership queries for set elements.+ .+ Membership queries may return false positive results. But queries don't+ return false negative results.+ .+ Unlike Bloom filters, Cuckoo filters maintain an upper bound on the false+ positive rate that is independent of the load of the filter. However,+ insertion of new elements in the filter can fail. For typical+ configurations this probability is very small for load factors smaller than+ 90 percent.++homepage: https://github.com/larskuhtz/cuckoo+bug-reports: https://github.com/larskuhtz/cuckoo/issues+license: BSD-3-Clause+license-file: LICENSE+author: Lars Kuhtz+maintainer: lakuhtz@gmail.com+copyright: Copyright (c) 2019, Lars Kuhtz <lakuhtz@gmail.com>+category: Data+tested-with:+ GHC==8.6.5+ GHC==8.4.4+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/larskuhtz/cuckoo.git++flag mwc-random+ description: Use mwc-random instead of the random package+ manual: True+ default: False++flag pcg-random+ description: Use pcg-random instead of the random package+ manual: True+ default: False++library random-internal+ hs-source-dirs: lib/random+ default-language: Haskell2010+ exposed-modules:+ System.Random.Internal+ ghc-options:+ -Wall+ build-depends:+ base >=4.11 && <4.15+ , primitive >=0.7++ if flag(pcg-random)+ build-depends:+ pcg-random >=0.1+ cpp-options: -DRANDOM_PCG+ elif flag(mwc-random)+ build-depends:+ mwc-random >=0.14+ , vector >=0.12+ cpp-options: -DRANDOM_MWC+ else+ build-depends:+ random >=1.1++library+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options:+ -Wall+ exposed-modules:+ Data.Cuckoo+ Data.Cuckoo.Internal+ build-depends:+ random-internal++ -- external+ , base >=4.11 && <4.15+ , memory >=0.14+ , primitive >=0.7+ , vector >=0.12++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options:+ -Wall+ -rtsopts+ -threaded+ -with-rtsopts=-N+ main-is: Main.hs+ build-depends:+ -- internal+ cuckoo+ , random-internal++ -- external+ , base >=4.11 && <4.15+ , bytestring >=0.10+ , cryptonite >=0.26+ , hashable >=1.3+ , memory >=0.14+ , stopwatch >=0.1++benchmark spellchecker+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ default-language: Haskell2010+ ghc-options:+ -Wall+ -rtsopts+ -threaded+ -with-rtsopts=-N+ main-is: SpellChecker.hs+ build-depends:+ -- internal+ cuckoo++ -- external+ , base >=4.11 && <4.15+ , bytestring >=0.10+ , memory >=0.14+ , stopwatch >=0.1++benchmark internal-benchmarks+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Internal.hs+ default-language: Haskell2010+ ghc-options:+ -Wall+ -rtsopts+ -threaded+ -with-rtsopts=-N+ -mbmi2+ -msse4.2+ build-depends:+ -- internal+ cuckoo++ -- external+ , QuickCheck >= 2.13+ , base >=4.10 && <4.15+ , criterion >= 1.5+
+ lib/random/System/Random/Internal.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: System.Random.Internal+-- Copyright: Copyright © 2019 Lars Kuhtz <lakuhtz@gmail.com>+-- License: BSD3+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+-- Dispatch for different PRNG implementations+--+module System.Random.Internal+( Gen+, Variate+, initialize+, uniform+, uniformR+) where++-- -------------------------------------------------------------------------- --+-- PCG+#ifdef RANDOM_PCG++import Control.Monad.Primitive+import System.Random.PCG hiding (initialize)+import qualified System.Random.PCG as PCG++initialize+ :: PrimMonad m+ => Int+ -> m (Gen (PrimState m))+initialize salt = PCG.initialize 0 (fromIntegral salt)++-- -------------------------------------------------------------------------- --+-- MWC+#elif defined RANDOM_MWC++import Control.Monad.Primitive+import Data.Vector+import System.Random.MWC hiding (initialize)+import qualified System.Random.MWC as MWC++initialize+ :: PrimMonad m+ => Int+ -> m (Gen (PrimState m))+initialize salt = MWC.initialize (singleton $ fromIntegral salt)++-- -------------------------------------------------------------------------- --+-- Random+#else++import Control.Monad.Primitive+import Data.STRef+import System.Random++type Variate a = (Random a)++type Gen s = STRef s StdGen++initialize+ :: PrimMonad m+ => Int+ -> m (Gen (PrimState m))+initialize salt = stToPrim $ newSTRef $! mkStdGen salt++uniformR+ :: Variate b+ => PrimMonad m+ => (b, b)+ -> Gen (PrimState m)+ -> m b+uniformR range gen = stToPrim $ do+ (!r, !g) <- randomR range <$> readSTRef gen+ writeSTRef gen g+ return r++uniform+ :: Variate b+ => PrimMonad m+ => Gen (PrimState m)+ -> m b+uniform gen = stToPrim $ do+ (!r, !g) <- random <$> readSTRef gen+ writeSTRef gen g+ return r++#endif+
+ src/Data/Cuckoo.hs view
@@ -0,0 +1,577 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module: Data.Cuckoo+-- Copyright: Copyright © 2019 Lars Kuhtz <lakuhtz@gmail.com>+-- License: BSD3+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+-- Haskell implementation of Cuckoo filters as described in+--+-- <https://www.cs.cmu.edu/~dga/papers/cuckoo-conext2014.pdf B. Fan, D.G. Anderson, M. Kaminsky, M.D. Mitzenmacher. Cuckoo Filter: Practically Better Than Bloom. In Proc. CoNEXT, 2014.>+--+-- Cuckoo filters are a data structure for probabilistic set membership. They+-- support insertion, deletion, and membership queries for set elements.+--+-- Membership queries may return false positive results. But queries don't+-- return false negative results.+--+-- Unlike Bloom filters, Cuckoo filters maintain an upper bound on the false+-- positive rate that is independent of the load of the filter. However,+-- insertion of new elements in the filter can fail. For typical+-- configurations this probability is very small for load factors smaller than+-- 90 percent.+--+module Data.Cuckoo+(+-- * Hash Functions+ Salt(..)+, CuckooFilterHash(..)++-- ** Hash functions+, sip+, sip_bytes+, fnv1a+, fnv1a_bytes++-- * Cuckoo Filter+, CuckooFilter+, CuckooFilterIO+, newCuckooFilter++-- * Cuckoo Filter Operations+, insert+, member+, delete++-- * Utils+, sizeInAllocatedBytes+, capacityInItems+, itemCount+, loadFactor++-- * Debugging Utils+, showFilter+, itemHashes+) where++import Control.Applicative+import Control.Monad+import Control.Monad.Primitive++import Data.Bits+import Data.Bool+import Data.Kind+import Data.Maybe+import Data.Primitive.ByteArray++import Foreign++import GHC.TypeLits++import Numeric.Natural++import Prelude hiding (null)++import System.Random.Internal++import Text.Printf++-- internal modules++import Data.Cuckoo.Internal++-- -------------------------------------------------------------------------- --+-- Hash Functions++-- The hashable package is a bit of a kitchen sink. Instances for different data+-- types use hash functions with very different properites and of varying+-- quality. Neither of this is documented.+--+-- Primitive base types, including all number types use fast instances that+-- provided very little uniformity in the output with respect to input data and+-- salt. Don't use these!+--+-- ByteString uses a pure Haskell implementation of Sip hash.+--+-- The helper functions for low-level ptrs (Ptr, ByteArray) use a C+-- implementation of fnv.+--+-- Because of the variying quality and properties of the functions, absence of+-- any control over which function is use, and no guarantees with respect to+-- stability accross versions, we don't use that package altogether.+--++-- | Salt for hash computations.+--+newtype Salt = Salt Int+ deriving (Show, Eq, Ord, Enum, Integral, Real, Num)++-- | Choosing good hash functions is imperative for a good performance of a+-- cuckoo filter. The hash functions must be+--+-- * independent and+-- * provide good uniformity on the lower bits of the output.+--+-- The default implementations use sip hash for 'cuckooHash' and 'fnv1a' (64+-- bit) for 'cuckooFingerprint'.+--+class CuckooFilterHash a where++ -- | This function must provide good entropy on the lower+ -- \(2^b - 1\) bits of the result, where \(b\) is the number of buckets.+ --+ cuckooHash :: Salt -> a -> Word64++ -- | This function must provide good entropy on the lower+ -- bits of the size of a fingerprint.+ --+ cuckooFingerprint :: Salt -> a -> Word64++ default cuckooHash :: Storable a => Salt -> a -> Word64+ cuckooHash (Salt s) a = sip s a+ {-# INLINE cuckooHash #-}++ default cuckooFingerprint :: Storable a => Salt -> a -> Word64+ cuckooFingerprint (Salt s) a = fnv1a s a+ {-# INLINE cuckooFingerprint #-}++-- -------------------------------------------------------------------------- --+-- Cuckoo Filter++-- | Cuckoo Filter with+--+-- * State token @s :: Type@,+-- * bucket size @b :: Nat@,+-- * fingerprint size @f :: Nat@, and+-- * content type @a :: Type@.+--+-- The following constraints apply+--+-- * \(0 < f \leq 32\)+-- * \(0 < b\)+--+-- The implementation is not thread safe. For concurrent use the filter must be+-- wrapped in a read-write lock.+--+data CuckooFilter s (b :: Nat) (f :: Nat) (a :: Type)+ = CuckooFilter+ { _cfBucketCount :: {-# UNPACK #-} !Int+ , _cfSalt :: {-# UNPACK #-} !Salt+ , _cfRng :: {-# UNPACK #-} !(Gen s)+ , _cfData :: {-# UNPACK #-} !(MutableByteArray s)+ }++-- | Cuckoo filter that can be used in the `IO` monad.+--+type CuckooFilterIO b f a = CuckooFilter RealWorld b f a++-- | Create a new Cuckoo filter that has at least the given capacity.+--+-- The type parameters are+--+-- * bucket size @b :: Nat@,+-- * fingerprint size @f :: Nat@,+-- * content type @a :: Type@, and+-- * Monad @m :: Type -> Type@,+--+-- Enabling the `TypeApplications` language extension provides a convenient way+-- for passing the type parameters to the function.+--+-- The following constraints apply:+--+-- * \(0 < f \leq 32\),+-- * \(0 < b\).+--+-- The false positive rate depends mostly on the value of @f@. It is bounded+-- from above by \(\frac{2b}{2^f}\). In most cases @4@ is a good choice for @b@.+--+-- Actual performance depends on the choice of good hash functions that provide+-- high uniformity on the lower bits.+--+-- The actual capacity may be much larger than what is requested, because the+-- actual bucket count is a power of two.+--+newCuckooFilter+ :: forall m b f a+ . KnownNat b+ => KnownNat f+ => PrimMonad m+ => Salt+ -- ^ Salt for the hash functions+ -> Natural+ -- ^ Size (must be positive)+ -> m (CuckooFilter (PrimState m) b f a)+newCuckooFilter salt n = do+ check+ arr <- newByteArray bytes+ fillByteArray arr 0 bytes 0+ CuckooFilter buckets salt+ <$> initialize (int salt)+ <*> pure arr+ where+ minBuckets = intFit n (w @b) -- minimum number of buckets match requested capacity+ buckets = intNextPowerOfTwo (int minBuckets) -- actual number of buckets+ items = w @b * buckets -- actual capacity (in number of items)+ bytes = intFit @_ @Int (w @f * items) 8 + 4 -- total number of allocated bytes++ -- we add 4 extra bytes to avoid having to deal with corner cases when+ -- reading and writing fingerprints that are not aligned to Word32 at+ -- the end of the filter.++ check+ | not (0 < w @f) = error "Fingerprint size must be positive"+ | not (w @f <= 32) = error "Fingerprint size must not be larger than 32"+ | not (0 < w @b) = error "Bucket size (items per bucket) must be positive"+ | not (0 < n) = error "The size (number of items) of the filter must be positive"+ | not (32 <= int n * w @f) = error "Seriously? Are you kidding me? If you need to represent such a tiny set, you'll have to pick another data structure for that"+ | otherwise = return ()++-- -------------------------------------------------------------------------- --+-- Insert++-- TODO: reduce number of reads, in checkBucket and don't re-read value+-- during setFingerprint. Similarly, don't recompute hashes.+--+-- TODO: is the RNG really important here (for security or performance) or is+-- the hash function sufficient? (For preventing attacks, is the salt+-- sufficient). Could we also compute the relocation slot from the hash?++-- | Insert an item into the filter and return whether the operation was+-- successful. If insertion fails, the filter is unchanged.+--+-- This function is not thread safe. No concurrent writes or reads should occur+-- while this function is executed. If this is needed a lock must be used.+--+-- This function is not exception safe. The filter must not be used any more+-- after an asynchronous exception has been throw during the computation of this+-- function. If this function is used in the presence of asynchronous exceptions+-- it should be apprioriately masked.+--+insert+ :: forall b f a m+ . KnownNat f+ => KnownNat b+ => PrimMonad m+ => CuckooFilterHash a+ => CuckooFilter (PrimState m) b f a+ -> a+ -> m Bool+insert f a = do+ (b1, b2, fp) <- getBucketsRandom f a+ checkBucket f b1 null >>= \case+ Just i -> True <$ setFingerprint f b1 i fp+ Nothing -> kick 500 b2 fp+ where++ -- TODO make this exception safe? Do we need that?+ --+ kick 0 _ _ = return False+ kick c b k = checkBucket f b null >>= \case+ Just i -> True <$ setFingerprint f b i k+ Nothing -> do+ i <- randomSlot+ k' <- swapFingerprint b i k+ kick (pred @Int c) (otherBucket f b k') k' >>= \case+ False -> False <$ setFingerprint f b i k'+ x -> return x+ {-# INLINE kick #-}++ randomSlot = Slot <$> uniformR (0, w @b - 1) (_cfRng f)+ {-# INLINE randomSlot #-}++ swapFingerprint b i k = do+ k' <- readFingerprint f b i+ setFingerprint f b i k+ return k'+ {-# INLINE swapFingerprint #-}++-- -------------------------------------------------------------------------- --+-- Member Test++-- | Test whether an item is in the set that is represented by the Cuckoo+-- filter.+--+-- A negative result means that the item is definitively not in the set. A+-- positive result means that the item is most likely in the set. The rate of+-- false positives is bounded from above by \(\frac{2b}{2^f}\) where @b@ is the number+-- of items per bucket and @f@ is the size of a fingerprint in bits.+--+member+ :: CuckooFilterHash a+ => PrimMonad m+ => KnownNat f+ => KnownNat b+ => CuckooFilter (PrimState m) b f a+ -> a+ -> m Bool+member f a = checkBucket f b1 fp >>= \case+ Just _ -> return True+ Nothing -> checkBucket f b2 fp >>= \case+ Just _ -> return True+ Nothing -> return False+ where+ salt = _cfSalt f+ b1 = bucket1 f a+ b2 = otherBucket f b1 fp+ fp = mkFingerprint salt a+{-# INLINE member #-}++-- -------------------------------------------------------------------------- --+-- Delete++-- | Delete an items from the filter.+--+-- /IMPORTANT/ An item must only be deleted if it was successfully added to the+-- filter before (and hasn't been deleted since then).+--+-- Deleting an item that isn't in the filter will result in the filter returning+-- false negative results.+--+-- This function is not thread safe. No concurrent writes must occur while this+-- function is executed. If this is needed a lock must be used. Concurrent reads+-- are fine.+--+delete+ :: CuckooFilterHash a+ => PrimMonad m+ => KnownNat f+ => KnownNat b+ => CuckooFilter (PrimState m) b f a+ -> a+ -> m Bool+delete f a = do+ (b1, b2, fp) <- getBucketsRandom f a+ checkBucket f b1 fp >>= \case+ Just i -> True <$ setFingerprint f b1 i null+ Nothing -> checkBucket f b2 fp >>= \case+ Just i -> True <$ setFingerprint f b2 i null+ Nothing -> return False++-- -------------------------------------------------------------------------- --+-- Internal+-- -------------------------------------------------------------------------- --++newtype Fingerprint (f :: Nat) = Fingerprint Word64+ deriving (Show, Eq, Ord)++newtype Bucket = Bucket Int+ deriving (Show, Eq, Ord, Enum, Integral, Real, Num)++newtype Slot = Slot Int+ deriving (Show, Eq, Ord, Enum, Integral, Real, Num)++-- TODO: Should we expose this function, too, in 'CuckooFilterHash'? By hiding+-- it here there is some chance that a user accidentally picks a function that+-- isn't independent from this one.+--+hashFingerprint :: Salt -> Fingerprint f -> Int+hashFingerprint (Salt s) (Fingerprint a) = int $! sip2 s a+{-# INLINE hashFingerprint #-}++mkFingerprint+ :: forall f a+ . KnownNat f+ => CuckooFilterHash a+ => Salt+ -> a+ -> Fingerprint f+mkFingerprint salt a = Fingerprint $! max 1 $!+ cuckooFingerprint salt a .&. (2 ^ w @f - 1)+{-# INLINE mkFingerprint #-}++bucket1 :: CuckooFilterHash a => CuckooFilter s b f a -> a -> Bucket+bucket1 f a = Bucket $! int $! cuckooHash (_cfSalt f) a .&. (int $ _cfBucketCount f - 1)+{-# INLINE bucket1 #-}++otherBucket :: CuckooFilter s b f a -> Bucket -> Fingerprint f -> Bucket+otherBucket f (Bucket b) fp = Bucket $!+ (b `xor` hashFingerprint (_cfSalt f) fp) .&. (int $ _cfBucketCount f - 1)+{-# INLINE otherBucket #-}++ix :: Bucket -> Int+ix (Bucket i) = i+{-# INLINE ix #-}++-- | Fingerprints must be of at most 32 bits. Yet we represent them as Word64,+-- this is compromise to work with an reasonably efficient 32bit alignment,+-- while guaranteeing that the for each fingerprint there is an alignment such+-- that the fingerprint fits into the returned value with respect to the+-- alignment.+--+readFingerprint+ :: forall b f a m+ . KnownNat f+ => KnownNat b+ => PrimMonad m+ => CuckooFilter (PrimState m) b f a+ -- ^ Filter+ -> Bucket+ -- ^ bucket number+ -> Slot+ -- ^ slot number+ -> m (Fingerprint f)+readFingerprint f n (Slot i) = do+ v <- get dat pos+ return $ Fingerprint $! (v `shiftR` off) .&. mask+ where+ dat = _cfData f+ mask = (2 ^ (w @f)) - 1+ (pos, off) = (w @b * w @f * ix n + w @f * i) `divMod` 32+{-# INLINE readFingerprint #-}++setFingerprint+ :: forall b f a m+ . KnownNat f+ => KnownNat b+ => PrimMonad m+ => CuckooFilter (PrimState m) b f a+ -- ^ Filter+ -> Bucket+ -- ^ bucket number+ -> Slot+ -- ^ slot number+ -> Fingerprint f+ -> m ()+setFingerprint f n (Slot i) (Fingerprint fp) = do+ v <- get dat pos+ set dat pos $ (fp `shiftL` off) .|. (v .&. complement mask)+ where+ dat = _cfData f+ mask = (2 ^ (w @f) - 1) `shiftL` off+ (pos, off) = (w @b * w @f * ix n + w @f * i) `divMod` 32+{-# INLINE setFingerprint #-}++-- -------------------------------------------------------------------------- --+-- Utils++null :: Fingerprint f+null = Fingerprint 0+{-# INLINE null #-}++getBucketsRandom+ :: CuckooFilterHash a+ => PrimMonad m+ => KnownNat f+ => KnownNat b+ => CuckooFilter (PrimState m) b f a+ -> a+ -> m (Bucket, Bucket, Fingerprint f)+getBucketsRandom f a = bool (b1, b2, fp) (b2, b1, fp) <$> uniform rng+ where+ salt = _cfSalt f+ rng = _cfRng f+ b1 = bucket1 f a+ b2 = otherBucket f b1 fp+ fp = mkFingerprint salt a+{-# INLINE getBucketsRandom #-}++checkBucket+ :: forall b f a m+ . PrimMonad m+ => KnownNat f+ => KnownNat b+ => CuckooFilter (PrimState m) b f a+ -> Bucket+ -> Fingerprint f+ -> m (Maybe Slot)+checkBucket f b fp = go (w @b - 1)+ where+ go :: Int -> m (Maybe Slot)+ go (-1) = return Nothing+ go i = readFingerprint f b (Slot i) >>= \x -> if x == fp+ then return $ Just (Slot i)+ else go (pred i)+ -- TODO: can we teach GHC to unroll this loop statically without+ -- defining a class. Maybe GHC does already unroll it?++-- | Total number of items that the filter can hold. In practice a load factor+-- of ~95% of this number can be reached.+--+capacityInItems :: forall b f a s . KnownNat b => CuckooFilter s b f a -> Int+capacityInItems f = _cfBucketCount f * w @b+{-# INLINE capacityInItems #-}++-- | The total number of bytes allocated for storing items in the filter.+--+sizeInAllocatedBytes :: forall b f a s . KnownNat f => KnownNat b => CuckooFilter s b f a -> Int+sizeInAllocatedBytes f = intFit @_ @Int (capacityInItems f * w @f) 8+{-# INLINE sizeInAllocatedBytes #-}++-- | Number of items currently stored in the filter.+--+-- /Note/ that computing this number is expensive \(\mathcal{O}(n)\).+--+itemCount+ :: forall b f a m+ . PrimMonad m+ => KnownNat b+ => KnownNat f+ => CuckooFilter (PrimState m) b f a+ -> m Int+itemCount f = foldM (\x i -> foldM (\x' j -> go x' (Bucket i) (Slot j)) x [0.. w @b - 1]) 0 [0.._cfBucketCount f - 1]+ where+ go x b s = readFingerprint f b s >>= \fp -> case fp == Fingerprint 0 of+ True -> return x+ False -> return (succ x)++-- | The current load factor of the filter in percent.+--+-- @+-- loadFactor f = 100 * itemCount f / capacityInItems+-- @+--+-- /Note/ that computing this number is expensive \(\mathcal{O}(n)\).+--+loadFactor+ :: forall b f a m+ . PrimMonad m+ => KnownNat b+ => KnownNat f+ => CuckooFilter (PrimState m) b f a+ -> m Double+loadFactor f = do+ i <- itemCount f+ return $! 100 * int i / int (capacityInItems f)++-- -------------------------------------------------------------------------- --+-- Debugging Tools++-- | Show the contents of the filter as a list of buckets with values show in+-- hex. Used for debugging purposes.+--+showFilter+ :: forall b f a+ . KnownNat f+ => KnownNat b+ => CuckooFilter RealWorld b f a+ -> IO [[String]]+showFilter f = forM [0.. _cfBucketCount f - 1] $ \(i :: Int) -> do+ forM [0 .. w @b - 1] $ \(j :: Int) -> do+ Fingerprint fp <- readFingerprint f (Bucket i) (Slot j)+ return $ printf ("%0" <> show (intFit @_ @Int (w @f) 8) <> "x") fp++-- | Returns the different hashes that are associated with an item in the+-- filter. Used for debugging purposes.+--+itemHashes+ :: forall b f a s+ . KnownNat f+ => CuckooFilterHash a+ => CuckooFilter s b f a+ -> a+ -> (Int, Int, Word64)+itemHashes f a = (b1_, b2_, fp_)+ where+ fp@(Fingerprint fp_) = mkFingerprint @f (_cfSalt f) a+ b1@(Bucket b1_) = bucket1 f a+ Bucket b2_ = otherBucket f b1 fp+
+ src/Data/Cuckoo/Internal.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module: Data.Cuckoo.Internal+-- Copyright: Copyright © 2019 Lars Kuhtz <lakuhtz@gmail.com>+-- License: BSD3+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+-- Internal Utilities. No guarantee is made about the stability of these+-- functions. Changes to these function won't be announced in the CHANGELOG and+-- are not reflected in the package version.+--+module Data.Cuckoo.Internal+( w+, int+, fit+, intFit+, nextPowerOfTwo+, intNextPowerOfTwo+, set+, get++-- * Hash functions+, sip+, fnv1a+, fnv1a_bytes+, sip_bytes+, sip2+) where++import Control.Monad.Primitive++import Data.Bits+import qualified Data.ByteArray as BA+import qualified Data.ByteArray.Hash as BA+import qualified Data.ByteArray.Pack as BA+import Data.Primitive.ByteArray++import Foreign++import GHC.Exts+import GHC.TypeLits++-- | Reify type level 'Nat' into 'Int' value.+--+w :: forall (n :: Nat) . KnownNat n => Int+w = int $ natVal' @n proxy#+{-# INLINE w #-}++-- | An shorter alias for 'fromIntegral'.+--+int :: Integral a => Num b => a -> b+int = fromIntegral+{-# INLINE int #-}++-- | @fit a b@ computes how many @b@s are needed to fit @a@, i.e.+-- \(\left\lceil\frac{a}{b}\right\rceil\).+--+-- For instance,+--+-- prop> fit 7 3 == 3+-- prop> fit 6 3 == 2+--+fit :: Real a => Real b => Integral c => a -> b -> c+fit a b = ceiling @Double $ realToFrac a / realToFrac b+{-# INLINE fit #-}++-- | @fit a b@ computes how many @b@s are needed to fit @a@, i.e.+-- \(\left\lceil\frac{a}{b}\right\rceil\).+--+-- For instance,+--+-- prop> fit 7 3 == 3+-- prop> fit 6 3 == 2+--+intFit :: Integral a => Integral b => a -> b -> a+intFit a b = 1 + (a - 1) `div` int b+{-# INLINE intFit #-}++-- | @nextPowerOfTwo a@ computes the smallest power of two that is larger or+-- equal than @a@.+--+nextPowerOfTwo :: Real a => Integral b => a -> b+nextPowerOfTwo x = 2 ^ ceiling @Double @Int (logBase 2 $ realToFrac x)+{-# INLINE nextPowerOfTwo #-}++-- | @nextPowerOfTwo a@ computes the smallest power of two that is larger or+-- equal than @a@.+--+intNextPowerOfTwo :: Int -> Int+intNextPowerOfTwo 0 = 1+intNextPowerOfTwo x = 1 `unsafeShiftL` (finiteBitSize x - countLeadingZeros (x - 1))+{-# INLINE intNextPowerOfTwo #-}++-- | Computes a 64 bit Fnv1a hash for a value that has an 'Storable' instance.+--+-- The first argument is use as a salt.+--+fnv1a+ :: Storable a+ => Int+ -- ^ Salt+ -> a+ -- ^ Value that is hashes+ -> Word64+fnv1a s x = r+ where+ Right (BA.FnvHash64 r) = BA.fnv1a_64Hash+ <$> BA.fill @BA.Bytes (8 + sizeOf x) (BA.putStorable s >> BA.putStorable x)+{-# INLINE fnv1a #-}++-- | Computes a 64 bit Fnv1a hash for a value that is an instance of+-- 'BA.ByteArrayAccess'.+--+-- The first argument is use as a salt.+--+fnv1a_bytes+ :: BA.ByteArrayAccess a+ => Int+ -- ^ Salt+ -> a+ -- ^ Value that is hashes+ -> Word64+fnv1a_bytes s x = r+ where+ Right (BA.FnvHash64 r) = BA.fnv1a_64Hash+ <$> BA.fill @BA.Bytes (8 + BA.length x) (BA.putStorable s >> BA.putBytes x)+{-# INLINE fnv1a_bytes #-}++-- | Computes a Sip hash for a value that has an 'Storable' instance.+--+-- The first argument is a salt value that is used to derive the key for the+-- hash computation.+--+sip+ :: Storable a+ => Int+ -- ^ Salt+ -> a+ -- ^ Value that is hashes+ -> Word64+sip s x = r+ where+ Right (BA.SipHash r) = BA.sipHash (BA.SipKey (int s) 23)+ <$> BA.fill @BA.Bytes (sizeOf x) (BA.putStorable x)+{-# INLINE sip #-}++-- | Computes a Sip hash for a value that is an instance of+-- 'BA.ByteArrayAccess'.+--+-- The first argument is a salt value that is used to derive the key for the+-- hash computation.+--+sip_bytes+ :: BA.ByteArrayAccess a+ => Int+ -- ^ Salt+ -> a+ -- ^ Value that is hashes+ -> Word64+sip_bytes s x = r+ where+ Right (BA.SipHash r) = BA.sipHash (BA.SipKey (int s) 23)+ <$> BA.fill @BA.Bytes (BA.length x) (BA.putBytes x)+{-# INLINE sip_bytes #-}++-- | An version of a Sip hash that is used internally. In order to avoid+-- dependencies between different hash computations, it shouldn't be used in the+-- implementation of instances of 'Data.Cuckoo.CuckooFilterHash'.+--+sip2 :: Storable a => Int -> a -> Word64+sip2 s x = r+ where+ Right (BA.SipHash r) = BA.sipHash (BA.SipKey 61 (int s * 17))+ <$> BA.fill @BA.Bytes (sizeOf x) (BA.putStorable x)+{-# INLINE sip2 #-}++-- | Write a 'Word64' value into a 'Word32' aligned 'MutableByteArray'+--+set+ :: PrimMonad m+ => MutableByteArray (PrimState m)+ -> Int+ -- ^ index in terms of 'Word32'+ -> Word64+ -- ^ 'Word64' value that is written+ -> m ()+set x i c = do+ writeByteArray @Word32 x i (int c)+ writeByteArray @Word32 x (succ i) (int $ c `unsafeShiftR` 32)+{-# INLINE set #-}++-- | Get a 'Word64' from a 'Word32' aligned 'MutableByteArray'.+--+get+ :: PrimMonad m+ => MutableByteArray (PrimState m)+ -- ^ byte array+ -> Int+ -- ^ index in terms of 'Word32'+ -> m Word64+ -- ^ Word64 value that contains the result bits+get x i = do+ a <- readByteArray @Word32 x i+ b <- readByteArray @Word32 x (succ i)++ -- TODO check of for host byte order+ -- Here we assume littel endian+ return $! int a + (int b `unsafeShiftL` 32)+{-# INLINE get #-}+
+ test/Main.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module: Main+-- Copyright: Copyright © 2019 Lars Kuhtz <lakuhtz@gmail.com>+-- License: BSD3+-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>+-- Stability: experimental+--+-- Test functions+--+module Main+( main++-- * Testing+, test0+, test1+, test2+) where++import Control.StopWatch++import qualified Crypto.Hash as C++import Data.Bool+import qualified Data.ByteArray as BA+import qualified Data.ByteArray.Pack as BA hiding (pack)+import qualified Data.ByteString as B+import Data.Either+import Data.Hashable++import Foreign++import Numeric.Natural++import System.IO.Unsafe+import System.Random.Internal++-- internal modules++import Data.Cuckoo+import Data.Cuckoo.Internal++-- -------------------------------------------------------------------------- --+-- Main++main :: IO ()+main = do+ putStrLn "fill with random Int values up to first insert failure"+ stopWatch (test0 @Int n) >>= p "Int"++ putStrLn ""+ putStrLn "fill up to first insert failure"+ stopWatch (test1 @Int n) >>= p "Int (default instance)"+ stopWatch (test1 @Double n) >>= p "Double (default instance)"++ putStrLn ""+ putStrLn "[ByteString] fill up to first insert failure"+ stopWatch (test2 @HashablePkg n) >>= p "Hashable Package"+ stopWatch (test2 @Fnv1aSip n) >>= p "Fnv1a+Sip"+ stopWatch (test2 @Crypto n) >>= p "Blake2b_256"++ putStrLn ""+ putStrLn "[ByteString] fill to 95%"+ stopWatch (test3 @HashablePkg n) >>= p "Hashable Package"+ stopWatch (test3 @Fnv1aSip n) >>= p "Fnv1a+Sip"+ stopWatch (test3 @Crypto n) >>= p "Blake2b_256"+ where+ p l (r, t) = putStrLn $ show t <> " - " <> l <> " - " <> show r+ n = 500000++-- -------------------------------------------------------------------------- --+-- Orphans++instance CuckooFilterHash Int+instance CuckooFilterHash Double++-- -------------------------------------------------------------------------- --+-- Hashable (I think, this uses SIP hash)++newtype HashablePkg = HashablePkg B.ByteString+ deriving (Show, Eq, Ord)+ deriving newtype (BA.ByteArrayAccess, BA.ByteArray, Semigroup, Monoid, Hashable)++instance CuckooFilterHash HashablePkg where+ cuckooHash (Salt s) a = fromIntegral $! hashWithSalt s a+ cuckooFingerprint (Salt s) a = fromIntegral $! hashWithSalt (s + 23) a+ {-# INLINE cuckooHash #-}+ {-# INLINE cuckooFingerprint #-}++-- -------------------------------------------------------------------------- --+-- Fnv1a Hashes++newtype Fnv1aSip = Fnv1aSip B.ByteString+ deriving (Show, Eq, Ord)+ deriving newtype (BA.ByteArrayAccess, BA.ByteArray, Semigroup, Monoid)++instance CuckooFilterHash Fnv1aSip where+ cuckooHash (Salt s) a = fnv1a_bytes s a+ cuckooFingerprint (Salt s) a = sip_bytes s a+ {-# INLINE cuckooHash #-}+ {-# INLINE cuckooFingerprint #-}++-- -------------------------------------------------------------------------- --+-- ByteStrings with cryptographic cuckoo filter hash functions++newtype Crypto = Crypto B.ByteString+ deriving (Show, Eq, Ord)+ deriving newtype (BA.ByteArrayAccess, BA.ByteArray, Semigroup, Monoid)++instance CuckooFilterHash Crypto where+ -- cuckooHash _ a = unsafePerformIO $ BA.withByteArray (C.hash @_ @C.Blake2b_256 a) $ peek+ cuckooHash (Salt s) a = unsafePerformIO $ flip BA.withByteArray peek+ $ C.hash @BA.Bytes @C.Blake2b_256+ $ fromRight (error "must not happen")+ $ BA.fill (BA.length a + 8) (BA.putStorable s >> BA.putBytes a)+ cuckooFingerprint s a = int $ cuckooHash (s + 23) a+ {-# INLINE cuckooHash #-}+ {-# INLINE cuckooFingerprint #-}++-- -------------------------------------------------------------------------- --+-- Test++-- | Fill with random items until first insert failure+--+test0 :: forall a . Variate a => CuckooFilterHash a => Natural -> IO TestResult+test0 n = do+ rng <- initialize 0+ s <- Salt <$> uniform rng+ f <- newCuckooFilter @IO @4 @10 @a s n+ let go i fp = do+ x <- uniform rng+ fp' <- bool fp (succ fp) <$> member f x+ insert f x >>= \case+ True -> go (succ i) fp'+ False -> return (i, fp')+ (a, b) <- go 0 0+ c <- itemCount f+ return $! TestResult a 1 b c+ (int b / int a * 100)+ (int c / int (capacityInItems f) * 100)++-- | Fill up to first insert failure+--+test1 :: forall a . CuckooFilterHash a => Num a => Natural -> IO TestResult+test1 n = do+ rng <- initialize 0+ s <- Salt <$> uniform rng+ f <- newCuckooFilter @IO @4 @10 @a s n+ let go i fp = do+ let x = int i+ fp' <- bool fp (succ fp) <$> member f x+ insert f x >>= \case+ True -> go (succ i) fp'+ False -> return (i, fp')+ (a, b) <- go 0 0+ c <- itemCount f+ return $! TestResult a 1 b c+ (int b / int a * 100)+ (int c / int (capacityInItems f) * 100)++-- | Fill up to first insert failure+--+test2 :: forall a . CuckooFilterHash a => BA.ByteArray a => Natural -> IO TestResult+test2 n = do+ rng <- initialize 0+ s <- Salt <$> uniform rng+ f <- newCuckooFilter @IO @4 @10 @a s n+ let go i fp = do+ let x = BA.pack (castEnum <$> show i)+ fp' <- bool fp (succ fp) <$> member f x+ insert f x >>= \case+ True -> go (succ i) fp'+ False -> return (i, fp')+ (a, b) <- go 0 0+ c <- itemCount f+ return $! TestResult a 1 b c+ (int b / int a * 100)+ (int c / int (capacityInItems f) * 100)++-- | Fill 90% of the filter+--+test3 :: forall a . CuckooFilterHash a => BA.ByteArray a => Natural -> IO TestResult+test3 n = do+ rng <- initialize 0+ s <- Salt <$> uniform rng+ f <- newCuckooFilter @IO @4 @10 @a s n+ let go i x fp+ | int i >= int @_ @Double n * 95 / 100 = return (i, x, fp)+ go i x fp = do+ let bytes = BA.pack (castEnum <$> show i)+ fp' <- bool fp (succ fp) <$> member f bytes++ -- unless (fp == fp') $ do+ -- print $ itemHashes f bytes++ insert f bytes >>= \case+ True -> go (succ i) x fp'+ False -> go (succ i) (succ x) fp'+ (i, x, b) <- go 0 0 0+ c <- itemCount f+ return $! TestResult i x b c+ (int b / int i * 100)+ (int c / int (capacityInItems f) * 100)++data TestResult = TestResult+ { _testInsertCount :: !Int+ , _testInsertFailures :: !Int+ , _testFalsePositiveCount :: !Int+ , _testItemCount :: !Int+ , _testFalsePositiveRate :: !Double+ , _testLoadFactor :: !Double+ }+ deriving (Show, Eq, Ord)++castEnum :: Enum a => Enum b => a -> b+castEnum = toEnum . fromEnum+{-# INLINE castEnum #-}