Replace criterion with gauge as the benchmark framework
[packages/containers.git] / benchmarks / IntMap.hs
1 {-# LANGUAGE BangPatterns #-}
2 module Main where
3
4 import Control.DeepSeq (rnf)
5 import Control.Exception (evaluate)
6 import Gauge (bench, defaultMain, whnf)
7 import Data.List (foldl')
8 import qualified Data.IntMap as M
9 import qualified Data.IntMap.Strict as MS
10 import Data.Maybe (fromMaybe)
11 import Prelude hiding (lookup)
12
13 main = do
14 let m = M.fromAscList elems :: M.IntMap Int
15 evaluate $ rnf [m]
16 defaultMain
17 [ bench "lookup" $ whnf (lookup keys) m
18 , bench "insert" $ whnf (ins elems) M.empty
19 , bench "insertWith empty" $ whnf (insWith elems) M.empty
20 , bench "insertWith update" $ whnf (insWith elems) m
21 , bench "insertWith' empty" $ whnf (insWith' elems) M.empty
22 , bench "insertWith' update" $ whnf (insWith' elems) m
23 , bench "insertWithKey empty" $ whnf (insWithKey elems) M.empty
24 , bench "insertWithKey update" $ whnf (insWithKey elems) m
25 , bench "insertWithKey' empty" $ whnf (insWithKey' elems) M.empty
26 , bench "insertWithKey' update" $ whnf (insWithKey' elems) m
27 , bench "insertLookupWithKey empty" $ whnf (insLookupWithKey elems) M.empty
28 , bench "insertLookupWithKey update" $ whnf (insLookupWithKey elems) m
29 , bench "map" $ whnf (M.map (+ 1)) m
30 , bench "mapWithKey" $ whnf (M.mapWithKey (+)) m
31 , bench "foldlWithKey" $ whnf (ins elems) m
32 , bench "foldlWithKey'" $ whnf (M.foldlWithKey' sum 0) m
33 , bench "foldrWithKey" $ whnf (M.foldrWithKey consPair []) m
34 , bench "delete" $ whnf (del keys) m
35 , bench "update" $ whnf (upd keys) m
36 , bench "updateLookupWithKey" $ whnf (upd' keys) m
37 , bench "alter" $ whnf (alt keys) m
38 , bench "mapMaybe" $ whnf (M.mapMaybe maybeDel) m
39 , bench "mapMaybeWithKey" $ whnf (M.mapMaybeWithKey (const maybeDel)) m
40 , bench "fromList" $ whnf M.fromList elems
41 , bench "fromAscList" $ whnf M.fromAscList elems
42 , bench "fromDistinctAscList" $ whnf M.fromDistinctAscList elems
43 , bench "minView" $ whnf (maybe 0 (\((k,v), m) -> k+v+M.size m) . M.minViewWithKey)
44 (M.fromList $ zip [1..10] [1..10])
45 ]
46 where
47 elems = zip keys values
48 keys = [1..2^12]
49 values = [1..2^12]
50 sum k v1 v2 = k + v1 + v2
51 consPair k v xs = (k, v) : xs
52
53 add3 :: Int -> Int -> Int -> Int
54 add3 x y z = x + y + z
55 {-# INLINE add3 #-}
56
57 lookup :: [Int] -> M.IntMap Int -> Int
58 lookup xs m = foldl' (\n k -> fromMaybe n (M.lookup k m)) 0 xs
59
60 ins :: [(Int, Int)] -> M.IntMap Int -> M.IntMap Int
61 ins xs m = foldl' (\m (k, v) -> M.insert k v m) m xs
62
63 insWith :: [(Int, Int)] -> M.IntMap Int -> M.IntMap Int
64 insWith xs m = foldl' (\m (k, v) -> M.insertWith (+) k v m) m xs
65
66 insWithKey :: [(Int, Int)] -> M.IntMap Int -> M.IntMap Int
67 insWithKey xs m = foldl' (\m (k, v) -> M.insertWithKey add3 k v m) m xs
68
69 insWith' :: [(Int, Int)] -> M.IntMap Int -> M.IntMap Int
70 insWith' xs m = foldl' (\m (k, v) -> MS.insertWith (+) k v m) m xs
71
72 insWithKey' :: [(Int, Int)] -> M.IntMap Int -> M.IntMap Int
73 insWithKey' xs m = foldl' (\m (k, v) -> MS.insertWithKey add3 k v m) m xs
74
75 data PairS a b = PS !a !b
76
77 insLookupWithKey :: [(Int, Int)] -> M.IntMap Int -> (Int, M.IntMap Int)
78 insLookupWithKey xs m = let !(PS a b) = foldl' f (PS 0 m) xs in (a, b)
79 where
80 f (PS n m) (k, v) = let !(n', m') = M.insertLookupWithKey add3 k v m
81 in PS (fromMaybe 0 n' + n) m'
82
83 del :: [Int] -> M.IntMap Int -> M.IntMap Int
84 del xs m = foldl' (\m k -> M.delete k m) m xs
85
86 upd :: [Int] -> M.IntMap Int -> M.IntMap Int
87 upd xs m = foldl' (\m k -> M.update Just k m) m xs
88
89 upd' :: [Int] -> M.IntMap Int -> M.IntMap Int
90 upd' xs m = foldl' (\m k -> snd $ M.updateLookupWithKey (\_ a -> Just a) k m) m xs
91
92 alt :: [Int] -> M.IntMap Int -> M.IntMap Int
93 alt xs m = foldl' (\m k -> M.alter id k m) m xs
94
95 maybeDel :: Int -> Maybe Int
96 maybeDel n | n `mod` 3 == 0 = Nothing
97 | otherwise = Just n