diff --git a/Data/PerfectHash.hs b/Data/PerfectHash.hs new file mode 100644 --- /dev/null +++ b/Data/PerfectHash.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Data.PerfectHash ( PerfectHash, fromList, lookup) where + +import Control.Monad (guard) +import Data.Array +import Data.Array.IO (IOArray, newArray_, writeArray) +import Data.Array.Unsafe (unsafeFreeze) +import qualified Data.ByteString.Char8 as S +import Data.CMPH (CMPH) +import qualified Data.CMPH as CMPH +import Data.Word +import Prelude hiding (lookup) +import System.IO.Unsafe (unsafePerformIO) + +data PerfectHash a = + PerfectHash + { computedHash :: !CMPH + , store :: !(Array Word64 a) + } + +fromList :: [(S.ByteString, a)] -> Maybe (PerfectHash a) +fromList ls = unsafePerformIO $ do + cmph' <- CMPH.fromList (map fst ls) + case cmph' of + Nothing -> return Nothing + Just cmph -> Just <$> do + (arr :: IOArray Word64 a) <- (newArray_ (0, fromIntegral (CMPH.size cmph - 1) )) + (`mapM_` ls) $ \(bs,val) -> do + h <- CMPH.hash cmph bs + writeArray arr h val + u <- unsafeFreeze arr + return $ PerfectHash cmph u + +-- | this is a maybe, because we can't guarantee that +-- the provided string is one of the things that we originally hashed +-- with. We don't try to verify that it matched, because we don't want +-- to store the original string: if you try a string we've never +-- seen, you might get Nothing and you might get a random value. +lookup :: S.ByteString -> PerfectHash a -> Maybe a +lookup !bs !ph = guard check >> return e + where index = {-# SCC "hash_only" #-} unsafePerformIO $ CMPH.hash (computedHash ph) bs + (!low, !high) = bounds arr + !arr = store ph + !e = {-# SCC array_lookup #-} arr ! index + !check = {-# SCC "check" #-} low <= index && high >= index diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2009 Mark Wotton +(Microbench copyright Evan Martin ) + +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 the name of the author nor the names of contributors may be + used to endorse or promote products derived from this software without + specific prior written permission. + +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 OWNER +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. + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,19 @@ +This is an immutable hashtable built on cmph. + +The motivation is mostly speed, and wren thornton's bytestring-trie seems to be the main competition: + +% ./dist/build/benchmark_trie/benchmark_trie +* trie lookup: 1.136ns per iteration / 880403.98 per second. + +% ./dist/build/benchmark/benchmark +* perfect lookup: 0.687ns per iteration / 1456455.69 per second. + +it also uses less space in the haskell heap, building once and doing the same number of lookups: + +PerfectHash: + total alloc = 2,525,223,964 bytes (excludes profiling overheads) + +Trie: + total alloc = 9,806,202,096 bytes (excludes profiling overheads) + +although this is not an entirely fair comparison given how much PerfectHash stores on the C side. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,2 @@ +- some sensible way of changing the hashing algorithm +- finalisers for C memory allocation - it probably leaks like crazy right now. diff --git a/benchmark/Main.hs b/benchmark/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark/Main.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +import Control.DeepSeq +import Control.Exception (bracket_, evaluate) +import Control.Monad (forM) +import Criterion.Main +import Data.Array.IO (IOArray, newListArray, readArray, + writeArray) +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.HashMap.Strict as HashMap +import qualified Data.List as DL +import qualified Data.Map as Map +import qualified Data.PerfectHash as PH +import GHC.Profiling + +import System.Random + +-- | Randomly shuffle a list +-- /O(N)/ +shuffle :: [a] -> IO [a] +shuffle xs = do + ar <- newArray n xs + forM [1..n] $ \i -> do + j <- randomRIO (i,n) + vi <- readArray ar i + vj <- readArray ar j + writeArray ar j vi + return vj + where + n = length xs + newArray :: Int -> [a] -> IO (IOArray Int a) + newArray n xs = newListArray (1,n) xs + +main = do + stopProfTimer + ws <- BS8.lines <$> BS8.readFile "/usr/share/dict/words" + let al = zip ws ([1..] :: [Int]) + m = Map.fromList al + hs = HashMap.fromList al + -- let us assume that the dictionary contains no embedded nulls. + Just ph = PH.fromList al + randomised <- evaluate . force =<< shuffle (concat $ replicate 3 ws) + evaluate $ force m + evaluate $ force hs + evaluate $ force hs + defaultMain [ + bgroup "fib" [ bench "Data.Map" $ nf (map (`Map.lookup` m)) randomised + , bench "Data.PerfectHash" $ nf (map (`PH.lookup` ph)) randomised + -- bracket_ startProfTimer stopProfTimer + + , bench "Data.HashMap" $ nf (map (`HashMap.lookup` hs)) randomised +-- , bench "Data.List" $ whnf (`DL.lookup` al) "exorbitant" + ] + ] diff --git a/perfecthash.cabal b/perfecthash.cabal new file mode 100644 --- /dev/null +++ b/perfecthash.cabal @@ -0,0 +1,62 @@ +Name: perfecthash +Version: 0.2.0 +Cabal-Version: >= 1.10 +License: BSD3 +License-File: LICENSE +Build-Type: Simple +Author: Mark Wotton +Maintainer: Mark Wotton +Category: Data, Data Structures +Stability: Experimental +extra-source-files: README, TODO +bug-reports: mailto:mwotton@gmail.com +Synopsis: A perfect hashing library for mapping bytestrings to values. +Description: A perfect hashing library for mapping bytestrings to values. + Insertion is not supported (by design): Only fromList + and lookup operations are supported. + + CI at https://travis-ci.org/mwotton/PerfectHash +Library + default-language: Haskell2010 + Exposed-Modules: Data.PerfectHash + ghc-options: -funbox-strict-fields -O2 + ghc-prof-options: -fprof-auto +-- extra-libraries: cmph + build-depends: base >=4.5 && <5.2, + containers, + cmph, + bytestring, + array, + time + + +test-suite cmph-test + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + other-modules: Data.PerfectHashSpec + build-depends: cmph + , base + , hspec + , QuickCheck + , perfecthash + , bytestring + , containers + +Benchmark bench-foo + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: benchmark + build-depends: base + , array + , bytestring + , criterion + , containers + , random + , perfecthash + , unordered-containers + , deepseq +source-repository head + type: git + location: http://github.com/mwotton/PerfectHash.git diff --git a/test/Data/PerfectHashSpec.hs b/test/Data/PerfectHashSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/PerfectHashSpec.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE IncoherentInstances #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Data.PerfectHashSpec where + +import qualified Data.ByteString.Char8 as S +import qualified Data.List as List +import qualified Data.Map as Map +import Data.Maybe +import qualified Data.PerfectHash as PerfectHash +import Debug.Trace +import Test.Hspec +import Test.QuickCheck + + +newtype Blub = Blub ([S.ByteString],[S.ByteString]) + deriving (Show, Read) + +newtype Bar = Bar [S.ByteString] + deriving (Show, Read) + +main = hspec spec + +spec = describe "PerfectHash" $ do + + it "Successfully looks up valid keys" $ do + ws <- take 10000 . S.lines <$> S.readFile "/usr/share/dict/words" + let al = zip ws ws + Just hash = PerfectHash.fromList al + datamap = Map.fromList al + (`mapM_` ws) $ \w -> + PerfectHash.lookup w hash `shouldBe` Map.lookup w datamap + + it "doesn't crash on invalid keys" $ do + ws <- take 10000 . S.lines <$> S.readFile "/usr/share/dict/words" + let al = zip ws ws + Just hash = PerfectHash.fromList al + PerfectHash.lookup "plerfle" hash `shouldSatisfy` + (\x -> isJust x || isNothing x) + + +halves :: [a] -> ([a], [a]) +halves ls = List.splitAt ((length ls) `div` 2) ls diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}