Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers On branch : master
http://hackage.haskell.org/trac/ghc/changeset/0b3612276f50afeb89dbdf76d27c3a7c48508e48 >--------------------------------------------------------------- commit 0b3612276f50afeb89dbdf76d27c3a7c48508e48 Author: Milan Straka <[email protected]> Date: Sat Apr 14 18:44:02 2012 +0200 Benchmark of set operations -- union, difference, intersection. >--------------------------------------------------------------- benchmarks/SetOperations-IntMap.hs | 6 ++++ benchmarks/SetOperations-IntSet.hs | 6 ++++ benchmarks/SetOperations-Map.hs | 6 ++++ benchmarks/SetOperations-Set.hs | 6 ++++ benchmarks/SetOperations.hs | 45 ++++++++++++++++++++++++++++++++++++ 5 files changed, 69 insertions(+), 0 deletions(-) diff --git a/benchmarks/SetOperations-IntMap.hs b/benchmarks/SetOperations-IntMap.hs new file mode 100644 index 0000000..036c82c --- /dev/null +++ b/benchmarks/SetOperations-IntMap.hs @@ -0,0 +1,6 @@ +module Main where + +import Data.IntMap as C +import SetOperations + +main = benchmark (\xs -> fromList [(x, x) | x <- xs]) True [("union", C.union), ("difference", C.difference), ("intersection", C.intersection)] diff --git a/benchmarks/SetOperations-IntSet.hs b/benchmarks/SetOperations-IntSet.hs new file mode 100644 index 0000000..3b116c7 --- /dev/null +++ b/benchmarks/SetOperations-IntSet.hs @@ -0,0 +1,6 @@ +module Main where + +import Data.IntSet as C +import SetOperations + +main = benchmark fromList True [("union", C.union), ("difference", C.difference), ("intersection", C.intersection)] diff --git a/benchmarks/SetOperations-Map.hs b/benchmarks/SetOperations-Map.hs new file mode 100644 index 0000000..7d08e3c --- /dev/null +++ b/benchmarks/SetOperations-Map.hs @@ -0,0 +1,6 @@ +module Main where + +import Data.Map as C +import SetOperations + +main = benchmark (\xs -> fromList [(x, x) | x <- xs]) True [("union", C.union), ("difference", C.difference), ("intersection", C.intersection)] diff --git a/benchmarks/SetOperations-Set.hs b/benchmarks/SetOperations-Set.hs new file mode 100644 index 0000000..bd1a0c9 --- /dev/null +++ b/benchmarks/SetOperations-Set.hs @@ -0,0 +1,6 @@ +module Main where + +import Data.Set as C +import SetOperations + +main = benchmark fromList True [("union", C.union), ("difference", C.difference), ("intersection", C.intersection)] diff --git a/benchmarks/SetOperations.hs b/benchmarks/SetOperations.hs new file mode 100644 index 0000000..0eced65 --- /dev/null +++ b/benchmarks/SetOperations.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE BangPatterns #-} + +module SetOperations (benchmark) where + +import Criterion.Main +import Data.List (partition) + +benchmark :: ([Int] -> container) -> Bool -> [(String, container -> container -> container)] -> IO () +benchmark fromList swap methods = do + defaultMain $ [ bench (method_str++"-"++input_str) $ whnf (method input1) input2 | (method_str, method) <- methods, (input_str, input1, input2) <- inputs ] + + where + n, s, t :: Int + n = 100000 + s {-small-} = n `div` 10 + t {-tiny-} = round $ sqrt $ fromIntegral n + + inputs = [ (mode_str, left, right) + | (mode_str, (left, right)) <- [ ("disj_nn", disj_nn), ("disj_ns", disj_ns), ("disj_nt", disj_nt) + , ("common_nn", common_nn), ("common_ns", common_ns), ("common_nt", common_nt) + , ("mix_nn", mix_nn), ("mix_ns", mix_ns), ("mix_nt", mix_nt) + , ("block_nn", block_nn), ("block_sn", block_ns) + ] + + , (mode_str, left, right) <- replicate 2 (mode_str, left, right) ++ + replicate (if swap && take 4 mode_str /= "diff" && last mode_str /= last (init mode_str) then 2 else 0) + (init (init mode_str) ++ [last mode_str] ++ [last (init mode_str)], right, left) + ] + + all_n = fromList [1..n] + + !disj_nn = seqPair $ (all_n, fromList [n+1..n+n]) + !disj_ns = seqPair $ (all_n, fromList [n+1..n+s]) + !disj_nt = seqPair $ (all_n, fromList [n+1..n+t]) + !common_nn = seqPair $ (all_n, fromList [2,4..n]) + !common_ns = seqPair $ (all_n, fromList [0,1+n`div`s..n]) + !common_nt = seqPair $ (all_n, fromList [0,1+n`div`t..n]) + !mix_nn = seqPair $ fromLists $ partition ((== 0) . (`mod` 2)) [1..n+n] + !mix_ns = seqPair $ fromLists $ partition ((== 0) . (`mod` (1 + n`div`s))) [1..s+n] + !mix_nt = seqPair $ fromLists $ partition ((== 0) . (`mod` (1 + n`div`t))) [1..t+n] + !block_nn = seqPair $ fromLists $ partition ((< t) . (`mod` (t * 2))) [1..n+n] + !block_ns = seqPair $ fromLists $ partition ((< t) . (`mod` (t * (1 + n`div`s)))) [1..s+n] + + fromLists (xs, ys) = (fromList xs, fromList ys) + seqPair pair@(xs, ys) = xs `seq` ys `seq` pair _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
