cuckoo-filter 0.1.0.2 → 0.2.0.1

raw patch · 11 files changed

+363/−115 lines, 11 filesdep +arraydep +bytestringdep +timePVP ok

version bump matches the API change (PVP)

Dependencies added: array, bytestring, time

API changes (from Hackage documentation)

Files

• README.md +41/−4
• benchmarks/Benchmarks.hs +6/−1
• benchmarks/Benchmarks/Simple.hs +34/−6
• benchmarks/Benchmarks/SpellChecker.hs +32/−0
• cuckoo-filter.cabal +18/−5
• src/Data/CuckooFilter.hs +59/−58
• src/Data/CuckooFilter/Internal.hs +22/−25
• src/Data/CuckooFilter/Mutable.hs +61/−0
• src/Data/CuckooFilter/Pure.hs +61/−0
• src/Data/CuckooFilter/Tutorial.hs +2/−0
• test/Spec.hs +27/−16

@@ -1,6 +1,6 @@ # cuckoo-filter -[![Hackage](https://img.shields.io/badge/Hackage-0.1.0.1-blue.svg)](https://hackage.haskell.org/package/cuckoo-filter)[![Build Status](https://travis-ci.org/ChrisCoffey/cuckoo-filter.svg?branch=master)](https://travis-ci.org/ChrisCoffey/cuckoo-filter)+[![Hackage](https://img.shields.io/badge/Hackage-0.2.0.0-blue.svg)](https://hackage.haskell.org/package/cuckoo-filter)[![Build Status](https://travis-ci.org/ChrisCoffey/cuckoo-filter.svg?branch=master)](https://travis-ci.org/ChrisCoffey/cuckoo-filter)  Cuckoo filters are a probabilistic data structure used to answer questions like "Have I already seen this user" or "Is this word in the English language?". They're _probabilistic_ because each membership operation has a false positive probability. It guarnatees that there will never be a false negative, but may have a low chance of false positives. @@ -22,6 +22,43 @@  The current implementation avoids pre-allocating memory for the filter, so the heap usage will incrase linearly with `insert` calls. This obviously helps keep heap usage low for sparse filters, but also means inserts are slower than they would be in a mutable implementation. -### TODO-- [ ] Benchmark against a Bloom filter implementation-- [ ] Introduce a mutable version of `Filter` and a typeclass for the storage interactions++#### Loading a SpellChecker test+The following test was run on a laptop, so the absolute numbers are going to vary a ton. The important thing is the relationship between the pure & immutable filter implementations.++The test consists of:+1. Load the `/usr/share/dict/words` file into memory+2. Create a filter containing all of the words+3. Lookup each word in the filter+++Pure+```+500000 cells+235886 words+0.078749ss to count words+0.933969ss to construct filter+745 insert failures+0.80465ss to query every element+```++Mutable+```+500000 cells+235886 words+0.082926ss to count words+0.29735ss to construct filter+582 insert failures+0.52605ss to query every element+```++Incredibly unscientific comparison to `bloom-filter` using a vanilla filter+```+235886 words+0.087499ss to count words+Bloom { 4194304 bits }+0.464982ss to construct filter+0.506902ss to query every element+```++*** Cuckoo Filters report the number of failures, while the Bloom Filter reports how many bits it contains. I'll start capturing size for the mutable Cuckoo Filter soon.

@@ -1,10 +1,15 @@ import Benchmarks.Simple+import Benchmarks.SpellChecker  import Criterion.Main -+-- main = stdInMutableBenchmark+-- main = stdInBenchmark+main = runSpellCheck+{- main = defaultMain [     tenPctPacked,     fiftyPctPacked,     ninetyPctPacked     ]+-}

