packages feed

perfect-hash-generator 0.1.0.4 → 0.2.0.0

raw patch · 10 files changed

+248/−208 lines, 10 filesdep +binarydep +bytestringdep +text

Dependencies added: binary, bytestring, text

Files

− demo-ints/Main.hs 
@@ -1,71 +0,0 @@-module Main where--import           System.Random                 (RandomGen, mkStdGen, randomR)--import           Data.IntSet                   (IntSet)-import qualified Data.IntSet                   as IntSet-import qualified Data.PerfectHash.Construction as Construction-import qualified Data.PerfectHash.Hashing      as Hashing-import qualified Data.PerfectHash.Lookup       as Lookup-import qualified Data.Vector.Unboxed           as Vector-import           Exercise                      (Atom (Atom))-import qualified Exercise---valueCount = 500000--randomRange = (0, Hashing.mask32bits)---data RandIntAccum t = RandIntAccum-  t -- ^ random number generator-  Int -- ^ max count-  IntSet -- ^ accumulated unique random numbers----- | Since computing the size of the set is O(N), we--- maintain the count separately.-getUniqueRandomIntegers :: RandomGen t => RandIntAccum t -> IntSet-getUniqueRandomIntegers (RandIntAccum std_gen count current_set) =--  if count == 0-    then current_set-    else getUniqueRandomIntegers newstate--  where-    (next_int, next_std_gen) = randomR randomRange std_gen--    a = RandIntAccum next_std_gen-    newstate = if IntSet.member next_int current_set-      then a count current_set-      else a (count - 1) (IntSet.insert next_int current_set)---intMapTuples :: [(Atom Int, Int)]-intMapTuples = zip (map Atom random_ints) [1..]-  where-    seed_value = RandIntAccum (mkStdGen 0) valueCount IntSet.empty-    random_ints = IntSet.toList $ getUniqueRandomIntegers seed_value---main = do--  putStrLn $ unwords ["Keys size:", show $ length intMapTuples]--  let lookup_table = Construction.createMinimalPerfectHash intMapTuples--  putStrLn $ unwords [-      "Finished computing lookup table with"-    , show $ Lookup.size lookup_table-    , "entries."-    ]--  let direct_mapping_nonces = Vector.filter (< 0) $ Lookup.nonces lookup_table--  putStrLn $ unwords [-      "There were"-    , show $ Vector.length direct_mapping_nonces-    , "lookup entries with direct mappings."-    ]--  Exercise.eitherExit $ Exercise.testLookups lookup_table intMapTuples
− demo-strings/Main.hs 
@@ -1,33 +0,0 @@-module Main where--import           Control.Monad                 (when)--import qualified Data.PerfectHash.Construction as Construction-import qualified Data.PerfectHash.Lookup       as Lookup-import qualified Exercise---enableDebug = False--dictionaryPath = "/usr/share/dict/words"---main = do--  word_index_tuples <- Exercise.wordsFromFile dictionaryPath--  putStrLn $ unwords ["Words size:", show $ length word_index_tuples]--  let lookup_table = Construction.createMinimalPerfectHash word_index_tuples--  putStrLn $ unwords [-      "Finished computing lookup table with"-    , show $ Lookup.size lookup_table-    , "entries."-    ]--  when enableDebug $ do-    putStrLn $ unwords ["Vector G:", show $ Lookup.nonces lookup_table]-    putStrLn $ unwords ["Vector V:", show $ Lookup.values lookup_table]--  Exercise.eitherExit $ Exercise.testLookups lookup_table word_index_tuples
+ demo/Ints/Main.hs view
@@ -0,0 +1,66 @@+module Main where++import           System.Random                 (RandomGen, mkStdGen, random)++import           Data.IntSet                   (IntSet)+import qualified Data.IntSet                   as IntSet+import qualified Data.PerfectHash.Construction as Construction+import qualified Data.PerfectHash.Lookup       as Lookup+import qualified Data.Vector.Unboxed           as Vector+import qualified Exercise+++valueCount = 250000+++data RandIntAccum t = RandIntAccum+  t -- ^ random number generator+  Int -- ^ max count+  IntSet -- ^ accumulated unique random numbers+++-- | Since computing the size of the set is O(N), we+-- maintain the count separately.+getUniqueRandomIntegers :: RandomGen t => RandIntAccum t -> IntSet+getUniqueRandomIntegers (RandIntAccum std_gen count current_set) =++  if count == 0+    then current_set+    else getUniqueRandomIntegers newstate++  where+    (next_int, next_std_gen) = random std_gen++    a = RandIntAccum next_std_gen+    newstate = if IntSet.member next_int current_set+      then a count current_set+      else a (count - 1) (IntSet.insert next_int current_set)+++intMapTuples :: [(Int, Int)]+intMapTuples = zip random_ints [1..]+  where+    seed_value = RandIntAccum (mkStdGen 0) valueCount IntSet.empty+    random_ints = IntSet.toList $ getUniqueRandomIntegers seed_value+++main = do+  putStrLn $ unwords ["Keys size:", show $ length intMapTuples]++  let lookup_table = Construction.createMinimalPerfectHash intMapTuples++  putStrLn $ unwords [+      "Finished computing lookup table with"+    , show $ Lookup.size lookup_table+    , "entries."+    ]++  let direct_mapping_nonces = Vector.filter (< 0) $ Lookup.nonces lookup_table++  putStrLn $ unwords [+      "There were"+    , show $ Vector.length direct_mapping_nonces+    , "lookup entries with direct mappings."+    ]++  Exercise.eitherExit $ Exercise.testLookups lookup_table intMapTuples
+ demo/Strings/Main.hs view
@@ -0,0 +1,33 @@+module Main where++import           Control.Monad                 (when)++import qualified Data.PerfectHash.Construction as Construction+import qualified Data.PerfectHash.Lookup       as Lookup+import qualified Exercise+++enableDebug = False++dictionaryPath = "/usr/share/dict/words"+++main = do++  word_index_tuples <- Exercise.wordsFromFile dictionaryPath++  putStrLn $ unwords ["Words size:", show $ length word_index_tuples]++  let lookup_table = Construction.createMinimalPerfectHash word_index_tuples++  putStrLn $ unwords [+      "Finished computing lookup table with"+    , show $ Lookup.size lookup_table+    , "entries."+    ]++  when enableDebug $ do+    putStrLn $ unwords ["Vector G:", show $ Lookup.nonces lookup_table]+    putStrLn $ unwords ["Vector V:", show $ Lookup.values lookup_table]++  Exercise.eitherExit $ Exercise.testLookups lookup_table word_index_tuples
perfect-hash-generator.cabal view
@@ -1,9 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.17.1.+-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack+--+-- hash: fc4c141081795a861f9768551508e74ca60a61d1b8061163c7ee9567b112173c  name:           perfect-hash-generator-version:        0.1.0.4+version:        0.2.0.0 synopsis:       Perfect minimal hashing implementation in native Haskell description:     A <https://en.wikipedia.org/wiki/Perfect_hash_function perfect hash function> for a set @S@ is a hash function that maps distinct elements in @S@ to a set of integers, with __no collisions__. A <https://en.wikipedia.org/wiki/Perfect_hash_function#Minimal_perfect_hash_function minimal perfect hash function> is a perfect hash function that maps @n@ keys to @n@ __consecutive__ integers, e.g. the numbers from @0@ to @n-1@.                 .@@ -16,14 +18,13 @@                 This implementation was adapted from <http://stevehanov.ca/blog/index.php?id=119 Steve Hanov's Blog>.                 .                 = Usage-                The library is written generically to hash both strings and raw integers. Integers should be wrapped in the @Atom@ newtype:-                .+                The library is written generically to hash both strings and raw integers according to the <http://isthe.com/chongo/tech/comp/fnv/ FNV-1a algorithm>. Integers are split by octets before hashing.                 > import Data.PerfectHash.Construction (createMinimalPerfectHash)                 >                 > tuples = [-                >    (Atom 1000, 1)-                >  , (Atom 5555, 2)-                >  , (Atom 9876, 3)+                >    (1000, 1)+                >  , (5555, 2)+                >  , (9876, 3)                 >  ]                 >                 > lookup_table = createMinimalPerfectHash tuples@@ -56,55 +57,72 @@       src   ghc-options: -fwarn-tabs -W   build-depends:-      base >= 4.5 && <= 4.10-    , unordered-containers+      base >=4.5 && <=4.10+    , binary+    , bytestring     , containers     , data-ordlist     , directory     , filepath     , hashable+    , text+    , unordered-containers     , vector   exposed-modules:       Data.PerfectHash.Construction       Data.PerfectHash.Hashing       Data.PerfectHash.Lookup+  other-modules:+      Paths_perfect_hash_generator   default-language: Haskell2010  executable hash-perfectly-ints-demo-  main-is: Main.hs+  main-is: Ints/Main.hs   hs-source-dirs:-      demo-ints+      demo       test   ghc-options: -fwarn-tabs -W   build-depends:-      base >= 4.5 && <= 4.10-    , unordered-containers+      base >=4.5 && <=4.10+    , binary+    , bytestring+    , containers+    , hashable+    , optparse-applicative     , perfect-hash-generator     , random-    , optparse-applicative+    , text+    , unordered-containers     , vector-    , hashable-    , containers   other-modules:+      Strings.Main       Exercise+      Main+      Paths_perfect_hash_generator   default-language: Haskell2010  executable hash-perfectly-strings-demo-  main-is: Main.hs+  main-is: Strings/Main.hs   hs-source-dirs:-      demo-strings+      demo       test   ghc-options: -fwarn-tabs -W   build-depends:-      base >= 4.5 && <= 4.10-    , unordered-containers+      base >=4.5 && <=4.10+    , binary+    , bytestring+    , hashable+    , optparse-applicative     , perfect-hash-generator     , random-    , optparse-applicative+    , text+    , unordered-containers     , vector-    , hashable   other-modules:+      Ints.Main       Exercise+      Main+      Paths_perfect_hash_generator   default-language: Haskell2010  test-suite regression-tests@@ -114,15 +132,19 @@       test   ghc-options: -fwarn-tabs -W   build-depends:-      base >= 4.5 && <= 4.10-    , unordered-containers-    , perfect-hash-generator+      HUnit+    , base >=4.5 && <=4.10+    , binary+    , bytestring+    , hashable     , optparse-applicative+    , perfect-hash-generator     , test-framework-    , HUnit     , test-framework-hunit-    , hashable+    , text+    , unordered-containers     , vector   other-modules:       Exercise+      Paths_perfect_hash_generator   default-language: Haskell2010
src/Data/PerfectHash/Construction.hs view
@@ -12,12 +12,14 @@  import           Control.Arrow            (second) import           Control.Monad            (join)+import           Data.Foldable            (foldl') import           Data.Hashable            (Hashable) import           Data.HashMap.Strict      (HashMap) import qualified Data.HashMap.Strict      as HashMap import           Data.IntSet              (IntSet) import qualified Data.IntSet              as IntSet import           Data.List                (sortOn)+import           Data.Ord                 (Down (Down)) import qualified Data.Vector.Unboxed      as Vector  import qualified Data.PerfectHash.Hashing as Hashing@@ -32,13 +34,13 @@   }  +emptyLookupTable :: LookupTable a emptyLookupTable = NewLookupTable HashMap.empty HashMap.empty   class Defaultable a where   getDefault :: a - instance Defaultable Int where   getDefault = 0 @@ -58,14 +60,14 @@ -- for every element in this multi-entry bucket, for the given nonce. -- -- Return a Nothing for a slot if it collides.-attemptNonceRecursive :: (Foldable f, Hashing.ToNumeric a) =>+attemptNonceRecursive :: Hashing.ToHashableChunks a =>      HashMapAndSize Int b-  -> Int-  -> IntSet-  -> [f a]+  -> Int -- ^ nonce+  -> IntSet -- ^ occupied slots+  -> [a] -- ^ keys   -> [Maybe Int] attemptNonceRecursive _ _ _ [] = []-attemptNonceRecursive values_and_size nonce occupied_slots (x:xs) =+attemptNonceRecursive values_and_size nonce occupied_slots (current_key:remaining_bucket_keys) =    if cannot_use_slot     then pure Nothing@@ -73,7 +75,7 @@    where     HashMapAndSize values size = values_and_size-    slot = Hashing.hashToSlot nonce x size+    slot = Hashing.hashToSlot nonce current_key size      cannot_use_slot = IntSet.member slot occupied_slots || HashMap.member slot values @@ -81,7 +83,7 @@       values_and_size       nonce       (IntSet.insert slot occupied_slots)-      xs+      remaining_bucket_keys   -- | Repeatedly try different values of the nonce until we find a hash function@@ -89,10 +91,10 @@ -- -- Keeps trying forever, incrementing the candidate nonce by @1@ each time. -- Theoretically we're guaranteed to eventually find a solution.-findNonceForBucket :: (Foldable f, Hashing.ToNumeric a) =>-     Int+findNonceForBucket :: Hashing.ToHashableChunks a =>+     Int -- ^ nonce to attempt   -> HashMapAndSize Int b-  -> [f a]+  -> [a] -- ^ colliding keys for this bucket   -> ([Int], Int) findNonceForBucket nonce_attempt values_and_size bucket = @@ -109,12 +111,12 @@ -- | Searches for a nonce for this bucket, starting with the value @1@, -- until one is found that results in no collisions for both this bucket -- and all previous buckets.-handleMultiBuckets :: (Foldable f, Hashing.ToNumeric a, Eq (f a), Hashable (f a)) =>-     HashMapAndSize (f a) b-  -> (Int, [f a])+handleMultiBuckets :: (Hashing.ToHashableChunks a, Eq a, Hashable a) =>+     HashMapAndSize a b   -> LookupTable b+  -> (Int, [a])   -> LookupTable b-handleMultiBuckets sized_words_dict (computed_hash, bucket) old_lookup_table =+handleMultiBuckets sized_words_dict old_lookup_table (computed_hash, bucket) =   NewLookupTable new_g new_values   where     HashMapAndSize words_dict size = sized_words_dict@@ -132,10 +134,10 @@ -- | This function exploits the sorted structure of the list twice, -- first by skimming the multi-entry buckets, then by skimming -- the single-entry buckets and dropping the empty buckets.-findCollisionNonces :: (Foldable f, Hashing.ToNumeric a, Eq (f a), Hashable (f a)) =>-     HashMapAndSize (f a) b-  -> [(Int, [f a])]-  -> (LookupTable b, [(Int, f a)])+findCollisionNonces :: (Hashing.ToHashableChunks a, Eq a, Hashable a) =>+     HashMapAndSize a b+  -> [(Int, [a])]+  -> (LookupTable b, [(Int, a)]) findCollisionNonces sized_words_dict sorted_bucket_hash_tuples =    (lookup_table, remaining_words)@@ -146,18 +148,22 @@     -- we know there are no more collision buckets.     (multi_entry_buckets, single_or_fewer_buckets) = span ((> 1) . length . snd) sorted_bucket_hash_tuples -    lookup_table = foldr (handleMultiBuckets sized_words_dict) emptyLookupTable multi_entry_buckets+    -- XXX Using 'foldl' rather than 'foldr' is crucial here, given the order+    -- of the buckets. 'foldr' would actually try to place the smallest buckets+    -- first, making it improbable that the large buckets will be placeable,+    -- and potentially resulting in an infinite loop.+    lookup_table = foldl' (handleMultiBuckets sized_words_dict) emptyLookupTable multi_entry_buckets      single_entry_buckets = takeWhile (not . null . snd) single_or_fewer_buckets     remaining_words = map (second head) single_entry_buckets   -- | Sort buckets by descending size-preliminaryBucketPlacement :: (Foldable f, Hashing.ToNumeric a, Eq (f a), Hashable (f a)) =>-     HashMap (f a) b-  -> [(Int, [f a])]+preliminaryBucketPlacement :: (Hashing.ToHashableChunks a, Eq a, Hashable a) =>+     HashMap a b+  -> [(Int, [a])] preliminaryBucketPlacement words_dict =-  sortOn (negate . length . snd) bucket_hash_tuples+  sortOn (Down . length . snd) bucket_hash_tuples   where     size = HashMap.size words_dict     slot_key_pairs = deriveTuples (\k -> Hashing.hashToSlot 0 k size) $ HashMap.keys words_dict@@ -171,8 +177,8 @@ -- The values may be of arbitrary type. -- -- /__N.b.__/ It is assumed that the input tuples list has no duplicate keys.-createMinimalPerfectHash :: (Vector.Unbox b, Defaultable b, Foldable f, Hashing.ToNumeric a, Eq (f a), Hashable (f a)) =>-     [(f a, b)]+createMinimalPerfectHash :: (Vector.Unbox b, Defaultable b, Hashing.ToHashableChunks a, Eq a, Hashable a) =>+     [(a, b)] -- ^ key-value pairs   -> Lookup.LookupTable b createMinimalPerfectHash tuples =   convertToVector $ NewLookupTable final_g final_values
src/Data/PerfectHash/Hashing.hs view
@@ -1,37 +1,47 @@ {-# OPTIONS_HADDOCK prune #-} +{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeSynonymInstances #-}++ -- | Implements the specialized hash function for -- this perfect hashing algorithm. module Data.PerfectHash.Hashing where -import           Data.Bits (xor, (.&.))-import           Data.Char (ord)+import           Data.Binary          (encode)+import           Data.Bits            (xor, (.&.))+import           Data.ByteString.Lazy (unpack)+import           Data.Char            (ord)+import           Data.Text            (Text)+import qualified Data.Text            as T   -- | This choice of prime number was taken from the Python implementation -- on <http://stevehanov.ca/blog/index.php?id=119 Steve Hanov's page>.+primeFNV :: Int primeFNV = 0x01000193  +mask32bits :: Int mask32bits = 0xffffffff  --- | A Foldable of any data type may be hashed, so long as it implements--- an instance of this class.-class ToNumeric a where-  toNum :: a -> Int+class ToHashableChunks a where+  toHashableChunks :: a -> [Int] --- | The numeric value of a character is simply its ordinal value.-instance ToNumeric Char where-  toNum = ord+instance ToHashableChunks Int where+  toHashableChunks = map fromIntegral . unpack . encode -instance ToNumeric Int where-  toNum = id+instance ToHashableChunks Text where+  toHashableChunks = map ord . T.unpack +instance ToHashableChunks String where+  toHashableChunks = map ord -hashToSlot :: (Foldable f, ToNumeric a) =>++hashToSlot :: ToHashableChunks a =>      Int -- ^ nonce-  -> f a -- ^ key+  -> a -- ^ key   -> Int -- ^ array size   -> Int hashToSlot nonce key size = hash nonce key `mod` size@@ -49,13 +59,17 @@ -- The interface is comparable to the -- <https://hackage.haskell.org/package/hashable-1.2.6.1/docs/Data-Hashable.html#v:hashWithSalt hashWithSalt> -- function from the @hashable@ package.-hash :: (Foldable f, ToNumeric a) => Int -> f a -> Int+hash :: ToHashableChunks a =>+     Int -- ^ nonce+  -> a -- ^ key+  -> Int hash nonce = -  foldl combine d -- NOTE: This must be 'foldl', not 'foldr'+  -- NOTE: This must be 'foldl', not 'foldr'+  foldl combine d . toHashableChunks   where     d = if nonce == 0       then primeFNV       else nonce -    combine acc = (.&. mask32bits) . (* primeFNV) . xor acc . toNum+    combine acc = (.&. mask32bits) . (* primeFNV) . xor acc
src/Data/PerfectHash/Lookup.hs view
@@ -1,7 +1,7 @@ {-# OPTIONS_HADDOCK prune #-}  -- | Note that what is referred to as a \"nonce\" in this library may be--- referred to by some as a \"salt\".+-- equivalently described as a \"salt\" by some. module Data.PerfectHash.Lookup (     LookupTable (LookupTable)   , nonces@@ -46,6 +46,7 @@ size = Vector.length . values  +encodeDirectEntry :: Int -> Int encodeDirectEntry = subtract 1 . negate  @@ -68,9 +69,9 @@ --           respect to the length of the 'values' array. -- --     3. Use the result of (2) as the index into the 'values' array.-lookupPerfect :: (Foldable f, Hashing.ToNumeric a, Vector.Unbox b) =>+lookupPerfect :: (Hashing.ToHashableChunks a, Vector.Unbox b) =>      LookupTable b-  -> f a+  -> a -- ^ key   -> b lookupPerfect lookup_table key =
test/Exercise.hs view
@@ -1,30 +1,16 @@-{-# LANGUAGE DeriveGeneric #-}- module Exercise where  import           Control.Monad            (unless) import           Data.Foldable            (traverse_)-import           Data.Hashable            (Hashable) import qualified Data.Vector.Unboxed      as Vector-import           GHC.Generics             (Generic)  import qualified Data.PerfectHash.Hashing as Hashing import qualified Data.PerfectHash.Lookup  as Lookup  --- | Wrapper to allow hashing of an integer-newtype Atom a = Atom {value :: a} deriving (Eq, Show, Generic)--instance Hashable a => Hashable (Atom a)---instance Foldable Atom where-  foldr f acc (Atom val) = f val acc---testLookups :: (Show b, Eq b, Show (f a), Foldable f, Hashing.ToNumeric a, Vector.Unbox b) =>+testLookups :: (Show b, Eq b, Show a, Hashing.ToHashableChunks a, Vector.Unbox b) =>      Lookup.LookupTable b-  -> [(f a, b)]+  -> [(a, b)]   -> Either String () testLookups lookup_table =   traverse_ check_entry
test/Main.hs view
@@ -1,7 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}+ module Main where  import           Data.Either                    (isRight) import           Data.Hashable                  (Hashable)+import           Data.Text                      (Text) import qualified Data.Vector.Unboxed            as Vector import           Test.Framework                 (defaultMain, testGroup) import           Test.Framework.Providers.HUnit (testCase)@@ -9,35 +12,46 @@  import qualified Data.PerfectHash.Construction  as Construction import qualified Data.PerfectHash.Hashing       as Hashing-import           Exercise                       (Atom (Atom)) import qualified Exercise  -testHashComputation :: String -> Int -> IO ()+testHashComputation :: (Hashing.ToHashableChunks a, Show a) =>+     a+  -> Int+  -> IO () testHashComputation key val =   assertEqual error_message val computed_hash   where-    error_message = unwords ["Incorrect hash computation of", key]+    error_message = unwords ["Incorrect hash computation of", show key]     computed_hash = Hashing.hash 0 key  -wordIndexTuples = [-    ("apple", 1 :: Int)-  , ("banana", 2)-  , ("carrot", 3)-  ]+wordIndexTuplesString :: [(String, Int)]+wordIndexTuplesString = zip [+    "apple"+  , "banana"+  , "carrot"+  ] [1..]  -intMapTuples :: [(Atom Int, Int)]+wordIndexTuplesText :: [(Text, Int)]+wordIndexTuplesText = zip [+    "alpha"+  , "beta"+  , "gamma"+  ] [1..]+++intMapTuples :: [(Int, Int)] intMapTuples = [-    (Atom 1000, 1)-  , (Atom 5555, 2)-  , (Atom 9876, 3)+    (1000, 1)+  , (5555, 2)+  , (9876, 3)   ]  -testHashLookups :: (Show (f a), Show b, Eq b, Vector.Unbox b, Construction.Defaultable b, Foldable f, Hashing.ToNumeric a, Eq (f a), Hashable (f a)) =>-  [(f a, b)] -> IO ()+testHashLookups :: (Show a, Show b, Eq b, Vector.Unbox b, Construction.Defaultable b, Hashing.ToHashableChunks a, Eq a, Hashable a) =>+  [(a, b)] -> IO () testHashLookups word_index_tuples =   assertBool "Perfect hash lookups failed to match the input" $ isRight test_result_either   where@@ -47,10 +61,12 @@  tests = [     testGroup "Hash computation" [-      testCase "compute-hash1" $ testHashComputation "blarg" 3322346319+      testCase "compute-string-hash" $ testHashComputation ("blarg" :: String) 3322346319+    , testCase "compute-int-hash" $ testHashComputation (70000 :: Int) 4169891409     ]   , testGroup "Hash lookups" [-      testCase "word-lookups" $ testHashLookups wordIndexTuples+      testCase "word-lookups-string" $ testHashLookups wordIndexTuplesString+    , testCase "word-lookups-text" $ testHashLookups wordIndexTuplesText     , testCase "int-lookups" $ testHashLookups intMapTuples     ]   ]