diff --git a/demo/ints/Main.hs b/demo/ints/Main.hs --- a/demo/ints/Main.hs +++ b/demo/ints/Main.hs @@ -2,6 +2,8 @@ import System.Random (RandomGen, mkStdGen, random) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet import qualified Data.PerfectHash.Construction as Construction @@ -37,8 +39,8 @@ else a (count - 1) (IntSet.insert next_int current_set) -intMapTuples :: [(Int, Int)] -intMapTuples = zip random_ints [1..] +intMapTuples :: HashMap Int Int +intMapTuples = HashMap.fromList $ zip random_ints [1..] where seed_value = RandIntAccum (mkStdGen 0) valueCount IntSet.empty random_ints = IntSet.toList $ getUniqueRandomIntegers seed_value diff --git a/demo/strings/Main.hs b/demo/strings/Main.hs --- a/demo/strings/Main.hs +++ b/demo/strings/Main.hs @@ -1,6 +1,7 @@ module Main where import Control.Monad (when) +import qualified Data.HashMap.Strict as HashMap import qualified Data.PerfectHash.Construction as Construction import qualified Data.PerfectHash.Lookup as Lookup @@ -18,7 +19,7 @@ putStrLn $ unwords ["Words size:", show $ length word_index_tuples] - let lookup_table = Construction.createMinimalPerfectHash word_index_tuples + let lookup_table = Construction.createMinimalPerfectHash $ HashMap.fromList word_index_tuples putStrLn $ unwords [ "Finished computing lookup table with" @@ -30,4 +31,4 @@ 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 + Exercise.eitherExit $ Exercise.testLookups lookup_table $ HashMap.fromList word_index_tuples diff --git a/perfect-hash-generator.cabal b/perfect-hash-generator.cabal --- a/perfect-hash-generator.cabal +++ b/perfect-hash-generator.cabal @@ -2,16 +2,16 @@ -- -- see: https://github.com/sol/hpack -- --- hash: df669bc3ba741914da19be7e67c73565365e07ef3a7f13c93f2d9c51330f48bb +-- hash: 5294c49846f25b6cb06c72295e7bffbdf2443d5e99a7f79652dd5176510b48b5 name: perfect-hash-generator -version: 0.2.0.5 +version: 0.2.0.6 synopsis: Perfect minimal hashing implementation in native Haskell description: A for a set @S@ is a hash function that maps distinct elements in @S@ to a set of integers, with __no collisions__. A is a perfect hash function that maps @n@ keys to @n@ __consecutive__ integers, e.g. the numbers from @0@ to @n-1@. . In contrast with the , which is a binding to a C-based library, this package is a fully-native Haskell implementation. . - It is intended primarily for generating C code for embedded applications (compare to @@). The output of this tool is a pair of arrays that can be included in generated C code for __-free hash tables__. + It is intended primarily for generating C code for embedded applications (compare to @@). The output of this tool is a pair of arrays that can be included in generated C code for __ hash tables__. . Though lookups also perform reasonably well for Haskell applications, it hasn't been benchmarked thorougly with respect to other data structures. . @@ -21,6 +21,7 @@ The library is written generically to hash both strings and raw integers according to the . Integers are split by octets before hashing. . > import Data.PerfectHash.Construction (createMinimalPerfectHash) + > import qualified Data.HashMap.Strict as HashMap > > tuples = [ > (1000, 1) @@ -28,7 +29,7 @@ > , (9876, 3) > ] > - > lookup_table = createMinimalPerfectHash tuples + > lookup_table = createMinimalPerfectHash $ HashMap.fromList tuples . Generation of C code based on the arrays in @lookup_table@ is left as an exercise to the reader. Algorithm documentation in the "Data.PerfectHash.Hashing" and "Data.PerfectHash.Lookup" modules will be helpful. . diff --git a/src/Data/PerfectHash/Construction.hs b/src/Data/PerfectHash/Construction.hs --- a/src/Data/PerfectHash/Construction.hs +++ b/src/Data/PerfectHash/Construction.hs @@ -1,10 +1,13 @@ {-# OPTIONS_HADDOCK prune #-} --- | Constructs a minimal perfect hash. +-- | Constructs a minimal perfect hash from a map of key-value pairs. -- --- Implementation was transliterated from Python on --- --- and then refactored. +-- Implementation was adapted from +-- . +-- +-- A refactoring of that Python implementation may be found +-- . +-- This Haskell implementation is transliterated from that refactoring. module Data.PerfectHash.Construction ( createMinimalPerfectHash , Defaultable @@ -38,6 +41,7 @@ emptyLookupTable = NewLookupTable HashMap.empty HashMap.empty +-- | Used to fill empty slots when promoting a HashMap to a Vector class Defaultable a where getDefault :: a @@ -60,6 +64,9 @@ -- for every element in this multi-entry bucket, for the given nonce. -- -- Return a Nothing for a slot if it collides. +-- +-- This function is able to fail fast if one of the elements of the bucket +-- yields a collision with the new nonce. attemptNonceRecursive :: Hashing.ToHashableChunks a => HashMapAndSize Int b -> Int -- ^ nonce @@ -95,10 +102,10 @@ Int -- ^ nonce to attempt -> HashMapAndSize Int b -> [a] -- ^ colliding keys for this bucket - -> ([Int], Int) + -> ([(Int, a)], Int) -- ^ slots for each bucket, with the current nonce attempt findNonceForBucket nonce_attempt values_and_size bucket = - maybe recursive_result (\x -> (x, nonce_attempt)) maybe_attempt_result + maybe recursive_result (\x -> (zip x bucket, nonce_attempt)) maybe_attempt_result where recursive_result = findNonceForBucket (nonce_attempt + 1) values_and_size bucket maybe_attempt_result = sequenceA $ attemptNonceRecursive @@ -117,17 +124,17 @@ -> (Int, [a]) -> LookupTable b handleMultiBuckets sized_words_dict old_lookup_table (computed_hash, bucket) = - NewLookupTable new_g new_values + NewLookupTable new_g new_values_dict where HashMapAndSize words_dict size = sized_words_dict sized_vals_dict = HashMapAndSize (vals old_lookup_table) size - (slots, nonce) = findNonceForBucket 1 sized_vals_dict bucket + (slots_for_bucket, nonce) = findNonceForBucket 1 sized_vals_dict bucket - new_g = HashMap.insert computed_hash nonce (redirs old_lookup_table) - new_values = foldr fold_func (vals old_lookup_table) $ zip [0..] bucket + new_g = HashMap.insert computed_hash nonce $ redirs old_lookup_table + new_values_dict = foldr fold_func (vals old_lookup_table) slots_for_bucket - fold_func (i, bucket_val) = HashMap.insert (slots !! i) $ + fold_func (slot_val, bucket_val) = HashMap.insert slot_val $ HashMap.lookupDefault (error "not found") bucket_val words_dict @@ -173,17 +180,17 @@ -- | Generates a minimal perfect hash for a set of key-value pairs. -- --- The keys must be 'Foldable's of 'ToNumeric' instances in order to be hashable. +-- The keys must be instances of 'Hashing.ToHashableChunks'. -- The values may be of arbitrary type. -- --- /__N.b.__/ It is assumed that the input tuples list has no duplicate keys. +-- A 'HashMap' is required as input to guarantee that there are no duplicate keys. createMinimalPerfectHash :: (Vector.Unbox b, Defaultable b, Hashing.ToHashableChunks a, Eq a, Hashable a) => - [(a, b)] -- ^ key-value pairs + HashMap a b -- ^ key-value pairs -> Lookup.LookupTable b -createMinimalPerfectHash tuples = + -- ^ output for use by 'LookupTable.lookup' or a custom code generator +createMinimalPerfectHash words_dict = convertToVector $ NewLookupTable final_g final_values where - words_dict = HashMap.fromList tuples size = HashMap.size words_dict sorted_bucket_hash_tuples = preliminaryBucketPlacement words_dict @@ -215,6 +222,8 @@ where f tuple = HashMap.insertWith (++) (snd tuple) [fst tuple] + +-- * Utility functions -- | duplicates the argument into both members of the tuple duple :: a -> (a, a) diff --git a/src/Data/PerfectHash/Hashing.hs b/src/Data/PerfectHash/Hashing.hs --- a/src/Data/PerfectHash/Hashing.hs +++ b/src/Data/PerfectHash/Hashing.hs @@ -1,22 +1,27 @@ {-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE TypeSynonymInstances #-} -- | Implements the specialized hash function for -- this perfect hashing algorithm. +-- +-- C code that makes use of the perfect hash table output must exactly +-- re-implement this 'hash' function. module Data.PerfectHash.Hashing where import Data.Binary (encode) import Data.Bits (xor, (.&.)) import Data.ByteString.Lazy (unpack) import Data.Char (ord) +import Data.Foldable (foldl') import Data.Text (Text) import qualified Data.Text as T --- | This choice of prime number was taken from the Python implementation +-- | This choice of prime number @0x01000193@ was taken from the Python implementation -- on . primeFNV :: Int primeFNV = 0x01000193 @@ -26,6 +31,8 @@ mask32bits = 0xffffffff +-- | Mechanism for a key to be decomposed into units processable by the +-- hashing algorithm. class ToHashableChunks a where toHashableChunks :: a -> [Int] @@ -48,7 +55,7 @@ -- | Uses the \"FNV-1a\" algorithm from the --- : +-- : -- -- > hash = offset_basis -- > for each octet_of_data to be hashed @@ -66,7 +73,7 @@ hash nonce = -- NOTE: This must be 'foldl', not 'foldr' - foldl combine d . toHashableChunks + foldl' combine d . toHashableChunks where d = if nonce == 0 then primeFNV diff --git a/src/Data/PerfectHash/Lookup.hs b/src/Data/PerfectHash/Lookup.hs --- a/src/Data/PerfectHash/Lookup.hs +++ b/src/Data/PerfectHash/Lookup.hs @@ -1,18 +1,17 @@ {-# OPTIONS_HADDOCK prune #-} -- | Note that what is referred to as a \"nonce\" in this library may be --- equivalently described as a \"salt\" by some. +-- better known as . module Data.PerfectHash.Lookup ( - LookupTable (LookupTable) - , nonces - , values + LookupTable (LookupTable, nonces, values) , size , encodeDirectEntry - , lookupPerfect + , lookup ) where import Data.Vector.Unboxed (Vector, (!)) import qualified Data.Vector.Unboxed as Vector +import Prelude hiding (lookup) import qualified Data.PerfectHash.Hashing as Hashing @@ -33,12 +32,12 @@ -- Otherwise, the value shall be used as a nonce in a second application of -- the hashing function to compute the index into the 'values' array. -- - -- See the documentation of 'lookupPerfect' for details. + -- See the documentation of 'lookup' for details. , values :: Vector a -- ^ An array of values of arbitrary type. -- - -- The objective of the perfect hash is to efficiently obtain an index into - -- this array, given the associated key for the value at that index. + -- The objective of the perfect hash is to efficiently retrieve an index into + -- this array, given the key associated with the value at that index. } @@ -69,11 +68,11 @@ -- respect to the length of the 'values' array. -- -- 3. Use the result of (2) as the index into the 'values' array. -lookupPerfect :: (Hashing.ToHashableChunks a, Vector.Unbox b) => +lookup :: (Hashing.ToHashableChunks a, Vector.Unbox b) => LookupTable b -> a -- ^ key - -> b -lookupPerfect lookup_table key = + -> b -- ^ value +lookup lookup_table key = values lookup_table ! v_key diff --git a/test-utils/Exercise.hs b/test-utils/Exercise.hs --- a/test-utils/Exercise.hs +++ b/test-utils/Exercise.hs @@ -4,6 +4,8 @@ import Control.Monad (unless) import Data.Foldable (traverse_) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap import qualified Data.Vector.Unboxed as Vector import qualified Data.PerfectHash.Hashing as Hashing @@ -12,10 +14,10 @@ testLookups :: (Show b, Eq b, Show a, Hashing.ToHashableChunks a, Vector.Unbox b) => Lookup.LookupTable b - -> [(a, b)] + -> HashMap a b -> Either String () testLookups lookup_table = - traverse_ check_entry + traverse_ check_entry . HashMap.toList where check_entry (word, source_index) = unless (lookup_result == source_index) $ Left $ unwords [ @@ -27,7 +29,7 @@ , show source_index ] where - lookup_result = Lookup.lookupPerfect lookup_table word + lookup_result = Lookup.lookup lookup_table word -- | Generate a map of words from a file to their line numbers. diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -4,6 +4,8 @@ import Data.Either (isRight) import Data.Hashable (Hashable) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap import Data.Text (Text) import qualified Data.Vector.Unboxed as Vector import Test.Framework (defaultMain, testGroup) @@ -26,32 +28,33 @@ computed_hash = Hashing.hash 0 key -wordIndexTuplesString :: [(String, Int)] -wordIndexTuplesString = zip [ +wordIndexTuplesString :: HashMap String Int +wordIndexTuplesString = HashMap.fromList $ zip [ "apple" , "banana" , "carrot" ] [1..] -wordIndexTuplesText :: [(Text, Int)] -wordIndexTuplesText = zip [ +wordIndexTuplesText :: HashMap Text Int +wordIndexTuplesText = HashMap.fromList $ zip [ "alpha" , "beta" , "gamma" ] [1..] -intMapTuples :: [(Int, Int)] -intMapTuples = [ - (1000, 1) - , (5555, 2) - , (9876, 3) - ] +intMapTuples :: HashMap Int Int +intMapTuples = HashMap.fromList $ zip [ + 1000 + , 5555 + , 9876 + ] [1..] testHashLookups :: (Show a, Show b, Eq b, Vector.Unbox b, Construction.Defaultable b, Hashing.ToHashableChunks a, Eq a, Hashable a) => - [(a, b)] -> IO () + HashMap a b + -> IO () testHashLookups word_index_tuples = assertBool "Perfect hash lookups failed to match the input" $ isRight test_result_either where