Skip to content

Commit

Permalink
Add benchmarks to hashmap operations inside containers
Browse files Browse the repository at this point in the history 
    * because 'HashMap' is now a wrapper and may/may not get unboxed
      during a program's execution, benchmarks to operations on sets of
      hashmaps inside different kinds of containers were added;
  • Loading branch information
@rockbmb
rockbmb committed Oct 18, 2022
1 parent 3b3820e commit a98d0b6
Show file tree
Hide file tree
Showing 2 changed files with 172 additions and 4 deletions.
175 changes: 171 additions & 4 deletions benchmarks/Benchmarks.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,16 @@ import Test.Tasty.Bench (bench, bgroup, defaultMain, env, nf, whnf)
import qualified Data.ByteString as BS
import qualified "hashmap" Data.HashMap as IHM
import qualified Data.HashMap.Strict as HM
import qualified "unordered-containers" Data.HashSet as HS
import qualified Data.IntMap as IM
import Data.List (foldl')
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import qualified Data.Set as S
import qualified Data.Vector as V
import GHC.Generics (Generic)
import Prelude hiding (lookup)

import qualified Util.ByteString as UBS
import qualified Util.Int as UI
import qualified Util.String as US
Expand All @@ -37,6 +45,8 @@ instance NFData B where
data Env = Env {
n :: !Int,

csz :: !Int, -- container size

elems :: ![(String, Int)],
keys :: ![String],
elemsBS :: ![(BS.ByteString, Int)],
Expand All @@ -49,6 +59,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],
Expand Down Expand Up @@ -79,6 +94,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]
Expand All @@ -91,6 +120,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
Expand Down Expand Up @@ -128,8 +162,8 @@ main = do
[
#ifdef BENCH_containers_Map
env setupEnv $ \ ~(Env{..}) ->
-- * Comparison to other data structures
-- ** Map
-- Comparison to other data structures
-- Map
bgroup "Map"
[ bgroup "lookup"
[ bench "String" $ whnf (lookupM keys) m
Expand Down Expand Up @@ -231,7 +265,7 @@ main = do

env setupEnv $ \ ~(Env{..}) ->
bgroup "HashMap"
[ -- * Basic interface
[ -- Basic interface
bgroup "lookup"
[ bench "String" $ whnf (lookup keys) hm
, bench "ByteString" $ whnf (lookup keysBS) hmbs
Expand Down Expand Up @@ -313,6 +347,51 @@ main = do
, bench "Int" $ whnf (isSubmapOfNaive hmiSubset) 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 "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
]
, bgroup "intersection"
[ bench "List" $ whnf intersectionC listOfHMs
, bench "Vector" $ whnf intersectionC vecOfHMs
, bench "HashSet" $ whnf intersectionC hsetOfHMs
, bench "Set" $ whnf intersectionC setOfHMs
]
, bgroup "size"
[ bench "List" $ nf sizeC listOfHMs
, bench "Vector" $ nf sizeC vecOfHMs
, bench "HashSet" $ nf sizeHS hsetOfHMs
, bench "Set" $ nf sizeS setOfHMs
]
]

-- Combine
, bgroup "union"
[ bench "Int" $ whnf (HM.union hmi) hmi2
Expand All @@ -327,7 +406,7 @@ main = do
-- Transformations
, bench "map" $ whnf (HM.map (\ v -> v + 1)) hmi

-- * Difference and intersection
-- Difference and intersection
, bench "difference" $ whnf (HM.difference hmi) hmi2

-- Folds
Expand Down Expand Up @@ -389,6 +468,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
Expand All @@ -399,6 +490,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 #-}
Expand All @@ -407,6 +513,21 @@ 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

alterInsert :: (Eq k, Hashable k) => [(k, Int)] -> HM.HashMap k Int
-> HM.HashMap k Int
alterInsert xs m0 =
Expand Down Expand Up @@ -451,6 +572,52 @@ alterFDelete xs m0 =
{-# SPECIALIZE alterFDelete :: [BS.ByteString] -> HM.HashMap BS.ByteString Int
-> HM.HashMap BS.ByteString Int #-}

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)

intersectionC :: (Eq k, Hashable k, Foldable f) => f (HM.HashMap k Int)
-> HM.HashMap k Int
intersectionC = foldl' HM.intersection mempty
{-# SPECIALIZE intersectionC :: [HM.HashMap Int Int]
-> HM.HashMap Int Int #-}
{-# SPECIALIZE intersectionC :: V.Vector (HM.HashMap Int Int)
-> HM.HashMap Int Int #-}
{-# SPECIALIZE intersectionC :: HS.HashSet (HM.HashMap Int Int)
-> HM.HashMap Int Int #-}
{-# SPECIALIZE intersectionC :: S.Set (HM.HashMap Int Int)
-> HM.HashMap Int Int #-}

sizeC :: (Eq k, Hashable k, Functor f) => f (HM.HashMap k Int) -> f Int
sizeC = fmap HM.size
{-# SPECIALIZE sizeC :: [HM.HashMap Int Int] -> [Int] #-}
{-# SPECIALIZE sizeC :: V.Vector (HM.HashMap Int Int) -> V.Vector Int #-}

sizeHS :: HS.HashSet (HM.HashMap Int Int) -> HS.HashSet Int
sizeHS = HS.map HM.size

sizeS :: S.Set (HM.HashMap Int Int) -> S.Set Int
sizeS = S.map HM.size

isSubmapOfNaive :: (Eq k, Hashable k) => HM.HashMap k Int -> HM.HashMap k Int -> Bool
isSubmapOfNaive m1 m2 = and [ Just v1 == HM.lookup k1 m2 | (k1,v1) <- HM.toList m1 ]
{-# SPECIALIZE isSubmapOfNaive :: HM.HashMap Int Int -> HM.HashMap Int Int -> Bool #-}
Expand Down
1 change: 1 addition & 0 deletions unordered-containers.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -131,6 +131,7 @@ benchmark benchmarks
containers,
deepseq,
hashable,
vector,
hashmap,
mtl,
random,
Expand Down

0 comments on commit a98d0b6

Please sign in to comment.