git.iko.soy/streamly
on c2aec50 help sign in
streamly/benchmark/Chart.hs
379 lines 13 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 | Base
31 | FileIO
32 | Array
33 | Concurrent
34 deriving Show
36data Options = Options
37 { genGraphs :: Bool
38 , groupDiff :: Bool
39 , benchType :: BenchType
40 } deriving Show
42defaultOptions = Options False False Linear
44setGenGraphs val = do
45 (args, opts) <- get
46 put (args, opts { genGraphs = val })
48setGroupDiff val = do
49 (args, opts) <- get
50 put (args, opts { groupDiff = val })
52setBenchType val = do
53 (args, opts) <- get
54 put (args, opts { benchType = val })
56-- Like the shell "shift" to shift the command line arguments
57shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
58shift = do
59 s <- get
60 case s of
61 ([], _) -> return Nothing
62 (x : xs, opts) -> put (xs, opts) >> return (Just x)
64parseBench :: StateT ([String], Options) (MaybeT IO) ()
65parseBench = do
66 x <- shift
67 case x of
68 Just "linear" -> setBenchType Linear
69 Just "linear-async" -> setBenchType LinearAsync
70 Just "linear-rate" -> setBenchType LinearRate
71 Just "nested" -> setBenchType Nested
72 Just "base" -> setBenchType Base
73 Just "fileio" -> setBenchType FileIO
74 Just "array" -> setBenchType Array
75 Just "concurrent" -> setBenchType Concurrent
76 Just str -> do
77 liftIO $ putStrLn $ "unrecognized benchmark type " <> str
78 mzero
79 Nothing -> do
80 liftIO $ putStrLn "please provide a benchmark type "
81 mzero
83-- totally imperative style option parsing
84parseOptions :: IO (Maybe Options)
85parseOptions = do
86 args <- getArgs
87 runMaybeT $ flip evalStateT (args, defaultOptions) $ do
88 parseLoop
89 fmap snd get
91 where
93 parseOpt opt =
94 case opt of
95 "--graphs" -> setGenGraphs True
96 "--group-diff" -> setGroupDiff True
97 "--benchmark" -> parseBench
98 str -> do
99 liftIO $ putStrLn $ "Unrecognized option " <> str
100 mzero
102 parseLoop = do
103 next <- shift
104 case next of
105 Just opt -> parseOpt opt >> parseLoop
106 Nothing -> return ()
108ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
109 putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
111------------------------------------------------------------------------------
112-- Linear composition charts
113------------------------------------------------------------------------------
115makeLinearGraphs :: Config -> String -> IO ()
116makeLinearGraphs cfg@Config{..} inputFile = do
117 ignoringErr $ graph inputFile "generation" $ cfg
118 { title = (++) <$> title <*> Just " generation"
119 , classifyBenchmark =
120 fmap ("Streamly",) . stripPrefix "serially/generation/"
121 }
123 ignoringErr $ graph inputFile "elimination" $ cfg
124 { title = (++) <$> title <*> Just " Elimination"
125 , classifyBenchmark =
126 fmap ("Streamly",) . stripPrefix "serially/elimination/"
127 }
129 ignoringErr $ graph inputFile "transformation-zip" $ cfg
130 { title = (++) <$> title <*> Just " Transformation & Zip"
131 , classifyBenchmark = \b ->
132 if "serially/transformation/" `isPrefixOf` b
133 || "serially/zipping" `isPrefixOf` b
134 then Just ("Streamly", last $ splitOn "/" b)
135 else Nothing
136 }
138 ignoringErr $ graph inputFile "filtering" $ cfg
139 { title = (++) <$> title <*> Just " Filtering"
140 , classifyBenchmark =
141 fmap ("Streamly",) . stripPrefix "serially/filtering/"
142 }
144 ignoringErr $ graph inputFile "transformationX4" $ cfg
145 { title = (++) <$> title <*> Just " Transformation x 4"
146 , classifyBenchmark =
147 fmap ("Streamly",) . stripPrefix "serially/transformationX4/"
148 }
150 ignoringErr $ graph inputFile "filteringX4"
151 $ cfg
152 { title = (++) <$> title <*> Just " Filtering x 4"
153 , classifyBenchmark =
154 fmap ("Streamly",) . stripPrefix "serially/filteringX4/"
155 }
157 ignoringErr $ graph inputFile "mixedX4"
158 $ cfg
159 { title = (++) <$> title <*> Just " Mixed x 4"
160 , classifyBenchmark =
161 fmap ("Streamly",) . stripPrefix "serially/mixedX4/"
162 }
164 ignoringErr $ graph inputFile "iterated"
165 $ cfg
166 { title = Just "iterate 10,000 times over 10 elems"
167 , classifyBenchmark =
168 fmap ("Streamly",) . stripPrefix "serially/iterated/"
169 }
171------------------------------------------------------------------------------
172-- Nested composition charts
173------------------------------------------------------------------------------
175makeNestedGraphs :: Config -> String -> IO ()
176makeNestedGraphs cfg inputFile =
177 ignoringErr $ graph inputFile "nested-all" $ cfg
178 { presentation = Groups Absolute
179 , classifyBenchmark = classifyNested
180 , selectGroups = \gs ->
181 groupBy ((==) `on` snd) gs
182 & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)
183 & concat
184 }
186 where
188 order = ["serially", "asyncly", "wAsyncly", "aheadly", "parallely"]
190 classifyNested b
191 | "serially/" `isPrefixOf` b =
192 ("serially",) <$> stripPrefix "serially/" b
193 | "asyncly/" `isPrefixOf` b =
194 ("asyncly",) <$> stripPrefix "asyncly/" b
195 | "wAsyncly/" `isPrefixOf` b =
196 ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
197 | "aheadly/" `isPrefixOf` b =
198 ("aheadly",) <$> stripPrefix "aheadly/" b
199 | "parallely/" `isPrefixOf` b =
200 ("parallely",) <$> stripPrefix "parallely/" b
201 | otherwise = Nothing
203------------------------------------------------------------------------------
204-- Charts for parallel streams
205------------------------------------------------------------------------------
207makeLinearAsyncGraphs :: Config -> String -> IO ()
208makeLinearAsyncGraphs cfg inputFile =
209 ignoringErr $ graph inputFile "linear-async" cfg
210 { presentation = Groups Absolute
211 , classifyBenchmark = classifyAsync
212 , selectGroups = \gs ->
213 groupBy ((==) `on` snd) gs
214 & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)
215 & concat
216 }
218 where
220 order = ["asyncly", "wAsyncly", "aheadly", "parallely"]
222 classifyAsync b
223 | "asyncly/" `isPrefixOf` b =
224 ("asyncly",) <$> stripPrefix "asyncly/" b
225 | "wAsyncly/" `isPrefixOf` b =
226 ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
227 | "aheadly/" `isPrefixOf` b =
228 ("aheadly",) <$> stripPrefix "aheadly/" b
229 | "parallely/" `isPrefixOf` b =
230 ("parallely",) <$> stripPrefix "parallely/" b
231 | otherwise = Nothing
233makeLinearRateGraphs :: Config -> String -> IO ()
234makeLinearRateGraphs cfg inputFile = do
235 putStrLn "Not implemented"
236 return ()
238------------------------------------------------------------------------------
239-- FileIO
240------------------------------------------------------------------------------
242makeFileIOGraphs :: Config -> String -> IO ()
243makeFileIOGraphs cfg@Config{..} inputFile =
244 ignoringErr $ graph inputFile "fileIO" cfg
246makeArrayGraphs :: Config -> String -> IO ()
247makeArrayGraphs cfg@Config{..} inputFile =
248 ignoringErr $ graph inputFile "array" cfg
250makeConcurrentGraphs :: Config -> String -> IO ()
251makeConcurrentGraphs cfg@Config{..} inputFile =
252 ignoringErr $ graph inputFile "concurrent" cfg
254------------------------------------------------------------------------------
255-- Reports/Charts for base streams
256------------------------------------------------------------------------------
258showStreamDVsK Options{..} cfg inp out =
259 let cfg' = cfg { classifyBenchmark = classifyBase }
260 in if genGraphs
261 then ignoringErr $ graph inp "streamD-vs-streamK"
262 cfg' { outputDir = Just out
263 , presentation = Groups Absolute
264 }
265 else ignoringErr $ report inp Nothing cfg'
267 where
269 classifyBase b
270 | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
271 | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
272 | otherwise = Nothing
274showStreamD Options{..} cfg inp out =
275 let cfg' = cfg { classifyBenchmark = classifyStreamD }
276 in if genGraphs
277 then ignoringErr $ graph inp "streamD"
278 cfg' {outputDir = Just out}
279 else ignoringErr $ report inp Nothing cfg'
281 where
283 classifyStreamD b
284 | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
285 | otherwise = Nothing
287showStreamK Options{..} cfg inp out =
288 let cfg' = cfg { classifyBenchmark = classifyStreamK }
289 in if genGraphs
290 then ignoringErr $ graph inp "streamK"
291 cfg' {outputDir = Just out}
292 else ignoringErr $ report inp Nothing cfg'
294 where
296 classifyStreamK b
297 | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
298 | otherwise = Nothing
300------------------------------------------------------------------------------
301-- text reports
302------------------------------------------------------------------------------
304selectBench
305 :: (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
306 -> [String]
307selectBench f =
308 reverse
309 $ fmap fst
310 $ either
311 (const $ either error (sortOn snd) $ f (ColumnIndex 0) (Just PercentDiff))
312 (sortOn snd)
313 $ f (ColumnIndex 1) (Just PercentDiff)
315benchShow Options{..} cfg func inp out =
316 if genGraphs
317 then func cfg {outputDir = Just out} inp
318 else ignoringErr $ report inp Nothing cfg
320main :: IO ()
321main = do
322 let cfg = defaultConfig
323 { presentation = Groups PercentDiff
324 , selectBenchmarks = selectBench
325 }
326 res <- parseOptions
328 case res of
329 Nothing -> do
330 putStrLn "cannot parse options"
331 return ()
332 Just opts@Options{..} ->
333 case benchType of
334 Linear -> benchShow opts cfg
335 { title = Just "100,000 elems" }
336 makeLinearGraphs
337 "charts/linear/results.csv"
338 "charts/linear"
339 LinearAsync -> benchShow opts cfg
340 { title = Just "Async 10,000 elems" }
341 makeLinearAsyncGraphs
342 "charts/linear-async/results.csv"
343 "charts/linear-async"
344 LinearRate -> benchShow opts cfg makeLinearRateGraphs
345 "charts/linear-rate/results.csv"
346 "charts/linear-rate"
347 Nested -> benchShow opts cfg
348 { title = Just "Nested loops 100 x 100 elems" }
349 makeNestedGraphs
350 "charts/nested/results.csv"
351 "charts/nested"
352 FileIO -> benchShow opts cfg
353 { title = Just "File IO" }
354 makeFileIOGraphs
355 "charts/fileio/results.csv"
356 "charts/fileio"
357 Array -> benchShow opts cfg
358 { title = Just "Array" }
359 makeArrayGraphs
360 "charts/array/results.csv"
361 "charts/array"
362 Concurrent -> benchShow opts cfg
363 { title = Just "Concurrent Ops" }
364 makeConcurrentGraphs
365 "charts/concurrent/results.csv"
366 "charts/concurrent"
367 Base -> do
368 let cfg' = cfg { title = Just "100,000 elems" }
369 if groupDiff
370 then showStreamDVsK opts cfg'
371 "charts/base/results.csv"
372 "charts/base"
373 else do
374 showStreamD opts cfg'
375 "charts/base/results.csv"
376 "charts/base"
377 showStreamK opts cfg'
378 "charts/base/results.csv"
379 "charts/base"