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