Replace criterion with gauge as the benchmark framework
[packages/containers.git] / benchmarks / LookupGE / 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, nf)
7 import Data.List (foldl')
8 import qualified Data.IntMap as M
9 import qualified LookupGE_IntMap as M
10 import Data.Maybe (fromMaybe)
11 import Prelude hiding (lookup)
12
13 main :: IO ()
14 main = do
15 evaluate $ rnf [m_even, m_odd, m_large]
16 defaultMain [b f | b <- benches, f <- funs1]
17 where
18 m_even = M.fromAscList elems_even :: M.IntMap Int
19 m_odd = M.fromAscList elems_odd :: M.IntMap Int
20 m_large = M.fromAscList elems_large :: M.IntMap Int
21 bound = 2^12
22 elems_even = zip evens evens
23 elems_odd = zip odds odds
24 elems_large = zip large large
25 evens = [2,4..bound]
26 odds = [1,3..bound]
27 large = [1,100..50*bound]
28 benches =
29 [ \(n,fun) -> bench (n++" present") $ nf (fge fun evens) m_even
30 , \(n,fun) -> bench (n++" absent") $ nf (fge fun evens) m_odd
31 , \(n,fun) -> bench (n++" far") $ nf (fge fun odds) m_large
32 , \(n,fun) -> bench (n++" !present") $ nf (fge2 fun evens) m_even
33 , \(n,fun) -> bench (n++" !absent") $ nf (fge2 fun evens) m_odd
34 , \(n,fun) -> bench (n++" !far") $ nf (fge2 fun odds) m_large
35 ]
36 funs1 = [ ("GE split", M.lookupGE1)
37 , ("GE Craig", M.lookupGE2)
38 , ("GE Twan", M.lookupGE3)
39 , ("GE Milan", M.lookupGE4) ]
40
41 fge :: (Int -> M.IntMap Int -> Maybe (Int,Int)) -> [Int] -> M.IntMap Int -> (Int,Int)
42 fge fun xs m = foldl' (\n k -> fromMaybe n (fun k m)) (0,0) xs
43
44 -- forcing values inside tuples!
45 fge2 :: (Int -> M.IntMap Int -> Maybe (Int,Int)) -> [Int] -> M.IntMap Int -> (Int,Int)
46 fge2 fun xs m = foldl' (\n@(!_, !_) k -> fromMaybe n (fun k m)) (0,0) xs
47