PerfectHash (empty) → 0.1

raw patch · 12 files changed

+440/−0 lines, 12 filesdep +HUnitdep +QuickCheckdep +arraysetup-changed

Dependencies added: HUnit, QuickCheck, array, base, bytestring, bytestring-trie, containers, digest, haskell98, time

Files

• Data/PerfectHash.lhs +91/−0
• HackedMicrobench.hs +105/−0
• LICENSE +29/−0
• PerfectHash.cabal +52/−0
• README +20/−0
• Setup.hs +4/−0
• TODO +2/−0
• benchmark.hs +22/−0
• benchmark_trie.hs +24/−0
• stub.c +34/−0
• stub.h +8/−0
• t/00_correctness.hs +49/−0

@@ -0,0 +1,91 @@+> {-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, EmptyDataDecls, BangPatterns #-}+> module Data.PerfectHash ( PerfectHash, fromList, lookup, lookupByIndex ) where++> import Array+> import Data.Array.IO+> import Foreign+> import Foreign.C.String+> import Foreign.C.Types+> import Foreign.Marshal.Array+> import Prelude hiding (lookup)+> import System.IO.Unsafe+> import qualified Data.ByteString.Char8 as S+> import qualified Data.ByteString.Unsafe as Unsafe+> import Data.Array.Storable+> import Data.Digest.CRC32 (crc32)+> import Data.Digest.Adler32 (adler32)+> import Control.Monad(guard)+ +Arguably the FFI stuff should be in a separate file, but let's keep it simple for the moment.++> foreign import ccall unsafe "cmph.h cmph_search" c_cmph_search :: Ptr ForeignHash -> CString -> CInt -> CULong+> foreign import ccall unsafe "stub.h build_hash" c_build_hash   :: Ptr CString -> CInt -> IO (Ptr ForeignHash)+> foreign import ccall unsafe "string.h strdup" c_strdup         :: CString -> IO CString+> foreign import ccall unsafe "string.h strncmp" c_strncmp         :: CString -> CString -> CInt -> IO CInt++standard idiom for an opaque type++> data ForeignHash++> data PerfectHash a = PerfectHash { store     :: !(Array.Array Word32 (a,CString)),+>                                    hashFunc  :: !(S.ByteString -> Word32) }++pretty certain this could be improved++> use_hash a str = {-# SCC "use_hash" #-}  unsafePerformIO $ Unsafe.unsafeUseAsCStringLen str+>                  (\(cstr,i) -> return (fromIntegral $ c_cmph_search a cstr (fromIntegral i)))++> raw_hashfunc hash cstr len = fromIntegral $ c_cmph_search hash cstr len++This could do with being broken up a little, probably++> fromList :: Show a => [(S.ByteString, a)] -> PerfectHash a+> fromList ls = unsafePerformIO $ do+>                   let len = length ls+>                   arr <- newArray_ (0, len-1)+>                   -- we make one pass over ls, then throw it away+>                   cstr_ptrs <- mapM (\(i,(bs, val)) ->+>                          S.useAsCStringLen bs $ \(cstr,len) -> do+>                            newPtr <- c_strdup cstr+>                            writeArray arr i newPtr+>                            return (newPtr,fromIntegral len,val))+>                         (zip [0..] ls)+>                   cmph <- withStorableArray arr $ \ptr -> c_build_hash ptr (fromIntegral len)+>                   let bounds :: (Word32, Word32) = (fromIntegral 0, fromIntegral len - 1)+>                   arr <- newArray_ bounds :: IO (IOArray Word32 a)+>                   checksums <- newArray_ bounds :: IO (IOArray Word32 Word32)+>                   let hashFunc = use_hash cmph+>                   mapM_ (\(cstr,len,val) -> do+>                          let index = raw_hashfunc cmph cstr len+>                          writeArray arr index (val,cstr)) $ cstr_ptrs+>                   i_arr <- freeze arr+>                   return PerfectHash { store = i_arr, +>                                        hashFunc = use_hash cmph }++>                 ++-- > crc = crc32++-- > crc = adler32++> lookup :: PerfectHash a -> S.ByteString -> Maybe a+> lookup !hash !bs+>     | check     = Just e+>     | otherwise = Nothing+>     where index = {-# SCC "hash_only" #-} hashFunc hash bs+>           (!low, !high) = Array.bounds arr+>           !arr = store hash+>           (e, str) = arr ! index+>           !check = {-# SCC "check" #-} low <= index && high >= index && +>                   {-# SCC "bs_check" #-} unsafePerformIO $ Unsafe.unsafeUseAsCStringLen bs (\(cstr,len) -> +>                                               c_strncmp str cstr (fromIntegral len) >>= \res -> return (res == 0))++sometimes it's convenient to have direct access, but this should probably be seen as a+slightly devious use case.++> lookupByIndex :: PerfectHash a -> Word32 -> Maybe S.ByteString+> lookupByIndex hash index = do+>                guard $ low <= index && high >= index+>                return $ unsafePerformIO $ S.packCString $ snd $  arr ! index+>   where (!low, !high) = bounds arr+>         arr = store hash

@@ -0,0 +1,105 @@+{-# LANGUAGE OverlappingInstances, FlexibleInstances #-}+-- microbench, a tiny microbenchmarking library for Haskell.+-- Copyright (C) 2008 Evan Martin <martine@danga.com>+--   hacked ever so slightly by mwotton@gmail.com in the interests+--   of not spinning forever on very fast operations++-- |Microbenchmarking can be used to compare the speed of different+-- approaches to the same operation.  Since most code is very fast, to+-- get accurate timing information you must run the operation many times+-- and then divide to get the time per operation.+--+-- This library manages the microbenchmarking process: it finds how many+-- iterations of a function are needed to get a good timing estimate per+-- iteration and prints out a human-readable \"Your code takes /n/+-- nanoseconds to run, and can run /n/ times per second\".+--+-- The only function 'microbench' takes a function that expects an+-- integer parameter (which is the quantity you're trying to measure),+-- and probes the function with increasing parameters until enough time+-- has elapsed to get a good measurement.+--+-- This may be better understood by some example code:+--+-- > sum1 n = sum [1..n]+-- > sum2 n = foldl (+) 0 [1..n]+-- > main = do+-- >   microbench "Sum using sum" sum1+-- >   microbench "Sum using foldl" sum2+--+-- When run, @sum1@ and @sum2@ are called with varying values of @n@.+-- The output, then, is an estimate of how many integers these+-- approaches could sum per second.+--+-- 'microbench' also accepts a parameter of type @IO ()@ for+-- benchmarking.  It does the same probing process, but manages running+-- the operation in a loop.+module HackedMicrobench (+  microbench,+  Microbenchable+) where++import Control.Exception+import Debug.Trace+import Data.IORef+import Data.List+import Data.Time.Clock+import Data.Typeable+import Control.Concurrent+import System.IO+import Numeric++-- Want to handle:+--   Int -> a    => ok+--   Int -> IO a => ok+--   IO ()       => loop the action+-- TODO:+--   IO a  => loop the action, forcing each result?+--   a     => is it possible? I tried for a while but couldn't make it work.+--+-- TODO 2:+--   factor out "setup time" by comparing different outputs for different inputs+--   and a linear model.++-- |Microbenchmarkable computations.  Be very wary of adding your own+-- instances of this class, as it's difficult to force GHC to+-- re-evaluate code in a way that makes benchmarking easy.+class Microbenchable a where+  run :: a -> Integer -> IO ()++instance Microbenchable (Integer -> IO ()) where+  run f n = f n+instance Microbenchable (Integer -> a) where+  run f n = do x <- evaluate (f n); return ()+instance Microbenchable (IO ()) where+  run f n = mapM_ (const f) [1..n]++-- This was chosen totally arbitrarily.  Perhaps it would be better to make it+-- a parameter, or use some sort of real statistical test.+microbenchTime = 5.0++-- |@microbench description target@ probes target with different parameters+-- until it's ran enough iterations to have a good estimate at the rate per+-- second of the operation.  @description@ is a textual description of the+-- thing being benchmarked.  Outputs to stdout.+microbench :: Microbenchable a => String -> a -> IO ()+microbench desc f = do+  hSetBuffering stdout NoBuffering+  putStr $ "* " ++ desc ++ ": "+  start <- getCurrentTime+  time <- probe 1+  putStrLn ""+  putStrLn $ "  " ++ showFFloat (Just 3) (time*1000*1000) "ns per iteration / "+                  ++ showGFloat (Just 2) (1 / time) " per second."+  where+  probe repeats = do+    -- putStr "."+    start <- getCurrentTime+    run f repeats+    end <- getCurrentTime+    let delta = end `diffUTCTime` start+    -- print (delta, repeats)+    if delta > microbenchTime+      then do return (realToFrac delta / realToFrac repeats)+      else probe (repeats * 2)+

@@ -0,0 +1,29 @@+Copyright (c) 2009 Mark Wotton <mwotton@gmail.com>+(Microbench copyright Evan Martin <martine@danga.com>)++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.+

@@ -0,0 +1,52 @@+Name:           PerfectHash+Version:        0.1+Cabal-Version:  >= 1.2+License:	BSD3+License-File:   LICENSE+Build-Type:     Simple+Author:		Mark Wotton <mwotton@gmail.com>+Maintainer:	Mark Wotton <mwotton@gmail.com>+Category:	Data, Data Structures+Stability:	Experimental+extra-source-files: stub.h, 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): this is just a binding+		to the C-based CMPH library (http://cmph.sf.net). Only fromList+		and lookup operations are supported, but in many circumstances+		this is all that's required.+Library+        Exposed-Modules: Data.PerfectHash, HackedMicrobench+        ghc-options:    -auto-all -funbox-strict-fields -fvia-C -optc-O2 +        c-sources: stub.c+        includes: stub.h+        extra-lib-dirs: /usr/local/lib/+        extra-libraries: cmph+        build-depends:  base, haskell98, containers, bytestring, digest,array, time++Executable benchmark+        Executable:     benchmark+        Main-Is:        benchmark.hs+        extra-lib-dirs: /usr/local/lib/+        extra-libraries: cmph+        c-sources: stub.c+        includes: stub.h++Executable benchmark_trie+        Executable:     benchmark_trie+        Main-Is:        benchmark_trie.hs+        extra-lib-dirs: /usr/local/lib/+        extra-libraries: cmph+        c-sources: stub.c+        includes: stub.h+        build-depends: bytestring-trie++Executable test+        Executable:     test+        Main-Is:        t/00_correctness.hs+        extra-lib-dirs: /usr/local/lib/+        extra-libraries: cmph+        c-sources: stub.c+        includes: stub.h+        build-depends:  QuickCheck, HUnit

@@ -0,0 +1,20 @@+This is a thin haskell wrapper around the CMPH library, obtainable at http://cmph.sf.net.+I assume you have it installed in /usr/local/lib.++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.

@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,2 @@+- some sensible way of changing the hashing algorithm+- finalisers for C memory allocation - it probably leaks like crazy right now.

@@ -0,0 +1,22 @@++{-# LANGUAGE ScopedTypeVariables #-}++import Random+import HackedMicrobench -- small bugfix - use Integer rather than Int. original author unavailable for reports+import Control.Exception+import Data.List as List+import Data.PerfectHash as PerfectHash+import Maybe+import qualified Data.ByteString.Char8 as S+++perfect_lookup :: PerfectHash Integer -> [S.ByteString] -> Integer -> Integer+perfect_lookup m words size = sum $ mapMaybe (PerfectHash.lookup m) targets+ where targets :: [S.ByteString] = genericTake size $ cycle words++main = do+ str <- S.readFile "/usr/share/dict/words"+ words <- evaluate $ S.lines str+ source :: [(S.ByteString, Integer)] <- evaluate $ zip words [1..]+ perfect <- evaluate $ PerfectHash.fromList source+ {-# SCC "mb_lookup" #-} microbench "perfect lookup" (perfect_lookup   perfect words)

@@ -0,0 +1,24 @@++{-# LANGUAGE ScopedTypeVariables #-}++import Random+import HackedMicrobench -- small bugfix - use Integer rather than Int. original author unavailable for reports+import Control.Exception+import Data.List as List+import Data.Trie as Trie+import Maybe+import qualified Data.ByteString.Char8 as S+++trie_lookup :: Trie.Trie Integer -> [S.ByteString] -> Integer -> Integer+trie_lookup m words size = sum $ mapMaybe (tl m) targets+ where targets :: [S.ByteString] = genericTake size $ cycle words++tl string trie = {-# SCC "trie" #-} Trie.lookup trie string++main = do+ str <- S.readFile "/usr/share/dict/words"+ words <- evaluate $ S.lines str+ source :: [(S.ByteString, Integer)] <- evaluate $ zip words [1..]+ trie <- evaluate $ Trie.fromList source+ {-# SCC "mb_lookup" #-} microbench "trie lookup" (trie_lookup   trie words)

@@ -0,0 +1,34 @@+#include "stub.h"+#include <stdio.h>+#include <string.h>+#include <cmph.h>++// #define __MONKEY_DEBUG__++void monkey_debug(char ** vector, int nkeys) {+  int i = 0;+  int blah=0;+  for(i=0; i< nkeys; i++) {+    fprintf(stderr, "read:%5d: %s\n", i, vector[i]);    +  }+}++cmph_t * build_hash(char ** vector, int nkeys) {+#ifdef __MONKEY_DEBUG__+  monkey_debug(vector, nkeys);+#endif+  //  fprintf(stderr, "building hash with %d keys, first is %s, last is %s\n", nkeys, *vector, vector[nkeys-1]);+  cmph_io_adapter_t *source = cmph_io_vector_adapter(vector, nkeys);+  //fprintf(stderr, "building adapter is %p\n", source);+  cmph_config_t *config = cmph_config_new(source);+  //  fprintf(stderr, "building config is %p\n", config);+  cmph_config_set_algo(config, CMPH_BDZ);+  cmph_t *hash = cmph_new(config);+    // cmph_config_destroy(config);+  //  fprintf(stderr, "building hash is %p\n", hash);+  // monkey_debug(vector, nkeys);+  if(!hash) { fprintf(stderr, "Dying horribly, hash is null"); exit(1); } +  return hash;+}+    +

@@ -0,0 +1,8 @@+#ifndef __HASH_STUB_H__+#define __HASH_STUB_H__++#include <cmph.h>++unsigned long stub_hash(cmph_t* hash, char * word);+cmph_t * build_hash(char ** vector, int nkeys);+#endif

@@ -0,0 +1,49 @@+{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, IncoherentInstances, OverlappingInstances  #-}++import qualified Data.ByteString.Char8 as S+import qualified Data.Map as Map+import qualified Data.PerfectHash as PerfectHash+import Debug.Trace+import Test.HUnit+import List +import Maybe+import Test.QuickCheck+++newtype Blub = Blub ([S.ByteString],[S.ByteString])+    deriving (Show, Read)++newtype Bar = Bar [S.ByteString]+    deriving (Show, Read)+++-- would be nice to have a reasonable way of generating random strings, then i could +-- move this to quickcheck and get rid of the dependence on /usr/share/dict/words++halves :: [a] -> ([a], [a])+halves ls = List.splitAt ((length ls) `div` 2) ls++big_test ws = TestList [TestLabel "Successful lookup"          $ TestList successTests, +                        TestLabel "Faithful report of absence" $ TestList absenceTests]+  where hash    = PerfectHash.fromList al+        datamap = Map.fromList al+        al = zip source [0..]+        (source, orphans) =  halves $ sortedNub ws+        absenceTests = map (\w -> TestCase $+                                  assertEqual "shouldn't find it"+                                                  (PerfectHash.lookup hash w)+                                                  Nothing+                           ) orphans+        successTests = map (\w -> TestCase $+                                  assertEqual "should find it: same result as Data.Map"+                                                  (Map.lookup w datamap )+                                                  (PerfectHash.lookup hash w)++                           ) source+        +sortedNub xs = map head $ group $ sort xs++main = do+  l <- S.readFile "/usr/share/dict/words";+  runTestTT (big_test $ take 10000 $ S.lines l)+