From c59897ee3837322d578a05245ec7a579353fdef1 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Mon, 10 Nov 2025 22:24:21 +0100 Subject: [PATCH 1/2] fine-grained: 1000 repetitions for fast ops --- benchmarks/FineGrained.hs | 44 +++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/benchmarks/FineGrained.hs b/benchmarks/FineGrained.hs index 0d2c6ace..fc60e072 100644 --- a/benchmarks/FineGrained.hs +++ b/benchmarks/FineGrained.hs @@ -66,11 +66,11 @@ bFromList = setupBytes s gen = genNBytes s bytesLength gen b s = bench (show s) . whnf (HM.fromList . map (,())) --- 100 lookups each, so we get more precise timings +-- 1000 lookups each, so we get more precise timings bLookup :: Benchmark bLookup = bgroup - "lookup" + "lookup (1000x)" [ bgroup "presentKey" bLookupPresentKey, bgroup "absentKey" bLookupAbsentKey ] @@ -85,7 +85,7 @@ bLookupPresentKey = b s = bench (show s) . whnf (\(m, ks) -> foldl' (\() k -> HM.lookup k m `seq` ()) () ks) - toKs = take 100 . Data.List.cycle . HM.keys + toKs = take 1000 . Data.List.cycle . HM.keys setupBytes size gen = do m <- genBytesMap size gen return (m, toKs m) @@ -104,20 +104,20 @@ bLookupAbsentKey = . whnf (\(m, ks) -> foldl' (\() k -> HM.lookup k m `seq` ()) () ks) setupBytes size gen = do m <- genBytesMap size gen - ks0 <- genNBytes 200 bytesLength gen - let ks1 = take 100 $ Data.List.cycle $ filter (not . flip HM.member m) ks0 + ks0 <- genNBytes 2000 bytesLength gen + let ks1 = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks0 return (m, ks1) setupInts size gen = do m <- genIntMap size gen - ks0 <- genInts 200 gen - let ks1 = take 100 $ Data.List.cycle $ filter (not . flip HM.member m) ks0 + ks0 <- genInts 2000 gen + let ks1 = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks0 return (m, ks1) --- 100 insertions each, so we get more precise timings +-- 1000 insertions each, so we get more precise timings bInsert :: Benchmark bInsert = bgroup - "insert" + "insert (1000x)" [ bgroup "presentKey" [ bgroup "sameValue" bInsertPresentKeySameValue, @@ -136,7 +136,7 @@ bInsertPresentKeySameValue = b s = bench (show s) . whnf (\(m, kvs) -> foldl' (\() (k, v) -> HM.insert k v m `seq` ()) () kvs) - toKVs = take 100 . Data.List.cycle . HM.toList + toKVs = take 1000 . Data.List.cycle . HM.toList setupBytes size gen = do m <- genBytesMap size gen return (m, toKVs m) @@ -154,7 +154,7 @@ bInsertPresentKeyDifferentValue = b s = bench (show s) . whnf (\(m, kvs) -> foldl' (\() (k, v) -> HM.insert k v m `seq` ()) () kvs) - toKVs = take 100 . Data.List.cycle . map (second (+ 1)) . HM.toList + toKVs = take 1000 . Data.List.cycle . map (second (+ 1)) . HM.toList setupBytes size gen = do m <- genBytesMap size gen return (m, toKVs m) @@ -173,20 +173,20 @@ bInsertAbsentKey = . whnf (\(m, kvs) -> foldl' (\() (k, v) -> HM.insert k v m `seq` ()) () kvs) setupBytes size gen = do m <- genBytesMap size gen - ks <- genNBytes 200 bytesLength gen - let kvs = take 100 $ Data.List.cycle $ map (,1) $ filter (not . flip HM.member m) ks + ks <- genNBytes 2000 bytesLength gen + let kvs = take 1000 $ Data.List.cycle $ map (,1) $ filter (not . flip HM.member m) ks return (m, kvs) setupInts size gen = do m <- genIntMap size gen - ks <- genInts 200 gen - let kvs = take 100 $ Data.List.cycle $ map (,1) $ filter (not . flip HM.member m) ks + ks <- genInts 2000 gen + let kvs = take 1000 $ Data.List.cycle $ map (,1) $ filter (not . flip HM.member m) ks return (m, kvs) --- 100 deletions each, so we get more precise timings +-- 1000 deletions each, so we get more precise timings bDelete :: Benchmark bDelete = bgroup - "delete" + "delete (1000x)" [ bgroup "presentKey" bDeletePresentKey, bgroup "absentKey" bDeleteAbsentKey ] @@ -201,7 +201,7 @@ bDeletePresentKey = b s = bench (show s) . whnf (\(m, ks) -> foldl' (\() k -> HM.delete k m `seq` ()) () ks) - toKs = take 100 . Data.List.cycle . HM.keys + toKs = take 1000 . Data.List.cycle . HM.keys setupBytes size gen = do m <- genBytesMap size gen return (m, toKs m) @@ -220,13 +220,13 @@ bDeleteAbsentKey = . whnf (\(m, ks) -> foldl' (\() k -> HM.delete k m `seq` ()) () ks) setupBytes size gen = do m <- genBytesMap size gen - ks0 <- genNBytes 200 bytesLength gen - let ks1 = take 100 $ Data.List.cycle $ filter (not . flip HM.member m) ks0 + ks0 <- genNBytes 2000 bytesLength gen + let ks1 = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks0 return (m, ks1) setupInts size gen = do m <- genIntMap size gen - ks0 <- genInts 200 gen - let ks1 = take 100 $ Data.List.cycle $ filter (not . flip HM.member m) ks0 + ks0 <- genInts 2000 gen + let ks1 = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks0 return (m, ks1) -- TODO: For the "overlap" and "equal" cases, it would be interesting to From 20d2605ded8918f04bc215d65b2f4b1faf8ed4d3 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Mon, 10 Nov 2025 22:53:06 +0100 Subject: [PATCH 2/2] Add benchmarks for `update` and `alter` --- benchmarks/FineGrained.hs | 131 +++++++++++++++++++++++++++++++++++--- 1 file changed, 123 insertions(+), 8 deletions(-) diff --git a/benchmarks/FineGrained.hs b/benchmarks/FineGrained.hs index fc60e072..4906eaee 100644 --- a/benchmarks/FineGrained.hs +++ b/benchmarks/FineGrained.hs @@ -1,5 +1,4 @@ --- | This file is formatted with https://hackage.haskell.org/package/ormolu - +-- This file is formatted with https://hackage.haskell.org/package/ormolu {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NumericUnderscores #-} @@ -30,6 +29,8 @@ main = [ bFromList, bLookup, bInsert, + bUpdate, + bAlter, bDelete, bUnion, bUnions, @@ -182,6 +183,115 @@ bInsertAbsentKey = let kvs = take 1000 $ Data.List.cycle $ map (,1) $ filter (not . flip HM.member m) ks return (m, kvs) +bUpdate :: Benchmark +bUpdate = + bgroup + "update (1000x)" + [ bgroup "presentKey" bUpdatePresentKey, + bgroup "absentKey" bUpdateAbsentKey + ] + +updateF :: Int -> Maybe Int +updateF x + | intPredicate x = Nothing + | x `mod` 3 == 0 = Just (x + 1) + | otherwise = Just x + +bUpdateAbsentKey :: [Benchmark] +bUpdateAbsentKey = + [ bgroup' "Bytes" setupBytes b, + bgroup' "Int" setupInts b + ] + where + b s = + bench (show s) + . whnf (\(m, ks) -> foldl' (\() k -> HM.update updateF k m `seq` ()) () ks) + setupBytes size gen = do + m <- genBytesMap size gen + ks <- genNBytes 2000 bytesLength gen + let ks' = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks + return (m, ks') + setupInts size gen = do + m <- genIntMap size gen + ks <- genInts 2000 gen + let ks' = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks + return (m, ks') + +bUpdatePresentKey :: [Benchmark] +bUpdatePresentKey = + [ bgroup'WithSizes sizes "Bytes" setupBytes b, + bgroup'WithSizes sizes "Int" setupInts b + ] + where + sizes = filter (/= 0) defaultSizes + b s = + bench (show s) + . whnf (\(m, ks) -> foldl' (\() k -> HM.update updateF k m `seq` ()) () ks) + toKs = take 1000 . Data.List.cycle . HM.keys + setupBytes size gen = do + m <- genBytesMap size gen + return (m, toKs m) + setupInts size gen = do + m <- genIntMap size gen + return (m, toKs m) + +bAlter :: Benchmark +bAlter = + bgroup + "alter (1000x)" + [ bgroup "presentKey" bAlterPresentKey, + bgroup "absentKey" bAlterAbsentKey + ] + +alterF' :: (Hashable k) => k -> Maybe Int -> Maybe Int +alterF' k Nothing + | intPredicate (hash k) = Nothing + | otherwise = Just (hash k) +alterF' k (Just v) + | odd n = Nothing + | intPredicate n = Just (n + 1) + | otherwise = Just v + where + n = hash k + v + +bAlterAbsentKey :: [Benchmark] +bAlterAbsentKey = + [ bgroup' "Bytes" setupBytes b, + bgroup' "Int" setupInts b + ] + where + b s = + bench (show s) + . whnf (\(m, ks) -> foldl' (\() k -> HM.alter (alterF' k) k m `seq` ()) () ks) + setupBytes size gen = do + m <- genBytesMap size gen + ks <- genNBytes 2000 bytesLength gen + let ks' = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks + return (m, ks') + setupInts size gen = do + m <- genIntMap size gen + ks <- genInts 2000 gen + let ks' = take 1000 $ Data.List.cycle $ filter (not . flip HM.member m) ks + return (m, ks') + +bAlterPresentKey :: [Benchmark] +bAlterPresentKey = + [ bgroup'WithSizes sizes "Bytes" setupBytes b, + bgroup'WithSizes sizes "Int" setupInts b + ] + where + sizes = filter (/= 0) defaultSizes + b s = + bench (show s) + . whnf (\(m, ks) -> foldl' (\() k -> HM.alter (alterF' k) k m `seq` ()) () ks) + toKs = take 1000 . Data.List.cycle . HM.keys + setupBytes size gen = do + m <- genBytesMap size gen + return (m, toKs m) + setupInts size gen = do + m <- genIntMap size gen + return (m, toKs m) + -- 1000 deletions each, so we get more precise timings bDelete :: Benchmark bDelete = @@ -266,10 +376,12 @@ bUnionEqual = b size = bench (show size) . whnf (\m -> HM.union m m) bUnions :: Benchmark -bUnions = bgroup "unions" - [ bgroup'WithSizes sizes "Bytes" setupBytes b, - bgroup'WithSizes sizes "Int" setupInts b - ] +bUnions = + bgroup + "unions" + [ bgroup'WithSizes sizes "Bytes" setupBytes b, + bgroup'WithSizes sizes "Int" setupInts b + ] where sizes = filter (>= 10) defaultSizes b size = bench (show size) . whnf (\ms -> HM.unions ms) @@ -432,7 +544,7 @@ env' setup b size = -- Generators keysToMap :: (Hashable k) => [k] -> HashMap k Int -keysToMap = HM.fromList . map (,1) +keysToMap = HM.fromList . map (\k -> (k, hashWithSalt 123 k)) genInts :: (StatefulGen g m) => @@ -482,7 +594,7 @@ genIntMapsDisjoint :: Int -> g -> m (HashMap Int Int, HashMap Int Int) genIntMapsDisjoint s gen = do ints <- genInts s gen - let (trues, falses) = Data.List.partition (flip testBit (31 :: Int)) ints + let (trues, falses) = Data.List.partition intPredicate ints return (keysToMap trues, keysToMap falses) genBytesMapsDisjoint :: @@ -491,3 +603,6 @@ genBytesMapsDisjoint :: genBytesMapsDisjoint s gen = do (trues, falses) <- Key.Bytes.genDisjoint s bytesLength gen return (keysToMap trues, keysToMap falses) + +intPredicate :: Int -> Bool +intPredicate n = testBit n 31