Document the Semigroup for Map
[packages/containers.git] / benchmarks / SetOperations / SetOperations.hs
1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3
4 module SetOperations (benchmark) where
5
6 import Gauge (bench, defaultMain, whnf)
7 import Data.List (partition, sortBy)
8 import Data.Ord (comparing)
9 import Data.Tuple as Tuple
10
11 -- | Benchmark a set operation for the given container.
12 -- Takes the following arguments:
13 -- * A way to construct the container
14 -- * Flag if we should benchmark the operations with reversed arguments.
15 -- * A list of operations.
16 benchmark :: forall container. (Show container, Eq container) => ([Int] -> container) -> Bool -> [(String, container -> container -> container)] -> IO ()
17 benchmark fromList swap methods = do
18
19 defaultMain $ [ bench (method_str++"-"++input_str ++ "_" ++ data_sizes) $
20 whnf (method input1) input2
21
22 | (method_str, method) <- methods
23 , (input_str, data_sizes, (input1, input2)) <- sortBenchs (base_inputs ++ swapped_input)
24 ]
25
26 where
27 -- Sort benchmark inputs by (data variant, data sizes)
28 sortBenchs = sortBy (comparing (\(name,size,_) -> (name,size)))
29
30 -- Data size descriptions, also used in the benchmark names.
31 -- They are used to describe how large the input data is, but NOT the data itself.
32 -- So for example nn_swap /= nn since the data size for both arguments is the same
33 -- but the actual data is different.
34 n, s, t :: Int
35 n = 100000
36 s {-small-} = n `div` 10
37 t {-tiny-} = round $ sqrt $ fromIntegral n
38
39 base_inputs :: [(String,String,(container,container))]
40 base_inputs = [ ("disj", "nn", disj_nn), ("disj","ns", disj_ns), ("disj","nt", disj_nt)
41 , ("common","nn", common_nn), ("common","ns", common_ns), ("common","nt", common_nt)
42 , ("mix","nn", mix_nn), ("mix","ns", mix_ns), ("mix","nt", mix_nt)
43 , ("block","nn", block_nn), ("block","ns", block_ns)
44 ]
45
46 -- Input with set arguments swapped.
47 swapped_input
48 | swap = map swap_input base_inputs
49 | otherwise = []
50
51 -- Reverse arguments
52 swap_input (name, data_sizes, input_data) =
53 (name, reverse data_sizes ++ "_swap", Tuple.swap input_data)
54
55 -- Data variants
56 all_n = fromList [1..n]
57
58 !disj_nn = seqPair $ (all_n, fromList [n+1..n+n])
59 !disj_ns = seqPair $ (all_n, fromList [n+1..n+s])
60 !disj_nt = seqPair $ (all_n, fromList [n+1..n+t])
61 !common_nn = seqPair $ (all_n, fromList [2,4..n])
62 !common_ns = seqPair $ (all_n, fromList [0,1+n`div`s..n])
63 !common_nt = seqPair $ (all_n, fromList [0,1+n`div`t..n])
64 !mix_nn = seqPair $ fromLists $ partition ((/= 0) . (`mod` 2)) [1..n+n]
65 !mix_ns = seqPair $ fromLists $ partition ((/= 0) . (`mod` (1 + n`div`s))) [1..s+n]
66 !mix_nt = seqPair $ fromLists $ partition ((/= 0) . (`mod` (1 + n`div`t))) [1..t+n]
67 !block_nn = seqPair $ fromLists $ partition ((>= t) . (`mod` (t * 2))) [1..n+n]
68 !block_ns = seqPair $ fromLists $ partition ((>= t) . (`mod` (t * (1 + n`div`s)))) [1..s+n]
69
70 fromLists (xs, ys) = (fromList xs, fromList ys)
71 seqPair pair@(xs, ys) = xs `seq` ys `seq` pair