1{-# LANGUAGE BangPatterns #-} 2 3module SetOperations (benchmark) where 4 5import Criterion.Main (bench, defaultMain, whnf) 6import Data.List (partition) 7 8benchmark :: ([Int] -> container) -> Bool -> [(String, container -> container -> container)] -> IO () 9benchmark fromList swap methods = do 10 defaultMain $ [ bench (method_str++"-"++input_str) $ whnf (method input1) input2 | (method_str, method) <- methods, (input_str, input1, input2) <- inputs ] 11 12 where 13 n, s, t :: Int 14 n = 100000 15 s {-small-} = n `div` 10 16 t {-tiny-} = round $ sqrt $ fromIntegral n 17 18 inputs = [ (mode_str, left, right) 19 | (mode_str, (left, right)) <- [ ("disj_nn", disj_nn), ("disj_ns", disj_ns), ("disj_nt", disj_nt) 20 , ("common_nn", common_nn), ("common_ns", common_ns), ("common_nt", common_nt) 21 , ("mix_nn", mix_nn), ("mix_ns", mix_ns), ("mix_nt", mix_nt) 22 , ("block_nn", block_nn), ("block_ns", block_ns) 23 ] 24 25 , (mode_str, left, right) <- replicate 2 (mode_str, left, right) ++ 26 replicate (if swap && take 4 mode_str /= "diff" && last mode_str /= last (init mode_str) then 2 else 0) 27 (init (init mode_str) ++ [last mode_str] ++ [last (init mode_str)], right, left) 28 ] 29 30 all_n = fromList [1..n] 31 32 !disj_nn = seqPair $ (all_n, fromList [n+1..n+n]) 33 !disj_ns = seqPair $ (all_n, fromList [n+1..n+s]) 34 !disj_nt = seqPair $ (all_n, fromList [n+1..n+t]) 35 !common_nn = seqPair $ (all_n, fromList [2,4..n]) 36 !common_ns = seqPair $ (all_n, fromList [0,1+n`div`s..n]) 37 !common_nt = seqPair $ (all_n, fromList [0,1+n`div`t..n]) 38 !mix_nn = seqPair $ fromLists $ partition ((/= 0) . (`mod` 2)) [1..n+n] 39 !mix_ns = seqPair $ fromLists $ partition ((/= 0) . (`mod` (1 + n`div`s))) [1..s+n] 40 !mix_nt = seqPair $ fromLists $ partition ((/= 0) . (`mod` (1 + n`div`t))) [1..t+n] 41 !block_nn = seqPair $ fromLists $ partition ((>= t) . (`mod` (t * 2))) [1..n+n] 42 !block_ns = seqPair $ fromLists $ partition ((>= t) . (`mod` (t * (1 + n`div`s)))) [1..s+n] 43 44 fromLists (xs, ys) = (fromList xs, fromList ys) 45 seqPair pair@(xs, ys) = xs `seq` ys `seq` pair 46