Add benchmarks to operations in containers of hashmaps

benchmarks/Benchmarks.hs

@@ -10,8 +10,11 @@ import Data.Hashable (Hashable)
 import qualified Data.ByteString as BS
 import qualified "hashmap" Data.HashMap as IHM
 import qualified Data.HashMap.Strict as HM
+import qualified Data.HashSet as HS
 import qualified Data.IntMap as IM
 import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.Vector as V
 import Data.List (foldl')
 import Data.Maybe (fromMaybe)
 import GHC.Generics (Generic)
@@ -36,6 +39,8 @@ instance NFData B where
 data Env = Env {
     n :: !Int,
 
+    csz :: !Int, -- container size
+
     elems   :: ![(String, Int)],
     keys    :: ![String],
     elemsBS :: ![(BS.ByteString, Int)],
@@ -48,6 +53,11 @@ data Env = Env {
     keysBS'  :: ![BS.ByteString],
     keysI'   :: ![Int],
 
+    listOfHMs :: ![HM.HashMap Int Int],
+    vecOfHMs  :: !(V.Vector (HM.HashMap Int Int)),
+    hsetOfHMs :: !(HS.HashSet (HM.HashMap Int Int)),
+    setOfHMs  :: !(S.Set (HM.HashMap Int Int)),
+
     keysDup    :: ![String],
     keysDupBS  :: ![BS.ByteString],
     keysDupI   :: ![Int],
@@ -72,6 +82,20 @@ setupEnv :: IO Env
 setupEnv = do
     let n = 2^(12 :: Int)
 
+        -- When building a container of hashmaps, 'cn' will be the size of each.
+        cn = n `div` 16
+        -- 'csz' is the size of the container of hashmaps.
+        csz = 2^(7 :: Int)
+
+        values = [1..csz*cn]
+
+        chop _ [] = []
+        chop k l =
+            let (taken, left) = splitAt k l
+            in taken : chop k left
+
+        vals = chop cn values
+
         elems   = zip keys [1..n]
         keys    = US.rnd 8 n
         elemsBS = zip keysBS [1..n]
@@ -84,6 +108,11 @@ setupEnv = do
         keysBS'  = UBS.rnd' 8 n
         keysI'   = UI.rnd' (n+n) n
 
+        listOfHMs = zipWith (\x y -> HM.fromList (zip x y)) (repeat keysI) vals
+        vecOfHMs  = V.fromList listOfHMs
+        hsetOfHMs = HS.fromList listOfHMs
+        setOfHMs  = S.fromList listOfHMs
+
         keysDup    = US.rnd 2 n
         keysDupBS  = UBS.rnd 2 n
         keysDupI   = UI.rnd (n`div`4) n
@@ -228,6 +257,39 @@ main = do
             , bench "Int" $ whnf (delete keysI') hmi
             ]
 
+          , bgroup "containerized"
+            [ bgroup "lookup"
+              [ bench "List" $ nf (lookupC keysI) listOfHMs
+              , bench "Vector" $ nf (lookupC keysI) vecOfHMs
+              , bench "HashSet" $ nf (lookupHS keysI) hsetOfHMs
+              , bench "Set" $ nf (lookupS keysI) setOfHMs
+              ]
+            , bgroup "insert"
+              [ bench "List" $ nf (insertC elemsI) listOfHMs
+              , bench "Vector" $ nf (insertC elemsI) vecOfHMs
+              , bench "HashSet" $ nf (insertHS elemsI) hsetOfHMs
+              , bench "Set" $ nf (insertS elemsI) setOfHMs
+              ]
+            , bgroup "delete"
+              [ bench "List" $ nf (deleteC keysI) listOfHMs
+              , bench "Vector" $ nf (deleteC keysI) vecOfHMs
+              , bench "HashSet" $ nf (deleteHS keysI) hsetOfHMs
+              , bench "Set" $ nf (deleteS keysI) setOfHMs
+              ]
+            , bgroup "union"
+              [ bench "List" $ whnf unionC listOfHMs
+              , bench "Vector" $ whnf unionC vecOfHMs
+              , bench "HashSet" $ whnf unionC hsetOfHMs
+              , bench "Set" $ whnf unionC setOfHMs
+              ]
+            , bgroup "containerized map"
+              [ bench "List" $ nf (mapC (\ v -> v + 1)) listOfHMs
+              , bench "Vector" $ nf (mapC (\ v -> v + 1)) vecOfHMs
+              , bench "HashSet" $ nf (mapHS (\ v -> v + 1)) hsetOfHMs
+              , bench "Set" $ nf (mapS (\ v -> v + 1)) setOfHMs
+              ]
+            ]
+
             -- Combine
           , bench "union" $ whnf (HM.union hmi) hmi2
 
@@ -292,6 +354,18 @@ lookup xs m = foldl' (\z k -> fromMaybe z (HM.lookup k m)) 0 xs
 {-# SPECIALIZE lookup :: [BS.ByteString] -> HM.HashMap BS.ByteString Int
                       -> Int #-}
 
+lookupC :: (Eq k, Hashable k, Traversable f) => [k] -> f (HM.HashMap k Int) -> f Int
+lookupC = fmap . lookup
+{-# SPECIALIZE lookupC :: [Int] -> [HM.HashMap Int Int] -> [Int] #-}
+{-# SPECIALIZE lookupC :: [Int] -> V.Vector (HM.HashMap Int Int)
+                       -> V.Vector Int #-}
+
+lookupHS :: [Int] -> HS.HashSet (HM.HashMap Int Int) -> HS.HashSet Int
+lookupHS = HS.map . lookup
+
+lookupS :: [Int] -> S.Set (HM.HashMap Int Int) -> S.Set Int
+lookupS = S.map . lookup
+
 insert :: (Eq k, Hashable k) => [(k, Int)] -> HM.HashMap k Int
        -> HM.HashMap k Int
 insert xs m0 = foldl' (\m (k, v) -> HM.insert k v m) m0 xs
@@ -302,6 +376,21 @@ insert xs m0 = foldl' (\m (k, v) -> HM.insert k v m) m0 xs
 {-# SPECIALIZE insert :: [(BS.ByteString, Int)] -> HM.HashMap BS.ByteString Int
                       -> HM.HashMap BS.ByteString Int #-}
 
+insertC :: (Eq k, Hashable k, Traversable f) => [(k, Int)] -> f (HM.HashMap k Int)
+        -> f (HM.HashMap k Int)
+insertC l = fmap (insert l)
+{-# SPECIALIZE insertC :: [(Int, Int)] -> [HM.HashMap Int Int]
+                       -> [HM.HashMap Int Int] #-}
+{-# SPECIALIZE insertC :: [(Int, Int)] -> V.Vector (HM.HashMap Int Int)
+                       -> V.Vector (HM.HashMap Int Int) #-}
+
+insertHS :: [(Int, Int)] -> HS.HashSet (HM.HashMap Int Int)
+         -> HS.HashSet (HM.HashMap Int Int)
+insertHS l = HS.map (insert l)
+
+insertS :: [(Int, Int)] -> S.Set (HM.HashMap Int Int) -> S.Set (HM.HashMap Int Int)
+insertS l = S.map (insert l)
+
 delete :: (Eq k, Hashable k) => [k] -> HM.HashMap k Int -> HM.HashMap k Int
 delete xs m0 = foldl' (\m k -> HM.delete k m) m0 xs
 {-# SPECIALIZE delete :: [Int] -> HM.HashMap Int Int -> HM.HashMap Int Int #-}
@@ -310,6 +399,44 @@ delete xs m0 = foldl' (\m k -> HM.delete k m) m0 xs
 {-# SPECIALIZE delete :: [BS.ByteString] -> HM.HashMap BS.ByteString Int
                       -> HM.HashMap BS.ByteString Int #-}
 
+deleteC :: (Eq k, Hashable k, Functor f) => [k] -> f (HM.HashMap k Int)
+        -> f (HM.HashMap k Int)
+deleteC = fmap . delete
+{-# SPECIALIZE deleteC :: [Int] -> [HM.HashMap Int Int]
+                       -> [HM.HashMap Int Int] #-}
+{-# SPECIALIZE deleteC :: [Int] -> V.Vector (HM.HashMap Int Int)
+                       -> V.Vector (HM.HashMap Int Int) #-}
+
+deleteHS :: [Int] -> HS.HashSet (HM.HashMap Int Int)
+         -> HS.HashSet (HM.HashMap Int Int)
+deleteHS = HS.map . delete
+
+deleteS :: [Int] -> S.Set (HM.HashMap Int Int) -> S.Set (HM.HashMap Int Int)
+deleteS = S.map . delete
+
+unionC :: (Eq k, Hashable k, Foldable f) => f (HM.HashMap k Int)
+       -> HM.HashMap k Int
+unionC = foldl' HM.union mempty
+{-# SPECIALIZE unionC :: [HM.HashMap Int Int] -> HM.HashMap Int Int #-}
+{-# SPECIALIZE unionC :: V.Vector (HM.HashMap Int Int) -> HM.HashMap Int Int #-}
+{-# SPECIALIZE unionC :: HS.HashSet (HM.HashMap Int Int) -> HM.HashMap Int Int #-}
+{-# SPECIALIZE unionC :: S.Set (HM.HashMap Int Int) -> HM.HashMap Int Int #-}
+
+mapC :: (Eq k, Hashable k, Functor f) => (Int -> Int) -> f (HM.HashMap k Int)
+       -> f (HM.HashMap k Int)
+mapC f = fmap (HM.map f)
+{-# SPECIALIZE mapC :: (Int -> Int) -> [HM.HashMap Int Int]
+                    -> [HM.HashMap Int Int] #-}
+{-# SPECIALIZE mapC :: (Int -> Int) -> V.Vector (HM.HashMap Int Int)
+                    -> V.Vector (HM.HashMap Int Int) #-}
+
+mapHS :: (Int -> Int) -> HS.HashSet (HM.HashMap Int Int)
+      -> HS.HashSet (HM.HashMap Int Int)
+mapHS f = HS.map (HM.map f)
+
+mapS :: (Int -> Int) -> S.Set (HM.HashMap Int Int) -> S.Set (HM.HashMap Int Int)
+mapS f = S.map (HM.map f)
+
 ------------------------------------------------------------------------
 -- * Map
 

benchmarks/unordered-containers-benchmarks.cabal

@@ -24,6 +24,7 @@ executable unordered-containers-benchmarks
     base,
     bytestring,
     containers,
+    vector,
     criterion,
     deepseq,
     deepseq-generics,

unordered-containers.cabal

@@ -179,6 +179,7 @@ benchmark benchmarks
     base,
     bytestring,
     containers,
+    vector,
     criterion >= 1.0 && < 1.3,
     deepseq >= 1.1,
     deepseq-generics,