{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveAnyClass #-}
module Data.CuckooFilter
(
Size,
makeSize,
Filter,
empty,
insert,
member,
delete
) where
import Data.Hashable (Hashable)
import qualified Data.IntMap.Strict as IM
import Data.Maybe (fromMaybe)
import Data.CuckooFilter.Internal
insert :: (Hashable a) =>
Filter a
-> a
-> 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}
Nothing -> let
idxB = secondaryIndex fp numBuckets idxA
in bumpHash maxNumKicks cfilt idxB fp
where
(Size s) = size cfilt
maxNumKicks = floor $ 0.1 * fromIntegral s
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
isBucketMinimum _ bkt = let
a = getCell bkt 0
b = getCell bkt 1
c = getCell bkt 2
d = getCell bkt 3
m = min a . min b $ min c d
in (a == m, b == m, c == m, d == m)
member :: (Hashable a) =>
a
-> Filter a
-> Bool
member a cFilter =
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
bA = fromMaybe emptyBucket $ toIndex bktCount idxA `IM.lookup` bkts
bB = fromMaybe emptyBucket $ toIndex bktCount idxB `IM.lookup` bkts
inBucket fp bucket =
fp == getCell bucket 0 ||
fp == getCell bucket 1 ||
fp == getCell bucket 2 ||
fp == getCell bucket 3
delete :: (Hashable a) =>
Filter 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}
where
fp = makeFingerprint a
idxA = primaryIndex a numBuckets
idxB = secondaryIndex fp numBuckets idxA
matchesFP _ bucket = (fp == getCell bucket 0,
fp == getCell bucket 1,
fp == getCell bucket 2,
fp == getCell bucket 3)
removeFromBucket bucket = let
(_, bucket') = replaceInBucket (FP 0) matchesFP bucket
in (bucket /= bucket', bucket')