@@ -1,5 +1,6 @@ module Benchmarks.Simple (     stdInBenchmark,+    stdInMutableBenchmark,     tenPctPacked,     fiftyPctPacked,     ninetyPctPacked@@ -8,6 +9,7 @@ import Criterion import Control.Monad (foldM) import Data.CuckooFilter+import Data.Functor.Identity (runIdentity) import Data.Ratio (Ratio) import Numeric.Natural (Natural) import System.Environment@@ -16,12 +18,31 @@ stdInBenchmark :: IO () stdInBenchmark = do     [n, m] <- fmap read <$> getArgs-    let (Just s) = makeSize n-        filt = empty s+    let (Just s) = makeSize (fromIntegral n)+        filt  = runIdentity $ initialize s :: Filter Int     print s-    filt' <- pure $ foldM (\ f a -> f `insert` a) filt [1..m]-    print $ member 1 <$> filt'+    filt' <- pure $ foldM (\ f a -> f `insertIdent` a) filt [1..m]+    print $ (runIdentity . member 1) <$> filt' +stdInMutableBenchmark :: IO ()+stdInMutableBenchmark = do+    [n, m] <- fmap read <$> getArgs+    let (Just s) = makeSize (fromIntegral n)+    filt <- initialize s :: IO (MFilter Int)+    print s+    filt' <- foldMaybeM (\f a -> f `insert` a) filt [1..m]+    case filt' of+        Nothing -> print "Collision occurred. Exiting."+        Just res -> print =<< member 1 res+    where+        foldMaybeM :: (Monad m) => (b -> a -> m (Maybe b)) -> b -> [a] -> m (Maybe b)+        foldMaybeM f seed [] = pure (Just seed)+        foldMaybeM f seed (x:xs) = do+            res <- f seed x+            case res of+                Just seed' -> foldMaybeM f seed' xs+                Nothing -> pure Nothing+ tenPctPacked :: Benchmark tenPctPacked = bgroup "10% packed" [     bench "Store 100k, 1% dupes" $ whnf (doTest oneMM (LF 10)) (D 1),@@ -64,8 +85,9 @@     -> LoadFactor     -> DupePct     -> Maybe (Filter Int)-doTest size (LF lf) (D d) =-    foldM insert (empty s) vals+doTest size (LF lf) (D d) = do+    filt <- initialize s+    foldM insertIdent filt vals     where         valCount :: Int         valCount = floor $ (fromIntegral size) * (realToFrac lf / 100.0)@@ -76,3 +98,9 @@                 else []         vals = dupes <> [1..(valCount - dupeCount)]         Just s = makeSize size++insertIdent ::+    Filter Int+    -> Int+    -> Maybe (Filter Int)+insertIdent filt n = runIdentity $ insert filt n

@@ -0,0 +1,32 @@+-- This code is mostly borrowed directly from Bryan O'Sullivan's bloom filter library. It is used+-- as a parity check between the two libraries.+module Benchmarks.SpellChecker (runSpellCheck ) where++import Control.Monad (mapM_, filterM, foldM)+import qualified Data.CuckooFilter as CF+import qualified Data.ByteString.Lazy.Char8 as B+import Data.Time.Clock (diffUTCTime, getCurrentTime)++runSpellCheck = do+    let dict = "/usr/share/dict/words"+    a <- getCurrentTime+    words <- B.lines `fmap` B.readFile dict+    putStrLn $ {-# SCC "words/length" #-} show (length words) ++ " words"+    b <- getCurrentTime+    putStrLn $ show (diffUTCTime b a) ++ "s to count words"+    let Just s = CF.makeSize 500000+    filt <- {-# SCC "construct" #-} CF.initialize s :: IO (CF.MFilter B.ByteString)+    Just filt' <- foldM ins (Just filt) words+    c <- getCurrentTime+    putStrLn $ show (diffUTCTime c b) ++ "s to construct filter"+    missing <- filterM (fmap not . (`CF.member` filt')) words+    {-# SCC "query" #-} print $ length missing+    d <- getCurrentTime+    putStrLn $ show (diffUTCTime d c) ++ "s to query every element"++    where+        ins filt@(Just f) a = do+            res <- CF.insert f a+            case res of+                Just f' -> pure res+                Nothing -> pure filt

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 4040eaba0a3590ddfb6c21fc0839acb35c8190b3e8f5a837796de44ca9f6facb+-- hash: 10e4a9c36733e569b2f34e1705f635a2195378da353585ba96b142feb54122e3  name:           cuckoo-filter-version:        0.1.0.2+version:        0.2.0.1 synopsis:       Pure and impure Cuckoo Filter description:    Please see the README on Github at <https://github.com/ChrisCoffey/cuckoo-filter#readme> category:       Data@@ -31,36 +31,46 @@   exposed-modules:       Data.CuckooFilter       Data.CuckooFilter.Internal+      Data.CuckooFilter.Mutable+      Data.CuckooFilter.Pure+      Data.CuckooFilter.Tutorial   other-modules:       Paths_cuckoo_filter   hs-source-dirs:       src-  default-extensions: NamedFieldPuns DerivingStrategies ScopedTypeVariables DeriveGeneric+  default-extensions: NamedFieldPuns DerivingStrategies ScopedTypeVariables DeriveGeneric MultiParamTypeClasses FunctionalDependencies FlexibleContexts FlexibleInstances   ghc-options: -O2   build-depends:       aeson+    , array     , base >=4.7 && <5+    , bytestring     , cereal     , containers     , hashable+    , time   default-language: Haskell2010  executable benchmarks   main-is: Benchmarks.hs   other-modules:-      Benchmarks.Simple+      Benchmarks.Simple, Benchmarks.SpellChecker   hs-source-dirs:       benchmarks+  default-extensions: NamedFieldPuns DerivingStrategies ScopedTypeVariables DeriveGeneric MultiParamTypeClasses FunctionalDependencies FlexibleContexts FlexibleInstances   ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2   build-depends:       aeson+    , array     , base >=4.7 && <5+    , bytestring     , cereal     , containers     , criterion     , cuckoo-filter     , hashable     , random+    , time   default-language: Haskell2010  test-suite cuckoo-filter-test@@ -70,12 +80,14 @@       Paths_cuckoo_filter   hs-source-dirs:       test-  default-extensions: NamedFieldPuns DerivingStrategies ScopedTypeVariables DeriveGeneric+  default-extensions: NamedFieldPuns DerivingStrategies ScopedTypeVariables DeriveGeneric MultiParamTypeClasses FunctionalDependencies FlexibleContexts FlexibleInstances   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:       QuickCheck     , aeson+    , array     , base >=4.7 && <5+    , bytestring     , cereal     , containers     , cuckoo-filter@@ -83,4 +95,5 @@     , tasty     , tasty-hunit     , tasty-quickcheck+    , time   default-language: Haskell2010

@@ -1,6 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DeriveAnyClass #-}- {-| Module      : Data.CuckooFilter Copyright   : (c) Chris Coffey, 2018@@ -28,7 +25,8 @@     Size,     makeSize,     Filter,-    empty,+    MFilter,+    initialize,      -- * Working with a Cuckoo Filter     insert,@@ -37,10 +35,11 @@     ) where  import Data.Hashable (Hashable)-import qualified Data.IntMap.Strict as IM import Data.Maybe (fromMaybe)  import Data.CuckooFilter.Internal+import Data.CuckooFilter.Pure+import Data.CuckooFilter.Mutable   -- | In exchange for the stable false-positive probability, insertion into a cuckoo filter@@ -52,37 +51,38 @@ -- that hash to the same fingerprint and share either IndexA or IndexB with probability /(2/numBuckets * 1/256)^ (|s|-1)/. -- Alternatively, inserting the same item /2b+1/ times will trigger the failure as well. ---insert :: (Hashable a) =>-    Filter a -- ^ Current filter state+insert :: (Hashable a, Monad m, CuckooFilter filt m) =>+    filt a -- ^ Current filter state     -> a -- ^ Item to hash and store in the filter-    -> Maybe (Filter a)-insert cfilt@(F {numBuckets}) val = let-    idxA = primaryIndex val numBuckets-    fp = makeFingerprint val-    bkts = buckets cfilt-    bucketA = fromMaybe emptyBucket $ toIndex numBuckets idxA `IM.lookup` bkts-    in case insertBucket fp bucketA of-        Just bucketA' -> Just $ cfilt {buckets = IM.insert (toIndex numBuckets idxA) bucketA' bkts}+    -> m (Maybe (filt a))+insert cfilt val = do+    numBuckets <- bucketCount cfilt+    let idxA = primaryIndex val numBuckets+        fp = makeFingerprint val+    bucketA <- readBucket (toIndex numBuckets idxA) cfilt+    case insertBucket fp bucketA of+        Just bucketA' ->+            Just <$> writeBucket (toIndex numBuckets idxA) bucketA' cfilt         Nothing -> let             idxB = secondaryIndex fp numBuckets idxA-            in bumpHash maxNumKicks cfilt idxB fp+            in bumpHash numBuckets maxNumKicks cfilt idxB fp     where-        (Size s) = size cfilt-        maxNumKicks = floor $ 0.1 * fromIntegral s+        maxNumKicks = 1200          -- The details of this algorithm can be found in https://www.cs.cmu.edu/~dga/papers/cuckoo-conext2014.pdf-        -- If the kick count is exhausted, the insert fails-        bumpHash 0 _ _ _ = Nothing-        bumpHash remaingKicks cfilt' idxB fp = let-            bkts = buckets cfilt'-            bucketB = fromMaybe emptyBucket $ toIndex numBuckets idxB `IM.lookup` bkts-            in case insertBucket fp bucketB of-                Just bb' -> Just $ cfilt' {buckets = IM.insert (toIndex numBuckets idxB) bb' bkts }-                Nothing -> let-                    (bumpedFP, bucketB') = replaceInBucket fp isBucketMinimum bucketB-                    nextStepFilter = cfilt' {buckets = IM.insert (toIndex numBuckets idxB) bucketB' bkts }-                    kickedIndex = kickedSecondaryIndex bumpedFP numBuckets idxB-                    in bumpHash (remaingKicks - 1) nextStepFilter kickedIndex bumpedFP+        -- If the kick count is exhausted, the insert fails. Otherwise, it will loop until it finds an open cell,+        -- insert the value, then return the filter+        bumpHash numBuckets 0 _ _ _ = pure Nothing+        bumpHash numBuckets remaingKicks cfilt' idxB fp = do+            bucketB <- readBucket (toIndex numBuckets idxB) cfilt'+            case insertBucket fp bucketB of+                Just bb' ->+                    Just <$> writeBucket (toIndex numBuckets idxB) bb' cfilt+                Nothing -> do+                    let (bumpedFP, bucketB') = replaceInBucket fp isBucketMinimum bucketB+                        kickedIndex = kickedSecondaryIndex bumpedFP numBuckets idxB+                    nextStepFilter <- writeBucket (toIndex numBuckets idxB) bucketB' cfilt'+                    bumpHash numBuckets (remaingKicks - 1) nextStepFilter kickedIndex bumpedFP          isBucketMinimum _ bkt = let             a = getCell bkt 0@@ -95,23 +95,20 @@ -- | Checks whether a given item is within the filter. -- -- /O(1)/-member :: (Hashable a) =>+member :: (Hashable a, Monad m, CuckooFilter filt m) =>     a -- ^ Check if this element is in the filter-    -> Filter a -- ^ The filter-    -> Bool-member a cFilter =-    inBucket fp bA || inBucket fp bB+    -> filt a -- ^ The filter+    -> m Bool+member a cFilter = do+    numBuckets <- bucketCount cFilter+    let idxA = primaryIndex a numBuckets+        idxB = secondaryIndex fp numBuckets idxA+    bA <- readBucket ( toIndex numBuckets idxA ) cFilter+    bB <- readBucket ( toIndex numBuckets idxB ) cFilter+    pure $ inBucket fp bA || inBucket fp bB     where-        bktCount = numBuckets cFilter         fp = makeFingerprint a-        idxA = primaryIndex a bktCount-        idxB = secondaryIndex fp bktCount idxA-        bkts = buckets cFilter -        -- TODO Try to make this typesafe-        bA = fromMaybe emptyBucket $ toIndex bktCount idxA `IM.lookup` bkts-        bB = fromMaybe emptyBucket $ toIndex bktCount idxB `IM.lookup` bkts-         -- fp `elem` [a,b,c,d] is simpler, but it allocates an additional list unnecessarily         inBucket fp bucket =             fp == getCell bucket 0 ||@@ -127,24 +124,28 @@ -- Deleting an element not in the Cuckoo Filter is a noop and returns the filter unchanged. -- -- /O(1)/-delete :: (Hashable a) =>-    Filter a+delete :: (Hashable a, Monad m, CuckooFilter filt m) =>+    filt a     -> a-    -> Filter a-delete cFilt@(F {numBuckets, buckets}) a-    | not $ member a cFilt = cFilt-    | otherwise = let-        bucketA = fromMaybe emptyBucket $ toIndex numBuckets idxA `IM.lookup` buckets-        bucketB = fromMaybe emptyBucket $ toIndex numBuckets idxB `IM.lookup` buckets-        (removedFromA, bucketA') = removeFromBucket bucketA-        (_, bucketB') = removeFromBucket bucketB-        in if removedFromA-           then cFilt {buckets = IM.insert (toIndex numBuckets idxA) bucketA' buckets}-           else cFilt {buckets = IM.insert (toIndex numBuckets idxB) bucketB' buckets}+    -> m (filt a)+delete cFilt a = do+    isMember <- member a cFilt+    if isMember+    then do+        numBuckets <- bucketCount cFilt+        let idxA = primaryIndex a numBuckets+            idxB = secondaryIndex fp numBuckets idxA+        bucketA <- readBucket ( toIndex numBuckets idxA ) cFilt+        bucketB <- readBucket ( toIndex numBuckets idxB ) cFilt+        let (removedFromA, bucketA') = removeFromBucket bucketA+            (_, bucketB') = removeFromBucket bucketB+        if removedFromA+        then writeBucket (toIndex numBuckets idxA) bucketA' cFilt+        else writeBucket (toIndex numBuckets idxB) bucketB' cFilt+    else pure cFilt+     where         fp = makeFingerprint a-        idxA = primaryIndex a numBuckets-        idxB = secondaryIndex fp numBuckets idxA         -- TODO just use Control.Arrow         matchesFP _ bucket = (fp == getCell bucket 0,                               fp == getCell bucket 1,

@@ -17,8 +17,7 @@     -- * Constructing a Cuckoo Filter     Size(..),     makeSize,-    Filter(..),-    empty,+    CuckooFilter(..),      -- * Fingerprints     FingerPrint(..),@@ -52,6 +51,21 @@ import GHC.Generics (Generic) import Numeric.Natural (Natural) +-- | A low-level interface for working with cuckoo filter storage.+class Monad m => CuckooFilter filt m where+    -- | Create a new cuckoo filter of the specified size+    initialize :: Size -> m (filt a)++    -- | Return the number of buckets contained in the filter. This is distinct from the total size of the filter (size /4)+    bucketCount :: filt a -> m Natural++    -- | Write the new contents of a bucket to the storage+    writeBucket :: Int -> Bucket -> filt a -> m (filt a)++    -- | Read the contents of a bucket from the storage+    readBucket :: Int -> filt a -> m Bucket++ -- | A non-zero natural number. Generally this is a power of two, although there's no hard requirement -- for that given the current implementation. newtype Size = Size Natural@@ -103,6 +117,7 @@     Bucket     -> Natural -- Really just 0-3. Is it worth creating a custom datatype for this?     -> FingerPrint+{-# INLINE getCell #-} getCell (B bucket) cellNumber =     FP . fromIntegral $ (bucket .&. mask) `shiftR` offset     where@@ -114,6 +129,7 @@     -> Natural     -> FingerPrint     -> Bucket+{-# INLINE setCell #-} setCell (B bucket) cellNumber (FP fp) =     B $ zeroed .|. mask     where@@ -122,30 +138,7 @@         zeroMask = (255 :: Word32) `shiftL` offset         mask = (fromIntegral fp :: Word32) `shiftL` offset --- | A Cuckoo Filter with a fixed size. The current implementation uses 8 bit fingerprints--- and 4 element buckets.-data Filter a = F {-    buckets :: IM.IntMap Bucket, -- size / 4.-    numBuckets :: !Natural, -- Track the number of buckets to avoid a length lookup-    size :: !Size -- The number of buckets-    }-    deriving (Show, Eq, Generic, Serialize, ToJSON, FromJSON) --- | Creates a new & empty 'Filter' of size s-empty ::-    Size -- ^ The initial size of the filter-    -> Filter a-empty (Size s) = F {-    -- By using an empty map, we're able to avoid allocating any memory for elements that aren't stored.-    -- If the filter is packed densely the additional memory for the IntMap hurts quite a bit, but at load-    -- factors-    buckets = IM.empty,-    numBuckets = numBuckets,-    size = Size s-    }-    where-        numBuckets = s `div` 4- -- -- Working with Buckets --@@ -190,6 +183,7 @@ makeFingerprint :: Hashable a =>     a     -> FingerPrint+{-# INLINE makeFingerprint #-} makeFingerprint a = FP . max 1 $  fromIntegral (abs $ hash a) `mod` 255  -- | (hash a) % numBuckets@@ -197,6 +191,7 @@     a     -> Natural     -> IndexA+{-# INLINE primaryIndex #-} primaryIndex a numBuckets =     IA . fromIntegral $ hash a @@ -206,6 +201,7 @@     -> Natural     -> IndexA     -> IndexB+{-# INLINE secondaryIndex #-} secondaryIndex fp numBuckets (IA primary) =     IB (primary `xor` fpHash)     where@@ -216,5 +212,6 @@     -> Natural     -> IndexB     -> IndexB+{-# INLINE kickedSecondaryIndex #-} kickedSecondaryIndex fp numBuckets (IB alt) =     secondaryIndex fp numBuckets (IA alt)

@@ -0,0 +1,61 @@+{-|+Module      : Data.CuckooFilter.Mutable+Copyright   : (c) Chris Coffey, 2018+License     : MIT+Maintainer  : chris@foldl.io+Stability   : experimental++An unboxed, mutable array implementation of the cuckoo filter. This is quite space efficient,+using only x% of the memory the pure IntMap implementation uses. Prefer this if you need memory+or cpu performance.+-}++module Data.CuckooFilter.Mutable (+    MFilter+    ) where++import Data.CuckooFilter.Internal (CuckooFilter(..), Bucket(..), Size(..), emptyBucket)++import Control.Monad.ST (stToIO)+import Data.Aeson (ToJSON, FromJSON)+import qualified Data.Array.IO as IOA+import qualified Data.Array.MArray as A+import Data.Serialize (Serialize)+import Data.Word (Word32, Word8)+import GHC.Generics (Generic)+import Numeric.Natural (Natural)++-- Write it in IO first+-- Given a mutable array, can I actually fix a C array & use that?++data MFilter a = MF {+    buckets :: IOA.IOUArray Int Word32,+    size :: !Size,+    numBuckets :: !Natural+    }+    deriving (Eq)++instance CuckooFilter MFilter IO where+    initialize (Size s) = do+        rawArray <- A.newArray (0::Int, fromIntegral nb) 0+        pure MF {+            buckets = rawArray,+            size = Size s,+            numBuckets = nb+            }+        where+            nb = s `div` 4++    {-# INLINE bucketCount #-}+    bucketCount MF { numBuckets } = pure numBuckets++    {-# INLINE writeBucket #-}+    writeBucket index (B val) filt = do+        A.writeArray (buckets filt) index val+        pure filt++    {-# INLINE readBucket #-}+    readBucket index filt =+        B <$> A.readArray (buckets filt)index++

@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveAnyClass #-}++{-|+Module      : Data.CuckooFilter.Pure+Copyright   : (c) Chris Coffey, 2018+License     : MIT+Maintainer  : chris@foldl.io+Stability   : experimental++A strict IntMap-based implementation of a cuckoo filter. This is still quite efficient in terms of+throughput, but the IntMap's internal structures baloon the memory usage, making it far less+practical for real usecases.+-}++module Data.CuckooFilter.Pure (+    Filter(..)+) where++import Data.CuckooFilter.Internal (Bucket, emptyBucket, Size(..), CuckooFilter(..))++import Data.Aeson (ToJSON, FromJSON)+import qualified Data.IntMap.Strict as IM+import Data.Maybe (fromMaybe)+import Data.Serialize (Serialize)+import Data.Word (Word32, Word8)+import GHC.Generics (Generic)+import Numeric.Natural (Natural)++-- | A Cuckoo Filter with a fixed size. The current implementation uses 8 bit fingerprints+-- and 4 element buckets.+data Filter a = F {+    buckets :: IM.IntMap Bucket, -- size / 4.+    numBuckets :: !Natural, -- Track the number of buckets to avoid a length lookup+    size :: !Size -- The number of buckets+    }+    deriving (Show, Eq, Generic, Serialize, ToJSON, FromJSON)++instance Monad m => CuckooFilter Filter m where+    initialize (Size s) = pure $+        -- By using an empty map, we're able to avoid allocating any memory for elements that aren't stored.+        -- If the filter is packed densely the additional memory for the IntMap hurts quite a bit, but at load+        -- factors+        F {+            buckets = IM.empty,+            numBuckets = numBuckets,+            size = Size s+            }+        where+            numBuckets = s `div` 4++    {-# INLINE bucketCount #-}+    bucketCount F {numBuckets} = pure numBuckets++    {-# INLINE writeBucket #-}+    writeBucket index bucket filt@(F {buckets} )= pure $+        filt {buckets = IM.insert index bucket buckets}++    {-# INLINE readBucket #-}+    readBucket index F {buckets} = pure . fromMaybe emptyBucket $ IM.lookup index buckets++

@@ -0,0 +1,2 @@+module Data.CuckooFilter.Tutorial where+

@@ -4,6 +4,7 @@ import Test.QuickCheck  import Control.Monad (foldM, replicateM)+import Data.Functor.Identity (runIdentity) import Data.Hashable (Hashable) import Data.Maybe (isJust, isNothing) import Data.Word@@ -18,10 +19,10 @@ tests :: TestTree tests = testGroup "Data.CuckooFilter" [     -- testProperty "insert x increases load factor" undefined,-    testProperty "insert x >> delete x is idempotent" $ \s -> let-        Just f = insert defaultFilter s-        f' = delete f s-        in not (member s f')+    testProperty "insert x >> delete x is idempotent" $ \s -> runIdentity $ do+        Just f <- insert defaultFilter s+        f' <- delete f s+        not <$> member s f'      ,testProperty "inserts into a full filter will fail" $ \s n -> let         f = insertNTimes (100000 + abs n) s defaultFilter@@ -29,10 +30,11 @@      ,testCase "delete x on empty == empty" $ let         (Just s) = makeSize 10-        in delete (empty s) "Foobar" @=? empty s+        filt = runIdentity $ initialize s :: Filter String+        in runIdentity (delete filt "Foobar") @=? filt      ,testProperty "Looking up a non existent value is False" $ \s ->-        not (member s defaultFilter)+        not (runIdentity $ member s defaultFilter)      -- the bucket size is hardcoded to 4 based on the recommendations from the paper, hence 8 below     ,testCase "More than 2b deletes is a noop" $ do@@ -40,15 +42,15 @@             g = deleteNTimes 7 "Foobar" f'             h = deleteNTimes 8 "Foobar" f'             i = deleteNTimes 90 "Foobar" f'-        member "Foobar" f' @=? True-        member "Foobar" g @=? True-        member "Foobar" h @=? False-        member "Foobar" i @=? False+        memberIdent "Foobar" f' @=? True+        memberIdent "Foobar" g @=? True+        memberIdent "Foobar" h @=? False+        memberIdent "Foobar" i @=? False      --     ,testProperty "insert x >> member x == True" $ \ s -> let-        Just f = insert defaultFilter s-        in member s f+        Just f = runIdentity $ insert defaultFilter s+        in runIdentity $ member s f      , indexTests     , bucketTests@@ -87,7 +89,7 @@ --  defaultFilter :: Filter String-defaultFilter = empty s+defaultFilter = runIdentity $ initialize s     where         (Just s) = makeSize 100000 @@ -96,8 +98,9 @@     -> a     -> Filter a     -> Maybe (Filter a)-insertNTimes n a filt =-    foldM (const . (`insert` a )) filt [1..n]+insertNTimes n a filt = let+    insertIdent x f = runIdentity $ insert f a+    in foldM (const . insertIdent a) filt [1..n]   deleteNTimes :: Hashable a =>@@ -105,7 +108,15 @@     -> a     -> Filter a     -> Filter a-deleteNTimes n a filt = foldl (const . (`delete` a )) filt [1..n]+deleteNTimes n a filt = let+    deleteIdent x f = runIdentity $ delete f x+    in foldl (const . deleteIdent a) filt [1..n]++memberIdent :: Hashable a =>+    a+    -> Filter a+    -> Bool+memberIdent a filt = runIdentity $ member a filt  -- -- Instances