packages feed

perfect-hash-generator 0.1.0.2 → 0.1.0.3

raw patch · 10 files changed

+203/−185 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

+ demo/Ints/Main.hs view
@@ -0,0 +1,71 @@+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/IntsDemo.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 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
− demo/StringsDemo.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
perfect-hash-generator.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           perfect-hash-generator-version:        0.1.0.2+version:        0.1.0.3 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@.                 .@@ -71,7 +71,7 @@   default-language: Haskell2010  executable hash-perfectly-ints-demo-  main-is: IntsDemo.hs+  main-is: Ints/Main.hs   hs-source-dirs:       demo       test@@ -86,13 +86,13 @@     , hashable     , containers   other-modules:-      StringsDemo+      Strings.Main       Exercise-      Test+      Main   default-language: Haskell2010  executable hash-perfectly-strings-demo-  main-is: StringsDemo.hs+  main-is: Strings/Main.hs   hs-source-dirs:       demo       test@@ -106,14 +106,14 @@     , vector     , hashable   other-modules:-      IntsDemo+      Ints.Main       Exercise-      Test+      Main   default-language: Haskell2010  test-suite regression-tests   type: exitcode-stdio-1.0-  main-is: Test.hs+  main-is: Main.hs   hs-source-dirs:       test   ghc-options: -fwarn-tabs -W
src/Data/PerfectHash/Construction.hs view
@@ -54,6 +54,10 @@     a2 = Vector.generate size (\z -> HashMap.lookupDefault getDefault z $ vals x)  +-- | Computes a slot in the destination array (Data.PerfectHash.Lookup.values)+-- 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) =>      HashMapAndSize Int b   -> Int@@ -61,26 +65,29 @@   -> [f a]   -> [Maybe Int] attemptNonceRecursive _ _ _ [] = []-attemptNonceRecursive values_and_size nonce previous_slots (x:xs) =+attemptNonceRecursive values_and_size nonce occupied_slots (x:xs) =    if cannot_use_slot-    then [Nothing]+    then pure Nothing     else Just slot : recursive_result    where     HashMapAndSize values size = values_and_size-    slot = Hashing.hash nonce x `mod` size+    slot = Hashing.hashToSlot nonce x size -    cannot_use_slot = IntSet.member slot previous_slots || HashMap.member slot values+    cannot_use_slot = IntSet.member slot occupied_slots || HashMap.member slot values -    next_slots = IntSet.insert slot previous_slots-    recursive_result = attemptNonceRecursive values_and_size nonce next_slots xs+    recursive_result = attemptNonceRecursive+      values_and_size+      nonce+      (IntSet.insert slot occupied_slots)+      xs   -- | Repeatedly try different values of the nonce until we find a hash function--- that places all items in the bucket into free slots+-- that places all items in the bucket into free slots. ----- Keeps trying forever.+-- 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@@ -99,6 +106,9 @@       bucket  +-- | 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])@@ -110,9 +120,9 @@     HashMapAndSize words_dict size = sized_words_dict      sized_vals_dict = HashMapAndSize (vals old_lookup_table) size-    (slots, d) = findNonceForBucket 1 sized_vals_dict bucket+    (slots, nonce) = findNonceForBucket 1 sized_vals_dict bucket -    new_g = HashMap.insert computed_hash d (redirs old_lookup_table)+    new_g = HashMap.insert computed_hash nonce (redirs old_lookup_table)     new_values = foldr fold_func (vals old_lookup_table) $ zip [0..] bucket      fold_func (i, bucket_val) = HashMap.insert (slots !! i) $@@ -150,7 +160,7 @@   sortOn (negate . length . snd) bucket_hash_tuples   where     size = HashMap.size words_dict-    slot_key_pairs = deriveTuples ((`mod` size) . Hashing.hash 0) $ HashMap.keys words_dict+    slot_key_pairs = deriveTuples (\k -> Hashing.hashToSlot 0 k size) $ HashMap.keys words_dict      bucket_hash_tuples = HashMap.toList $ binTuplesBySecond slot_key_pairs @@ -192,7 +202,7 @@  -- * Utilities --- | Place the second elements of the tuples into bins according to the second+-- | Place the first elements of the tuples into bins according to the second -- element. binTuplesBySecond :: (Eq b, Hashable b) => [(a, b)] -> HashMap.HashMap b [a] binTuplesBySecond = foldr f HashMap.empty
src/Data/PerfectHash/Hashing.hs view
@@ -29,6 +29,14 @@   toNum = id  +hashToSlot :: (Foldable f, ToNumeric a) =>+     Int -- ^ nonce+  -> f a -- ^ key+  -> Int -- ^ array size+  -> Int+hashToSlot nonce key size = hash nonce key `mod` size++ -- | Uses the \"FNV-1a\" algorithm from the -- <http://isthe.com/chongo/tech/comp/fnv/ FNV website>: --
src/Data/PerfectHash/Lookup.hs view
@@ -79,10 +79,10 @@   where     table_size = size lookup_table -    nonce_index = Hashing.hash 0 key `mod` table_size+    nonce_index = Hashing.hashToSlot 0 key table_size     nonce = nonces lookup_table ! nonce_index      -- Negative value indicates that we don't need extra lookup layer     v_key = if nonce < 0       then encodeDirectEntry nonce-      else Hashing.hash nonce key `mod` table_size+      else Hashing.hashToSlot nonce key table_size
+ test/Main.hs view
@@ -0,0 +1,59 @@+module Main where++import           Data.Either                    (isRight)+import           Data.Hashable                  (Hashable)+import qualified Data.Vector.Unboxed            as Vector+import           Test.Framework                 (defaultMain, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     (assertBool, assertEqual)++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 key val =+  assertEqual error_message val computed_hash+  where+    error_message = unwords ["Incorrect hash computation of", key]+    computed_hash = Hashing.hash 0 key+++wordIndexTuples = [+    ("apple", 1 :: Int)+  , ("banana", 2)+  , ("carrot", 3)+  ]+++intMapTuples :: [(Atom Int, Int)]+intMapTuples = [+    (Atom 1000, 1)+  , (Atom 5555, 2)+  , (Atom 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 word_index_tuples =+  assertBool "Perfect hash lookups failed to match the input" $ isRight test_result_either+  where+    lookup_table = Construction.createMinimalPerfectHash word_index_tuples+    test_result_either = Exercise.testLookups lookup_table word_index_tuples+++tests = [+    testGroup "Hash computation" [+      testCase "compute-hash1" $ testHashComputation "blarg" 3322346319+    ]+  , testGroup "Hash lookups" [+      testCase "word-lookups" $ testHashLookups wordIndexTuples+    , testCase "int-lookups" $ testHashLookups intMapTuples+    ]+  ]+++main = defaultMain tests
− test/Test.hs 
@@ -1,59 +0,0 @@-module Main where--import           Data.Either                    (isRight)-import           Data.Hashable                  (Hashable)-import qualified Data.Vector.Unboxed            as Vector-import           Test.Framework                 (defaultMain, testGroup)-import           Test.Framework.Providers.HUnit (testCase)-import           Test.HUnit                     (assertBool, assertEqual)--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 key val =-  assertEqual error_message val computed_hash-  where-    error_message = unwords ["Incorrect hash computation of", key]-    computed_hash = Hashing.hash 0 key---wordIndexTuples = [-    ("apple", 1 :: Int)-  , ("banana", 2)-  , ("carrot", 3)-  ]---intMapTuples :: [(Atom Int, Int)]-intMapTuples = [-    (Atom 1000, 1)-  , (Atom 5555, 2)-  , (Atom 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 word_index_tuples =-  assertBool "Perfect hash lookups failed to match the input" $ isRight test_result_either-  where-    lookup_table = Construction.createMinimalPerfectHash word_index_tuples-    test_result_either = Exercise.testLookups lookup_table word_index_tuples---tests = [-    testGroup "Hash computation" [-      testCase "compute-hash1" $ testHashComputation "blarg" 3322346319-    ]-  , testGroup "Hash lookups" [-      testCase "word-lookups" $ testHashLookups wordIndexTuples-    , testCase "int-lookups" $ testHashLookups intMapTuples-    ]-  ]---main = defaultMain tests