perfect-hash-generator (empty) → 0.1.0.0
raw patch · 9 files changed
+1033/−0 lines, 9 filesdep +HUnitdep +basedep +containers
Dependencies added: HUnit, base, containers, data-ordlist, directory, filepath, hashable, optparse-applicative, perfect-hash-generator, random, test-framework, test-framework-hunit, unordered-containers, vector
Files
- LICENSE +335/−0
- demo/IntsDemo.hs +70/−0
- demo/StringsDemo.hs +33/−0
- perfect-hash-generator.cabal +126/−0
- src/Data/PerfectHash/Construction.hs +216/−0
- src/Data/PerfectHash/Hashing.hs +50/−0
- src/Data/PerfectHash/Lookup.hs +88/−0
- test/Exercise.hs +58/−0
- test/Test.hs +57/−0
+ LICENSE view
@@ -0,0 +1,335 @@+Summary: This library is licensed under Apache-2.0, BSD2, and MIT.++Some code in this library is derived from the process library, whose license+is in the "Library" section.++-----------------------------------------------------------------------------++== The 2-Clause BSD License ==++Copyright 2016-2017 XT <https://e.xtendo.org/>++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-----------------------------------------------------------------------------++== The MIT License ==++Copyright (c) 2016-2017 XT <https://e.xtendo.org/>++Permission is hereby granted, free of charge, to any+person obtaining a copy of this software and associated+documentation files (the "Software"), to deal in the+Software without restriction, including without+limitation the rights to use, copy, modify, merge,+publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software+is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice+shall be included in all copies or substantial portions+of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF+ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED+TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A+PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT+SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR+IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER+DEALINGS IN THE SOFTWARE.++-----------------------------------------------------------------------------++== The Apache License Version 2.0 ==++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.++-----------------------------------------------------------------------------++== Library ==++The libraries (process and directory) are derived from code from two+sources:++ * Code from the GHC project which is largely (c) The University of+ Glasgow, and distributable under a BSD-style license (see below),++ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+ and freely redistributable (but see the full license for+ restrictions).++The full text of these licenses is reproduced below. Both of the+licenses are BSD-style or compatible.++-----------------------------------------------------------------------------++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.++-----------------------------------------------------------------------------++Code derived from the document "Report on the Programming Language+Haskell 98", is distributed under the following license:++ Copyright (c) 2002 Simon Peyton Jones++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Language.++-----------------------------------------------------------------------------
+ demo/IntsDemo.hs view
@@ -0,0 +1,70 @@+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.Lookup as Lookup+import qualified Data.Vector.Unboxed as Vector+import Exercise (Atom (Atom))+import qualified Exercise+++valueCount = 500000++upperBound = 2^32 - 1+randomRange = (0, upperBound)+++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."+ ]++ let test_result_either = Exercise.testLookups lookup_table intMapTuples+ Exercise.eitherExit test_result_either
+ demo/StringsDemo.hs view
@@ -0,0 +1,33 @@+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]+++ let test_result_either = Exercise.testLookups lookup_table word_index_tuples+ Exercise.eitherExit test_result_either
+ perfect-hash-generator.cabal view
@@ -0,0 +1,126 @@+-- This file has been generated from package.yaml by hpack version 0.17.1.+--+-- see: https://github.com/sol/hpack++name: perfect-hash-generator+version: 0.1.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@.+ .+ In contrast with the <https://hackage.haskell.org/package/PerfectHash PerfectHash package>, 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 @<https://www.gnu.org/software/gperf/manual/gperf.html#Search-Structures gperf>@). The output of this tool is a pair of arrays that can be included in generated C code for __<https://en.wikipedia.org/wiki/C_dynamic_memory_allocation allocation>-free hash tables__.+ .+ Though lookups also perform reasonably well for Haskell applications, it hasn't been benchmarked thorougly with respect to other data structures.+ .+ 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:+ .+ > import Data.PerfectHash.Construction (createMinimalPerfectHash)+ >+ > tuples = [+ > (Atom 1000, 1)+ > , (Atom 5555, 2)+ > , (Atom 9876, 3)+ > ]+ >+ > lookup_table = createMinimalPerfectHash 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.+ .+ See the @hash-perfectly-strings-demo@ and @hash-perfectly-ints-demo@, as well as the test suite, for working examples.+ .+ > $ stack build+ > $ stack exec hash-perfectly-strings-demo+ .+ = Caveats+ Only integer keys of at most __32-bits__ have been demonstrated to work properly. Since the hash function masks to 32 bits, colliding 64-bit integers can hang the lookup table construction. +category: Data Structures, Embedded+author: Karl Ostmo+maintainer: kostmo@gmail.com+license: Apache-2.0+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++library+ hs-source-dirs:+ src+ ghc-options: -fwarn-tabs -W+ build-depends:+ base >= 4.5 && <= 4.10+ , unordered-containers+ , containers+ , data-ordlist+ , directory+ , filepath+ , hashable+ , vector+ exposed-modules:+ Data.PerfectHash.Construction+ Data.PerfectHash.Hashing+ Data.PerfectHash.Lookup+ default-language: Haskell2010++executable hash-perfectly-ints-demo+ main-is: IntsDemo.hs+ hs-source-dirs:+ demo+ test+ ghc-options: -fwarn-tabs -W+ build-depends:+ base >= 4.5 && <= 4.10+ , unordered-containers+ , perfect-hash-generator+ , random+ , optparse-applicative+ , vector+ , hashable+ , containers+ other-modules:+ StringsDemo+ Exercise+ Test+ default-language: Haskell2010++executable hash-perfectly-strings-demo+ main-is: StringsDemo.hs+ hs-source-dirs:+ demo+ test+ ghc-options: -fwarn-tabs -W+ build-depends:+ base >= 4.5 && <= 4.10+ , unordered-containers+ , perfect-hash-generator+ , random+ , optparse-applicative+ , vector+ , hashable+ other-modules:+ IntsDemo+ Exercise+ Test+ default-language: Haskell2010++test-suite regression-tests+ type: exitcode-stdio-1.0+ main-is: Test.hs+ hs-source-dirs:+ test+ ghc-options: -fwarn-tabs -W+ build-depends:+ base >= 4.5 && <= 4.10+ , unordered-containers+ , perfect-hash-generator+ , optparse-applicative+ , test-framework+ , HUnit+ , test-framework-hunit+ , hashable+ , vector+ other-modules:+ Exercise+ default-language: Haskell2010
+ src/Data/PerfectHash/Construction.hs view
@@ -0,0 +1,216 @@+{-# OPTIONS_HADDOCK prune #-}++-- | Constructs a minimal perfect hash.+--+-- Implementation was transliterated from Python on+-- <http://stevehanov.ca/blog/index.php?id=119 Steve Hanov's Blog>+-- and then refactored.+module Data.PerfectHash.Construction (+ createMinimalPerfectHash+ , Defaultable+ ) where++import Control.Arrow (second)+import Control.Monad (join)+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 qualified Data.Vector.Unboxed as Vector++import qualified Data.PerfectHash.Hashing as Hashing+import qualified Data.PerfectHash.Lookup as Lookup+++-- | NOTE: Vector may peform better for these structures, but+-- the code may not be as clean.+data LookupTable a = NewLookupTable {+ redirs :: HashMap Int Int+ , vals :: HashMap Int a+ }+++emptyLookupTable = NewLookupTable HashMap.empty HashMap.empty+++class Defaultable a where+ getDefault :: a+++instance Defaultable Int where+ getDefault = 0+++data HashMapAndSize a b = HashMapAndSize (HashMap a b) Int+++convertToVector :: (Vector.Unbox a, Defaultable a) => LookupTable a -> Lookup.LookupTable a+convertToVector x = Lookup.LookupTable a1 a2+ where+ size = length $ vals x+ a1 = Vector.generate size (\z -> HashMap.lookupDefault 0 z $ redirs x)+ a2 = Vector.generate size (\z -> HashMap.lookupDefault getDefault z $ vals x)+++attemptNonceRecursive :: (Foldable f, Hashing.ToNumeric a) =>+ HashMapAndSize Int b+ -> Int+ -> IntSet+ -> [f a]+ -> [Maybe Int]+attemptNonceRecursive _ _ _ [] = []+attemptNonceRecursive values_and_size nonce previous_slots (x:xs) =++ if cannot_use_slot+ then [Nothing]+ else Just slot : recursive_result++ where+ HashMapAndSize values size = values_and_size+ slot = Hashing.hash nonce x `mod` size++ cannot_use_slot = IntSet.member slot previous_slots || HashMap.member slot values++ next_slots = IntSet.insert slot previous_slots+ recursive_result = attemptNonceRecursive values_and_size nonce next_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+--+-- Keeps trying forever.+-- Theoretically we're guaranteed to eventually find a solution.+findNonceForBucket :: (Foldable f, Hashing.ToNumeric a) =>+ Int+ -> HashMapAndSize Int b+ -> [f a]+ -> ([Int], Int)+findNonceForBucket nonce_attempt values_and_size bucket =++ maybe recursive_result (\x -> (x, nonce_attempt)) maybe_attempt_result+ where+ recursive_result = findNonceForBucket (nonce_attempt + 1) values_and_size bucket+ maybe_attempt_result = sequenceA $ attemptNonceRecursive+ values_and_size+ nonce_attempt+ mempty+ bucket+++handleMultiBuckets :: (Foldable f, Hashing.ToNumeric a, Eq (f a), Hashable (f a)) =>+ HashMapAndSize (f a) b+ -> (Int, [f a])+ -> LookupTable b+ -> LookupTable b+handleMultiBuckets sized_words_dict (computed_hash, bucket) old_lookup_table =+ NewLookupTable new_g new_values+ where+ HashMapAndSize words_dict size = sized_words_dict++ sized_vals_dict = HashMapAndSize (vals old_lookup_table) size+ (slots, d) = findNonceForBucket 1 sized_vals_dict bucket++ new_g = HashMap.insert computed_hash d (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) $+ HashMap.lookupDefault (error "not found") bucket_val words_dict+++-- | 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 sized_words_dict sorted_bucket_hash_tuples =++ (lookup_table, remaining_words)+ where++ -- Since the buckets have been sorted by descending size,+ -- once we get to the bucket with 1 or fewer elements,+ -- 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++ 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 words_dict =+ 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++ bucket_hash_tuples = HashMap.toList $ binTuplesBySecond slot_key_pairs+++-- | 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 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)]+ -> Lookup.LookupTable b+createMinimalPerfectHash tuples =+ convertToVector $ NewLookupTable final_g final_values+ where+ words_dict = HashMap.fromList tuples+ size = HashMap.size words_dict++ sorted_bucket_hash_tuples = preliminaryBucketPlacement words_dict++ (intermediate_lookup_table, remaining_word_hash_tuples) = findCollisionNonces+ (HashMapAndSize words_dict size)+ sorted_bucket_hash_tuples++ unused_slots = filter (not . (`HashMap.member` vals intermediate_lookup_table)) [0..(size - 1)]++ zipped_remaining_with_unused_slots = zip remaining_word_hash_tuples unused_slots++ -- We subtract one to ensure it's negative even if the zeroeth slot was used.+ f1 ((computed_hash, _), free_slot_index) = HashMap.insert computed_hash $ Lookup.encodeDirectEntry free_slot_index+ final_g = foldr f1 (redirs intermediate_lookup_table) zipped_remaining_with_unused_slots++ f2 ((_, word), free_slot_index) = HashMap.insert free_slot_index $+ HashMap.lookupDefault (error "Impossible!") word words_dict++ final_values = foldr f2 (vals intermediate_lookup_table) zipped_remaining_with_unused_slots+++-- * Utilities++-- | Place the second 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+ where+ f tuple = HashMap.insertWith (++) (snd tuple) [fst tuple]+++-- | duplicates the argument into both members of the tuple+duple :: a -> (a, a)+duple = join (,)+++-- | Given a function and a value, create a pair+-- where the first element is the value, and the+-- second element is the function applied to the value+derivePair :: (a -> b) -> a -> (a, b)+derivePair g = fmap g . duple+++deriveTuples :: (a -> b) -> [a] -> [(a, b)]+deriveTuples = map . derivePair
+ src/Data/PerfectHash/Hashing.hs view
@@ -0,0 +1,50 @@+{-# OPTIONS_HADDOCK prune #-}++-- | Implements the specialized hash function for+-- this perfect hashing algorithm.+module Data.PerfectHash.Hashing where++import Data.Bits (xor, (.&.))+import Data.Char (ord)+++-- | 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 = 0x01000193+++-- | 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++-- | The numeric value of a character is simply its ordinal value.+instance ToNumeric Char where+ toNum = ord++instance ToNumeric Int where+ toNum = id+++-- | Uses the \"FNV-1a\" algorithm from the+-- <http://isthe.com/chongo/tech/comp/fnv/ FNV website>:+--+-- > hash = offset_basis+-- > for each octet_of_data to be hashed+-- > hash = hash xor octet_of_data+-- > hash = hash * FNV_prime+-- > return hash+--+-- 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 nonce =++ foldl combine d -- NOTE: This must be 'foldl', not 'foldr'+ where+ d = if nonce == 0+ then primeFNV+ else nonce++ combine acc = (.&. 0xffffffff) . (* primeFNV) . xor acc . toNum
+ src/Data/PerfectHash/Lookup.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_HADDOCK prune #-}++-- | Note that what is referred to as a \"nonce\" in this library may be+-- equivalently described as a \"salt\" by some.+module Data.PerfectHash.Lookup (+ LookupTable (LookupTable)+ , nonces+ , values+ , size+ , encodeDirectEntry+ , lookupPerfect+ ) where++import Data.Vector.Unboxed (Vector, (!))+import qualified Data.Vector.Unboxed as Vector++import qualified Data.PerfectHash.Hashing as Hashing+++-- | Inputs for the lookup function.+--+-- There are two arrays used in successive stages of the lookup.+-- In this implementation, both arrays are the same length.+data LookupTable a = LookupTable {+ nonces :: Vector Int+ -- ^ This is the intermediate lookup table.+ --+ -- In the lookup process, the key's hash is computed first with a nonce of+ -- zero to obtain an index into this array.+ --+ -- If the value at this index is negative, it is (after negating and+ -- subtracting one) a direct index into the 'values' array.+ -- 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.+ , 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.+ }+++size :: Vector.Unbox a => LookupTable a -> Int+size = Vector.length . values+++encodeDirectEntry = subtract 1 . negate+++-- | For embedded applications, this function would usually be re-implemented+-- in C code.+--+-- == Algorithm description+-- The lookup procedure is three steps:+--+-- 1. Compute the 'Hashing.hash' (with a nonce of zero) of the "key", modulo+-- the length of the 'values' array.+-- 2. Use the resulting value as an index into the 'nonces' array. The value+-- found there represents either a direct index into the 'values' array+-- or a nonce for a second round of hashing.+--+-- * If negative, it is the former. Negate it (to obtain a positive+-- value) and subtract one to obtain the actual index.+-- * Otherwise, re-compute the hash of the key, using this+-- value instead of zero as the nonce. Again, compute the modulus with+-- 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) =>+ LookupTable b+ -> f a+ -> b+lookupPerfect lookup_table key =++ values lookup_table ! v_key++ where+ table_size = size lookup_table++ nonce_index = Hashing.hash 0 key `mod` 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
+ test/Exercise.hs view
@@ -0,0 +1,58 @@+{-# 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) =>+ Lookup.LookupTable b+ -> [(f a, b)]+ -> Either String ()+testLookups lookup_table =+ traverse_ check_entry+ where+ check_entry (word, source_index) = unless (lookup_result == source_index) $+ Left $ unwords [+ "Result for key"+ , show word+ , "had incorrect index"+ , show lookup_result+ , "; should have been"+ , show source_index+ ]+ where+ lookup_result = Lookup.lookupPerfect lookup_table word+++-- | Generate a map of words from a file to their line numbers.+--+-- Intended for use with @\"/usr/share/dict/words\"@.+wordsFromFile :: FilePath -> IO [(String, Int)]+wordsFromFile path = do+ file_lines <- readFile path+ let word_index_tuples = zip (lines file_lines) [1..]+ return word_index_tuples+++eitherExit :: Either String b -> IO ()+eitherExit x = case x of+ Left err -> error err+ Right _ -> return ()
+ test/Test.hs view
@@ -0,0 +1,57 @@+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