Skip to content

Commit ebb5c13

Browse files
sjakobisjakobi
authored
Improve fine-grained benchmarks (#547)
* Add benchmarks for update and alter * For fast operations, do 1000 repetitions instead of 100
1 parent a7736a1 commit ebb5c13

File tree

1 file changed

+145
-30
lines changed

1 file changed

+145
-30
lines changed

‎benchmarks/FineGrained.hs‎

Lines changed: 145 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
1-
-- | This file is formatted with https://hackage.haskell.org/package/ormolu
2-
1+
-- This file is formatted with https://hackage.haskell.org/package/ormolu
32
{-# LANGUAGE DeriveAnyClass #-}
43
{-# LANGUAGE DeriveGeneric #-}
54
{-# LANGUAGE NumericUnderscores #-}
@@ -30,6 +29,8 @@ main =
3029
[ bFromList,
3130
bLookup,
3231
bInsert,
32+
bUpdate,
33+
bAlter,
3334
bDelete,
3435
bUnion,
3536
bUnions,
@@ -66,11 +67,11 @@ bFromList =
6667
setupBytes s gen = genNBytes s bytesLength gen
6768
b s = bench (show s) . whnf (HM.fromList . map (,()))
6869

69-
-- 100 lookups each, so we get more precise timings
70+
-- 1000 lookups each, so we get more precise timings
7071
bLookup :: Benchmark
7172
bLookup =
7273
bgroup
73-
"lookup"
74+
"lookup (1000x)"
7475
[ bgroup "presentKey" bLookupPresentKey,
7576
bgroup "absentKey" bLookupAbsentKey
7677
]
@@ -85,7 +86,7 @@ bLookupPresentKey =
8586
b s =
8687
bench (show s)
8788
. whnf (\(m, ks) -> foldl' (\() k -> HM.lookup k m `seq` ()) () ks)
88-
toKs = take 100 . Data.List.cycle . HM.keys
89+
toKs = take 1000 . Data.List.cycle . HM.keys
8990
setupBytes size gen = do
9091
m <- genBytesMap size gen
9192
return (m, toKs m)
@@ -104,20 +105,20 @@ bLookupAbsentKey =
104105
. whnf (\(m, ks) -> foldl' (\() k -> HM.lookup k m `seq` ()) () ks)
105106
setupBytes size gen = do
106107
m <- genBytesMap size gen
107-
ks0 <- genNBytes 200 bytesLength gen
108-
let ks1 = take 100 $ Data.List.cycle $ filter (not . flip HM.member m) ks0
108+
ks0 <- genNBytes 2000 bytesLength gen
109+
let ks1 = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks0
109110
return (m, ks1)
110111
setupInts size gen = do
111112
m <- genIntMap size gen
112-
ks0 <- genInts 200 gen
113-
let ks1 = take 100 $ Data.List.cycle $ filter (not . flip HM.member m) ks0
113+
ks0 <- genInts 2000 gen
114+
let ks1 = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks0
114115
return (m, ks1)
115116

116-
-- 100 insertions each, so we get more precise timings
117+
-- 1000 insertions each, so we get more precise timings
117118
bInsert :: Benchmark
118119
bInsert =
119120
bgroup
120-
"insert"
121+
"insert (1000x)"
121122
[ bgroup
122123
"presentKey"
123124
[ bgroup "sameValue" bInsertPresentKeySameValue,
@@ -136,7 +137,7 @@ bInsertPresentKeySameValue =
136137
b s =
137138
bench (show s)
138139
. whnf (\(m, kvs) -> foldl' (\() (k, v) -> HM.insert k v m `seq` ()) () kvs)
139-
toKVs = take 100 . Data.List.cycle . HM.toList
140+
toKVs = take 1000 . Data.List.cycle . HM.toList
140141
setupBytes size gen = do
141142
m <- genBytesMap size gen
142143
return (m, toKVs m)
@@ -154,7 +155,7 @@ bInsertPresentKeyDifferentValue =
154155
b s =
155156
bench (show s)
156157
. whnf (\(m, kvs) -> foldl' (\() (k, v) -> HM.insert k v m `seq` ()) () kvs)
157-
toKVs = take 100 . Data.List.cycle . map (second (+ 1)) . HM.toList
158+
toKVs = take 1000 . Data.List.cycle . map (second (+ 1)) . HM.toList
158159
setupBytes size gen = do
159160
m <- genBytesMap size gen
160161
return (m, toKVs m)
@@ -173,20 +174,129 @@ bInsertAbsentKey =
173174
. whnf (\(m, kvs) -> foldl' (\() (k, v) -> HM.insert k v m `seq` ()) () kvs)
174175
setupBytes size gen = do
175176
m <- genBytesMap size gen
176-
ks <- genNBytes 200 bytesLength gen
177-
let kvs = take 100 $ Data.List.cycle $ map (,1) $ filter (not . flip HM.member m) ks
177+
ks <- genNBytes 2000 bytesLength gen
178+
let kvs = take 1000 $ Data.List.cycle $ map (,1) $ filter (not . flip HM.member m) ks
178179
return (m, kvs)
179180
setupInts size gen = do
180181
m <- genIntMap size gen
181-
ks <- genInts 200 gen
182-
let kvs = take 100 $ Data.List.cycle $ map (,1) $ filter (not . flip HM.member m) ks
182+
ks <- genInts 2000 gen
183+
let kvs = take 1000 $ Data.List.cycle $ map (,1) $ filter (not . flip HM.member m) ks
183184
return (m, kvs)
184185

185-
-- 100 deletions each, so we get more precise timings
186+
bUpdate :: Benchmark
187+
bUpdate =
188+
bgroup
189+
"update (1000x)"
190+
[ bgroup "presentKey" bUpdatePresentKey,
191+
bgroup "absentKey" bUpdateAbsentKey
192+
]
193+
194+
updateF :: Int -> Maybe Int
195+
updateF x
196+
| intPredicate x = Nothing
197+
| x `mod` 3 == 0 = Just (x + 1)
198+
| otherwise = Just x
199+
200+
bUpdateAbsentKey :: [Benchmark]
201+
bUpdateAbsentKey =
202+
[ bgroup' "Bytes" setupBytes b,
203+
bgroup' "Int" setupInts b
204+
]
205+
where
206+
b s =
207+
bench (show s)
208+
. whnf (\(m, ks) -> foldl' (\() k -> HM.update updateF k m `seq` ()) () ks)
209+
setupBytes size gen = do
210+
m <- genBytesMap size gen
211+
ks <- genNBytes 2000 bytesLength gen
212+
let ks' = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks
213+
return (m, ks')
214+
setupInts size gen = do
215+
m <- genIntMap size gen
216+
ks <- genInts 2000 gen
217+
let ks' = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks
218+
return (m, ks')
219+
220+
bUpdatePresentKey :: [Benchmark]
221+
bUpdatePresentKey =
222+
[ bgroup'WithSizes sizes "Bytes" setupBytes b,
223+
bgroup'WithSizes sizes "Int" setupInts b
224+
]
225+
where
226+
sizes = filter (/= 0) defaultSizes
227+
b s =
228+
bench (show s)
229+
. whnf (\(m, ks) -> foldl' (\() k -> HM.update updateF k m `seq` ()) () ks)
230+
toKs = take 1000 . Data.List.cycle . HM.keys
231+
setupBytes size gen = do
232+
m <- genBytesMap size gen
233+
return (m, toKs m)
234+
setupInts size gen = do
235+
m <- genIntMap size gen
236+
return (m, toKs m)
237+
238+
bAlter :: Benchmark
239+
bAlter =
240+
bgroup
241+
"alter (1000x)"
242+
[ bgroup "presentKey" bAlterPresentKey,
243+
bgroup "absentKey" bAlterAbsentKey
244+
]
245+
246+
alterF' :: (Hashable k) => k -> Maybe Int -> Maybe Int
247+
alterF' k Nothing
248+
| intPredicate (hash k) = Nothing
249+
| otherwise = Just (hash k)
250+
alterF' k (Just v)
251+
| odd n = Nothing
252+
| intPredicate n = Just (n + 1)
253+
| otherwise = Just v
254+
where
255+
n = hash k + v
256+
257+
bAlterAbsentKey :: [Benchmark]
258+
bAlterAbsentKey =
259+
[ bgroup' "Bytes" setupBytes b,
260+
bgroup' "Int" setupInts b
261+
]
262+
where
263+
b s =
264+
bench (show s)
265+
. whnf (\(m, ks) -> foldl' (\() k -> HM.alter (alterF' k) k m `seq` ()) () ks)
266+
setupBytes size gen = do
267+
m <- genBytesMap size gen
268+
ks <- genNBytes 2000 bytesLength gen
269+
let ks' = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks
270+
return (m, ks')
271+
setupInts size gen = do
272+
m <- genIntMap size gen
273+
ks <- genInts 2000 gen
274+
let ks' = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks
275+
return (m, ks')
276+
277+
bAlterPresentKey :: [Benchmark]
278+
bAlterPresentKey =
279+
[ bgroup'WithSizes sizes "Bytes" setupBytes b,
280+
bgroup'WithSizes sizes "Int" setupInts b
281+
]
282+
where
283+
sizes = filter (/= 0) defaultSizes
284+
b s =
285+
bench (show s)
286+
. whnf (\(m, ks) -> foldl' (\() k -> HM.alter (alterF' k) k m `seq` ()) () ks)
287+
toKs = take 1000 . Data.List.cycle . HM.keys
288+
setupBytes size gen = do
289+
m <- genBytesMap size gen
290+
return (m, toKs m)
291+
setupInts size gen = do
292+
m <- genIntMap size gen
293+
return (m, toKs m)
294+
295+
-- 1000 deletions each, so we get more precise timings
186296
bDelete :: Benchmark
187297
bDelete =
188298
bgroup
189-
"delete"
299+
"delete (1000x)"
190300
[ bgroup "presentKey" bDeletePresentKey,
191301
bgroup "absentKey" bDeleteAbsentKey
192302
]
@@ -201,7 +311,7 @@ bDeletePresentKey =
201311
b s =
202312
bench (show s)
203313
. whnf (\(m, ks) -> foldl' (\() k -> HM.delete k m `seq` ()) () ks)
204-
toKs = take 100 . Data.List.cycle . HM.keys
314+
toKs = take 1000 . Data.List.cycle . HM.keys
205315
setupBytes size gen = do
206316
m <- genBytesMap size gen
207317
return (m, toKs m)
@@ -220,13 +330,13 @@ bDeleteAbsentKey =
220330
. whnf (\(m, ks) -> foldl' (\() k -> HM.delete k m `seq` ()) () ks)
221331
setupBytes size gen = do
222332
m <- genBytesMap size gen
223-
ks0 <- genNBytes 200 bytesLength gen
224-
let ks1 = take 100 $ Data.List.cycle $ filter (not . flip HM.member m) ks0
333+
ks0 <- genNBytes 2000 bytesLength gen
334+
let ks1 = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks0
225335
return (m, ks1)
226336
setupInts size gen = do
227337
m <- genIntMap size gen
228-
ks0 <- genInts 200 gen
229-
let ks1 = take 100 $ Data.List.cycle $ filter (not . flip HM.member m) ks0
338+
ks0 <- genInts 2000 gen
339+
let ks1 = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks0
230340
return (m, ks1)
231341

232342
-- TODO: For the "overlap" and "equal" cases, it would be interesting to
@@ -266,10 +376,12 @@ bUnionEqual =
266376
b size = bench (show size) . whnf (\m -> HM.union m m)
267377

268378
bUnions :: Benchmark
269-
bUnions = bgroup "unions"
270-
[ bgroup'WithSizes sizes "Bytes" setupBytes b,
271-
bgroup'WithSizes sizes "Int" setupInts b
272-
]
379+
bUnions =
380+
bgroup
381+
"unions"
382+
[ bgroup'WithSizes sizes "Bytes" setupBytes b,
383+
bgroup'WithSizes sizes "Int" setupInts b
384+
]
273385
where
274386
sizes = filter (>= 10) defaultSizes
275387
b size = bench (show size) . whnf (\ms -> HM.unions ms)
@@ -432,7 +544,7 @@ env' setup b size =
432544
-- Generators
433545

434546
keysToMap :: (Hashable k) => [k] -> HashMap k Int
435-
keysToMap = HM.fromList . map (,1)
547+
keysToMap = HM.fromList . map (\k -> (k, hashWithSalt 123 k))
436548

437549
genInts ::
438550
(StatefulGen g m) =>
@@ -482,7 +594,7 @@ genIntMapsDisjoint ::
482594
Int -> g -> m (HashMap Int Int, HashMap Int Int)
483595
genIntMapsDisjoint s gen = do
484596
ints <- genInts s gen
485-
let (trues, falses) = Data.List.partition (flip testBit (31 :: Int)) ints
597+
let (trues, falses) = Data.List.partition intPredicate ints
486598
return (keysToMap trues, keysToMap falses)
487599

488600
genBytesMapsDisjoint ::
@@ -491,3 +603,6 @@ genBytesMapsDisjoint ::
491603
genBytesMapsDisjoint s gen = do
492604
(trues, falses) <- Key.Bytes.genDisjoint s bytesLength gen
493605
return (keysToMap trues, keysToMap falses)
606+
607+
intPredicate :: Int -> Bool
608+
intPredicate n = testBit n 31

0 commit comments

Comments
 (0)