60e7acec544653f2418cc52926c30dd6c7227641
[packages/containers.git] / benchmarks / Map.hs
1 {-# LANGUAGE BangPatterns #-}
2 module Main where
3
4 import Control.DeepSeq
5 import Control.Exception (evaluate)
6 import Control.Monad.Trans (liftIO)
7 import Criterion.Main
8 import Data.List (foldl')
9 import qualified Data.Map as M
10 import Data.Maybe (fromMaybe)
11 import Prelude hiding (lookup)
12
13 main = do
14 let m = M.fromAscList elems :: M.Map Int Int
15 m_even = M.fromAscList elems_even :: M.Map Int Int
16 m_odd = M.fromAscList elems_odd :: M.Map Int Int
17 evaluate $ rnf [m, m_even, m_odd]
18 defaultMain
19 [ bench "lookup absent" $ whnf (lookup evens) m_odd
20 , bench "lookup present" $ whnf (lookup evens) m_even
21 , bench "insert absent" $ whnf (ins elems_even) m_odd
22 , bench "insert present" $ whnf (ins elems_even) m_even
23 , bench "insertWith absent" $ whnf (insWith elems_even) m_odd
24 , bench "insertWith present" $ whnf (insWith elems_even) m_even
25 , bench "insertWith' absent" $ whnf (insWith' elems_even) m_odd
26 , bench "insertWith' present" $ whnf (insWith' elems_even) m_even
27 , bench "insertWithKey absent" $ whnf (insWithKey elems_even) m_odd
28 , bench "insertWithKey present" $ whnf (insWithKey elems_even) m_even
29 , bench "insertWithKey' absent" $ whnf (insWithKey' elems_even) m_odd
30 , bench "insertWithKey' present" $ whnf (insWithKey' elems_even) m_even
31 , bench "insertLookupWithKey absent" $ whnf (insLookupWithKey elems_even) m_odd
32 , bench "insertLookupWithKey present" $ whnf (insLookupWithKey elems_even) m_even
33 , bench "insertLookupWithKey' absent" $ whnf (insLookupWithKey' elems_even) m_odd
34 , bench "insertLookupWithKey' present" $ whnf (insLookupWithKey' elems_even) m_even
35 , bench "map" $ whnf (M.map (+ 1)) m
36 , bench "mapWithKey" $ whnf (M.mapWithKey (+)) m
37 , bench "foldlWithKey" $ whnf (ins elems) m
38 -- , bench "foldlWithKey'" $ whnf (M.foldlWithKey' sum 0) m
39 , bench "foldrWithKey" $ whnf (M.foldrWithKey consPair []) m
40 , bench "delete absent" $ whnf (del evens) m_odd
41 , bench "delete present" $ whnf (del evens) m
42 , bench "update absent" $ whnf (upd Just evens) m_odd
43 , bench "update present" $ whnf (upd Just evens) m_even
44 , bench "update delete" $ whnf (upd (const Nothing) evens) m
45 , bench "updateLookupWithKey absent" $ whnf (upd' Just evens) m_odd
46 , bench "updateLookupWithKey present" $ whnf (upd' Just evens) m_even
47 , bench "updateLookupWithKey delete" $ whnf (upd' (const Nothing) evens) m
48 , bench "alter absent" $ whnf (alt id evens) m_odd
49 , bench "alter insert" $ whnf (alt (const (Just 1)) evens) m_odd
50 , bench "alter update" $ whnf (alt id evens) m_even
51 , bench "alter delete" $ whnf (alt (const Nothing) evens) m
52 , bench "mapMaybe" $ whnf (M.mapMaybe maybeDel) m
53 , bench "mapMaybeWithKey" $ whnf (M.mapMaybeWithKey (const maybeDel)) m
54 , bench "lookupIndex" $ whnf (lookupIndex keys) m
55 , bench "union" $ whnf (M.union m_even) m_odd
56 , bench "difference" $ whnf (M.difference m) m_even
57 , bench "intersection" $ whnf (M.intersection m) m_even
58 , bench "split" $ whnf (M.split (bound `div` 2)) m
59 , bench "fromList" $ whnf M.fromList elems
60 , bench "fromList-desc" $ whnf M.fromList (reverse elems)
61 , bench "fromAscList" $ whnf M.fromAscList elems
62 , bench "fromDistinctAscList" $ whnf M.fromDistinctAscList elems
63 ]
64 where
65 bound = 2^12
66 elems = zip keys values
67 elems_even = zip evens evens
68 elems_odd = zip odds odds
69 keys = [1..bound]
70 evens = [2,4..bound]
71 odds = [1,3..bound]
72 values = [1..bound]
73 sum k v1 v2 = k + v1 + v2
74 consPair k v xs = (k, v) : xs
75
76 add3 :: Int -> Int -> Int -> Int
77 add3 x y z = x + y + z
78 {-# INLINE add3 #-}
79
80 lookup :: [Int] -> M.Map Int Int -> Int
81 lookup xs m = foldl' (\n k -> fromMaybe n (M.lookup k m)) 0 xs
82
83 lookupIndex :: [Int] -> M.Map Int Int -> Int
84 lookupIndex xs m = foldl' (\n k -> fromMaybe n (M.lookupIndex k m)) 0 xs
85
86 ins :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int
87 ins xs m = foldl' (\m (k, v) -> M.insert k v m) m xs
88
89 insWith :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int
90 insWith xs m = foldl' (\m (k, v) -> M.insertWith (+) k v m) m xs
91
92 insWithKey :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int
93 insWithKey xs m = foldl' (\m (k, v) -> M.insertWithKey add3 k v m) m xs
94
95 insWith' :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int
96 insWith' xs m = foldl' (\m (k, v) -> M.insertWith' (+) k v m) m xs
97
98 insWithKey' :: [(Int, Int)] -> M.Map Int Int -> M.Map Int Int
99 insWithKey' xs m = foldl' (\m (k, v) -> M.insertWithKey' add3 k v m) m xs
100
101 data PairS a b = PS !a !b
102
103 insLookupWithKey :: [(Int, Int)] -> M.Map Int Int -> (Int, M.Map Int Int)
104 insLookupWithKey xs m = let !(PS a b) = foldl' f (PS 0 m) xs in (a, b)
105 where
106 f (PS n m) (k, v) = let !(n', m') = M.insertLookupWithKey add3 k v m
107 in PS (fromMaybe 0 n' + n) m'
108
109 insLookupWithKey' :: [(Int, Int)] -> M.Map Int Int -> (Int, M.Map Int Int)
110 insLookupWithKey' xs m = let !(PS a b) = foldl' f (PS 0 m) xs in (a, b)
111 where
112 f (PS n m) (k, v) = let !(n', m') = M.insertLookupWithKey' add3 k v m
113 in PS (fromMaybe 0 n' + n) m'
114
115 del :: [Int] -> M.Map Int Int -> M.Map Int Int
116 del xs m = foldl' (\m k -> M.delete k m) m xs
117
118 upd :: (Int -> Maybe Int) -> [Int] -> M.Map Int Int -> M.Map Int Int
119 upd f xs m = foldl' (\m k -> M.update f k m) m xs
120
121 upd' :: (Int -> Maybe Int) -> [Int] -> M.Map Int Int -> M.Map Int Int
122 upd' f xs m = foldl' (\m k -> snd $ M.updateLookupWithKey (\_ a -> f a) k m) m xs
123
124 alt :: (Maybe Int -> Maybe Int) -> [Int] -> M.Map Int Int -> M.Map Int Int
125 alt f xs m = foldl' (\m k -> M.alter f k m) m xs
126
127 maybeDel :: Int -> Maybe Int
128 maybeDel n | n `mod` 3 == 0 = Nothing
129 | otherwise = Just n