git.iko.soy/streamly
on 8ec2ebe help sign in
streamly/benchmark/Chart.hs
386 lines 14 kB history raw
1{-# LANGUAGE TupleSections #-}
2{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE ScopedTypeVariables #-}
5module Main where
7import Control.Exception (handle, catch, SomeException, ErrorCall(..))
8import Control.Monad.Trans.State
9import Control.Monad.Trans.Maybe
10import Data.Function (on, (&))
11import Data.List
12import Data.List.Split
13import Data.Maybe (mapMaybe)
14import Data.Ord (comparing)
15import System.Environment (getArgs)
16import Control.Monad.IO.Class (liftIO)
17import Control.Monad (mzero)
19import BenchShow
21------------------------------------------------------------------------------
22-- Command line parsing
23------------------------------------------------------------------------------
25data BenchType
26 = Linear
27 | LinearAsync
28 | LinearRate
29 | Nested
30 | NestedConcurrent
31 | Base
32 | FileIO
33 | Array
34 | Concurrent
35 deriving Show
37data Options = Options
38 { genGraphs :: Bool
39 , groupDiff :: Bool
40 , benchType :: BenchType
41 } deriving Show
43defaultOptions = Options False False Linear
45setGenGraphs val = do
46 (args, opts) <- get
47 put (args, opts { genGraphs = val })
49setGroupDiff val = do
50 (args, opts) <- get
51 put (args, opts { groupDiff = val })
53setBenchType val = do
54 (args, opts) <- get
55 put (args, opts { benchType = val })
57-- Like the shell "shift" to shift the command line arguments
58shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
59shift = do
60 s <- get
61 case s of
62 ([], _) -> return Nothing
63 (x : xs, opts) -> put (xs, opts) >> return (Just x)
65parseBench :: StateT ([String], Options) (MaybeT IO) ()
66parseBench = do
67 x <- shift
68 case x of
69 Just "linear" -> setBenchType Linear
70 Just "linear-async" -> setBenchType LinearAsync
71 Just "linear-rate" -> setBenchType LinearRate
72 Just "nested" -> setBenchType Nested
73 Just "nested-concurrent" -> setBenchType NestedConcurrent
74 Just "base" -> setBenchType Base
75 Just "fileio" -> setBenchType FileIO
76 Just "array" -> setBenchType Array
77 Just "concurrent" -> setBenchType Concurrent
78 Just str -> do
79 liftIO $ putStrLn $ "unrecognized benchmark type " <> str
80 mzero
81 Nothing -> do
82 liftIO $ putStrLn "please provide a benchmark type "
83 mzero
85-- totally imperative style option parsing
86parseOptions :: IO (Maybe Options)
87parseOptions = do
88 args <- getArgs
89 runMaybeT $ flip evalStateT (args, defaultOptions) $ do
90 parseLoop
91 fmap snd get
93 where
95 parseOpt opt =
96 case opt of
97 "--graphs" -> setGenGraphs True
98 "--group-diff" -> setGroupDiff True
99 "--benchmark" -> parseBench
100 str -> do
101 liftIO $ putStrLn $ "Unrecognized option " <> str
102 mzero
104 parseLoop = do
105 next <- shift
106 case next of
107 Just opt -> parseOpt opt >> parseLoop
108 Nothing -> return ()
110ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
111 putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
113------------------------------------------------------------------------------
114-- Linear composition charts
115------------------------------------------------------------------------------
117makeLinearGraphs :: Config -> String -> IO ()
118makeLinearGraphs cfg@Config{..} inputFile = do
119 ignoringErr $ graph inputFile "generation" $ cfg
120 { title = (++) <$> title <*> Just " generation"
121 , classifyBenchmark =
122 fmap ("Streamly",) . stripPrefix "serially/generation/"
123 }
125 ignoringErr $ graph inputFile "elimination" $ cfg
126 { title = (++) <$> title <*> Just " Elimination"
127 , classifyBenchmark =
128 fmap ("Streamly",) . stripPrefix "serially/elimination/"
129 }
131 ignoringErr $ graph inputFile "transformation-zip" $ cfg
132 { title = (++) <$> title <*> Just " Transformation & Zip"
133 , classifyBenchmark = \b ->
134 if "serially/transformation/" `isPrefixOf` b
135 || "serially/zipping" `isPrefixOf` b
136 then Just ("Streamly", last $ splitOn "/" b)
137 else Nothing
138 }
140 ignoringErr $ graph inputFile "filtering" $ cfg
141 { title = (++) <$> title <*> Just " Filtering"
142 , classifyBenchmark =
143 fmap ("Streamly",) . stripPrefix "serially/filtering/"
144 }
146 ignoringErr $ graph inputFile "transformationX4" $ cfg
147 { title = (++) <$> title <*> Just " Transformation x 4"
148 , classifyBenchmark =
149 fmap ("Streamly",) . stripPrefix "serially/transformationX4/"
150 }
152 ignoringErr $ graph inputFile "filteringX4"
153 $ cfg
154 { title = (++) <$> title <*> Just " Filtering x 4"
155 , classifyBenchmark =
156 fmap ("Streamly",) . stripPrefix "serially/filteringX4/"
157 }
159 ignoringErr $ graph inputFile "mixedX4"
160 $ cfg
161 { title = (++) <$> title <*> Just " Mixed x 4"
162 , classifyBenchmark =
163 fmap ("Streamly",) . stripPrefix "serially/mixedX4/"
164 }
166 ignoringErr $ graph inputFile "iterated"
167 $ cfg
168 { title = Just "iterate 10,000 times over 10 elems"
169 , classifyBenchmark =
170 fmap ("Streamly",) . stripPrefix "serially/iterated/"
171 }
173------------------------------------------------------------------------------
174-- Nested composition charts
175------------------------------------------------------------------------------
177makeNestedGraphs :: Config -> String -> IO ()
178makeNestedGraphs cfg inputFile =
179 ignoringErr $ graph inputFile "nested-all" $ cfg
180 { presentation = Groups Absolute
181 , classifyBenchmark = classifyNested
182 , selectGroups = \gs ->
183 groupBy ((==) `on` snd) gs
184 & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)
185 & concat
186 }
188 where
190 order = ["serially", "asyncly", "wAsyncly", "aheadly", "parallely"]
192 classifyNested b
193 | "serially/" `isPrefixOf` b =
194 ("serially",) <$> stripPrefix "serially/" b
195 | "asyncly/" `isPrefixOf` b =
196 ("asyncly",) <$> stripPrefix "asyncly/" b
197 | "wAsyncly/" `isPrefixOf` b =
198 ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
199 | "aheadly/" `isPrefixOf` b =
200 ("aheadly",) <$> stripPrefix "aheadly/" b
201 | "parallely/" `isPrefixOf` b =
202 ("parallely",) <$> stripPrefix "parallely/" b
203 | otherwise = Nothing
205------------------------------------------------------------------------------
206-- Charts for parallel streams
207------------------------------------------------------------------------------
209makeLinearAsyncGraphs :: Config -> String -> IO ()
210makeLinearAsyncGraphs cfg inputFile =
211 ignoringErr $ graph inputFile "linear-async" cfg
212 { presentation = Groups Absolute
213 , classifyBenchmark = classifyAsync
214 , selectGroups = \gs ->
215 groupBy ((==) `on` snd) gs
216 & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)
217 & concat
218 }
220 where
222 order = ["asyncly", "wAsyncly", "aheadly", "parallely"]
224 classifyAsync b
225 | "asyncly/" `isPrefixOf` b =
226 ("asyncly",) <$> stripPrefix "asyncly/" b
227 | "wAsyncly/" `isPrefixOf` b =
228 ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
229 | "aheadly/" `isPrefixOf` b =
230 ("aheadly",) <$> stripPrefix "aheadly/" b
231 | "parallely/" `isPrefixOf` b =
232 ("parallely",) <$> stripPrefix "parallely/" b
233 | otherwise = Nothing
235makeLinearRateGraphs :: Config -> String -> IO ()
236makeLinearRateGraphs cfg inputFile = do
237 putStrLn "Not implemented"
238 return ()
240------------------------------------------------------------------------------
241-- FileIO
242------------------------------------------------------------------------------
244makeFileIOGraphs :: Config -> String -> IO ()
245makeFileIOGraphs cfg@Config{..} inputFile =
246 ignoringErr $ graph inputFile "fileIO" cfg
248makeArrayGraphs :: Config -> String -> IO ()
249makeArrayGraphs cfg@Config{..} inputFile =
250 ignoringErr $ graph inputFile "array" cfg
252makeConcurrentGraphs :: Config -> String -> IO ()
253makeConcurrentGraphs cfg@Config{..} inputFile =
254 ignoringErr $ graph inputFile "concurrent" cfg
256------------------------------------------------------------------------------
257-- Reports/Charts for base streams
258------------------------------------------------------------------------------
260showStreamDVsK Options{..} cfg inp out =
261 let cfg' = cfg { classifyBenchmark = classifyBase }
262 in if genGraphs
263 then ignoringErr $ graph inp "streamD-vs-streamK"
264 cfg' { outputDir = Just out
265 , presentation = Groups Absolute
266 }
267 else ignoringErr $ report inp Nothing cfg'
269 where
271 classifyBase b
272 | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
273 | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
274 | otherwise = Nothing
276showStreamD Options{..} cfg inp out =
277 let cfg' = cfg { classifyBenchmark = classifyStreamD }
278 in if genGraphs
279 then ignoringErr $ graph inp "streamD"
280 cfg' {outputDir = Just out}
281 else ignoringErr $ report inp Nothing cfg'
283 where
285 classifyStreamD b
286 | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
287 | otherwise = Nothing
289showStreamK Options{..} cfg inp out =
290 let cfg' = cfg { classifyBenchmark = classifyStreamK }
291 in if genGraphs
292 then ignoringErr $ graph inp "streamK"
293 cfg' {outputDir = Just out}
294 else ignoringErr $ report inp Nothing cfg'
296 where
298 classifyStreamK b
299 | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
300 | otherwise = Nothing
302------------------------------------------------------------------------------
303-- text reports
304------------------------------------------------------------------------------
306selectBench
307 :: (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
308 -> [String]
309selectBench f =
310 reverse
311 $ fmap fst
312 $ either
313 (const $ either error (sortOn snd) $ f (ColumnIndex 0) (Just PercentDiff))
314 (sortOn snd)
315 $ f (ColumnIndex 1) (Just PercentDiff)
317benchShow Options{..} cfg func inp out =
318 if genGraphs
319 then func cfg {outputDir = Just out} inp
320 else ignoringErr $ report inp Nothing cfg
322main :: IO ()
323main = do
324 let cfg = defaultConfig
325 { presentation = Groups PercentDiff
326 , selectBenchmarks = selectBench
327 }
328 res <- parseOptions
330 case res of
331 Nothing -> do
332 putStrLn "cannot parse options"
333 return ()
334 Just opts@Options{..} ->
335 case benchType of
336 Linear -> benchShow opts cfg
337 { title = Just "100,000 elems" }
338 makeLinearGraphs
339 "charts/linear/results.csv"
340 "charts/linear"
341 LinearAsync -> benchShow opts cfg
342 { title = Just "Async 10,000 elems" }
343 makeLinearAsyncGraphs
344 "charts/linear-async/results.csv"
345 "charts/linear-async"
346 LinearRate -> benchShow opts cfg makeLinearRateGraphs
347 "charts/linear-rate/results.csv"
348 "charts/linear-rate"
349 Nested -> benchShow opts cfg
350 { title = Just "Nested loops 316 x 316 elems" }
351 makeNestedGraphs
352 "charts/nested/results.csv"
353 "charts/nested"
354 NestedConcurrent -> benchShow opts cfg
355 { title = Just "Nested concurrent loops 316 x 316 elems" }
356 makeNestedGraphs
357 "charts/nested-concurrent/results.csv"
358 "charts/nested-concurrent"
359 FileIO -> benchShow opts cfg
360 { title = Just "File IO" }
361 makeFileIOGraphs
362 "charts/fileio/results.csv"
363 "charts/fileio"
364 Array -> benchShow opts cfg
365 { title = Just "Array" }
366 makeArrayGraphs
367 "charts/array/results.csv"
368 "charts/array"
369 Concurrent -> benchShow opts cfg
370 { title = Just "Concurrent Ops" }
371 makeConcurrentGraphs
372 "charts/concurrent/results.csv"
373 "charts/concurrent"
374 Base -> do
375 let cfg' = cfg { title = Just "100,000 elems" }
376 if groupDiff
377 then showStreamDVsK opts cfg'
378 "charts/base/results.csv"
379 "charts/base"
380 else do
381 showStreamD opts cfg'
382 "charts/base/results.csv"
383 "charts/base"
384 showStreamK opts cfg'
385 "charts/base/results.csv"
386 "charts/base"