git.iko.soy/streamly
on d161b05 help sign in
streamly/benchmark/Chart.hs
349 lines 12 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 = Linear | LinearAsync | LinearRate | Nested | Base | FileIO
26 deriving Show
28data Options = Options
29 { genGraphs :: Bool
30 , groupDiff :: Bool
31 , benchType :: BenchType
32 } deriving Show
34defaultOptions = Options False False Linear
36setGenGraphs val = do
37 (args, opts) <- get
38 put (args, opts { genGraphs = val })
40setGroupDiff val = do
41 (args, opts) <- get
42 put (args, opts { groupDiff = val })
44setBenchType val = do
45 (args, opts) <- get
46 put (args, opts { benchType = val })
48-- Like the shell "shift" to shift the command line arguments
49shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
50shift = do
51 s <- get
52 case s of
53 ([], _) -> return Nothing
54 (x : xs, opts) -> put (xs, opts) >> return (Just x)
56parseBench :: StateT ([String], Options) (MaybeT IO) ()
57parseBench = do
58 x <- shift
59 case x of
60 Just "linear" -> setBenchType Linear
61 Just "linear-async" -> setBenchType LinearAsync
62 Just "linear-rate" -> setBenchType LinearRate
63 Just "nested" -> setBenchType Nested
64 Just "base" -> setBenchType Base
65 Just "fileio" -> setBenchType FileIO
66 Just str -> do
67 liftIO $ putStrLn $ "unrecognized benchmark type " <> str
68 mzero
69 Nothing -> do
70 liftIO $ putStrLn "please provide a benchmark type "
71 mzero
73-- totally imperative style option parsing
74parseOptions :: IO (Maybe Options)
75parseOptions = do
76 args <- getArgs
77 runMaybeT $ flip evalStateT (args, defaultOptions) $ do
78 parseLoop
79 fmap snd get
81 where
83 parseOpt opt =
84 case opt of
85 "--graphs" -> setGenGraphs True
86 "--group-diff" -> setGroupDiff True
87 "--benchmark" -> parseBench
88 str -> do
89 liftIO $ putStrLn $ "Unrecognized option " <> str
90 mzero
92 parseLoop = do
93 next <- shift
94 case next of
95 Just opt -> parseOpt opt >> parseLoop
96 Nothing -> return ()
98ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
99 putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
101------------------------------------------------------------------------------
102-- Linear composition charts
103------------------------------------------------------------------------------
105makeLinearGraphs :: Config -> String -> IO ()
106makeLinearGraphs cfg@Config{..} inputFile = do
107 ignoringErr $ graph inputFile "generation" $ cfg
108 { title = (++) <$> title <*> Just " generation"
109 , classifyBenchmark =
110 fmap ("Streamly",) . stripPrefix "serially/generation/"
111 }
113 ignoringErr $ graph inputFile "elimination" $ cfg
114 { title = (++) <$> title <*> Just " Elimination"
115 , classifyBenchmark =
116 fmap ("Streamly",) . stripPrefix "serially/elimination/"
117 }
119 ignoringErr $ graph inputFile "transformation-zip" $ cfg
120 { title = (++) <$> title <*> Just " Transformation & Zip"
121 , classifyBenchmark = \b ->
122 if "serially/transformation/" `isPrefixOf` b
123 || "serially/zipping" `isPrefixOf` b
124 then Just ("Streamly", last $ splitOn "/" b)
125 else Nothing
126 }
128 ignoringErr $ graph inputFile "filtering" $ cfg
129 { title = (++) <$> title <*> Just " Filtering"
130 , classifyBenchmark =
131 fmap ("Streamly",) . stripPrefix "serially/filtering/"
132 }
134 ignoringErr $ graph inputFile "transformationX4" $ cfg
135 { title = (++) <$> title <*> Just " Transformation x 4"
136 , classifyBenchmark =
137 fmap ("Streamly",) . stripPrefix "serially/transformationX4/"
138 }
140 ignoringErr $ graph inputFile "filteringX4"
141 $ cfg
142 { title = (++) <$> title <*> Just " Filtering x 4"
143 , classifyBenchmark =
144 fmap ("Streamly",) . stripPrefix "serially/filteringX4/"
145 }
147 ignoringErr $ graph inputFile "mixedX4"
148 $ cfg
149 { title = (++) <$> title <*> Just " Mixed x 4"
150 , classifyBenchmark =
151 fmap ("Streamly",) . stripPrefix "serially/mixedX4/"
152 }
154 ignoringErr $ graph inputFile "iterated"
155 $ cfg
156 { title = Just "iterate 10,000 times over 10 elems"
157 , classifyBenchmark =
158 fmap ("Streamly",) . stripPrefix "serially/iterated/"
159 }
161------------------------------------------------------------------------------
162-- Nested composition charts
163------------------------------------------------------------------------------
165makeNestedGraphs :: Config -> String -> IO ()
166makeNestedGraphs cfg inputFile =
167 ignoringErr $ graph inputFile "nested-all" $ cfg
168 { presentation = Groups Absolute
169 , classifyBenchmark = classifyNested
170 , selectGroups = \gs ->
171 groupBy ((==) `on` snd) gs
172 & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)
173 & concat
174 }
176 where
178 order = ["serially", "asyncly", "wAsyncly", "aheadly", "parallely"]
180 classifyNested b
181 | "serially/" `isPrefixOf` b =
182 ("serially",) <$> stripPrefix "serially/" b
183 | "asyncly/" `isPrefixOf` b =
184 ("asyncly",) <$> stripPrefix "asyncly/" b
185 | "wAsyncly/" `isPrefixOf` b =
186 ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
187 | "aheadly/" `isPrefixOf` b =
188 ("aheadly",) <$> stripPrefix "aheadly/" b
189 | "parallely/" `isPrefixOf` b =
190 ("parallely",) <$> stripPrefix "parallely/" b
191 | otherwise = Nothing
193------------------------------------------------------------------------------
194-- Charts for parallel streams
195------------------------------------------------------------------------------
197makeLinearAsyncGraphs :: Config -> String -> IO ()
198makeLinearAsyncGraphs cfg inputFile =
199 ignoringErr $ graph inputFile "linear-async" cfg
200 { presentation = Groups Absolute
201 , classifyBenchmark = classifyAsync
202 , selectGroups = \gs ->
203 groupBy ((==) `on` snd) gs
204 & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)
205 & concat
206 }
208 where
210 order = ["asyncly", "wAsyncly", "aheadly", "parallely"]
212 classifyAsync b
213 | "asyncly/" `isPrefixOf` b =
214 ("asyncly",) <$> stripPrefix "asyncly/" b
215 | "wAsyncly/" `isPrefixOf` b =
216 ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
217 | "aheadly/" `isPrefixOf` b =
218 ("aheadly",) <$> stripPrefix "aheadly/" b
219 | "parallely/" `isPrefixOf` b =
220 ("parallely",) <$> stripPrefix "parallely/" b
221 | otherwise = Nothing
223makeLinearRateGraphs :: Config -> String -> IO ()
224makeLinearRateGraphs cfg inputFile = do
225 putStrLn "Not implemented"
226 return ()
228------------------------------------------------------------------------------
229-- FileIO
230------------------------------------------------------------------------------
232makeFileIOGraphs :: Config -> String -> IO ()
233makeFileIOGraphs cfg@Config{..} inputFile =
234 ignoringErr $ graph inputFile "fileIO" cfg
236------------------------------------------------------------------------------
237-- Reports/Charts for base streams
238------------------------------------------------------------------------------
240showStreamDVsK Options{..} cfg inp out =
241 let cfg' = cfg { classifyBenchmark = classifyBase }
242 in if genGraphs
243 then ignoringErr $ graph inp "streamD-vs-streamK"
244 cfg' { outputDir = Just out
245 , presentation = Groups Absolute
246 }
247 else ignoringErr $ report inp Nothing cfg'
249 where
251 classifyBase b
252 | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
253 | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
254 | otherwise = Nothing
256showStreamD Options{..} cfg inp out =
257 let cfg' = cfg { classifyBenchmark = classifyStreamD }
258 in if genGraphs
259 then ignoringErr $ graph inp "streamD"
260 cfg' {outputDir = Just out}
261 else ignoringErr $ report inp Nothing cfg'
263 where
265 classifyStreamD b
266 | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
267 | otherwise = Nothing
269showStreamK Options{..} cfg inp out =
270 let cfg' = cfg { classifyBenchmark = classifyStreamK }
271 in if genGraphs
272 then ignoringErr $ graph inp "streamK"
273 cfg' {outputDir = Just out}
274 else ignoringErr $ report inp Nothing cfg'
276 where
278 classifyStreamK b
279 | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
280 | otherwise = Nothing
282------------------------------------------------------------------------------
283-- text reports
284------------------------------------------------------------------------------
286selectBench :: (SortColumn -> Either String [(String, Double)]) -> [String]
287selectBench f =
288 reverse
289 $ fmap fst
290 $ either
291 (const $ either error (sortOn snd) $ f $ ColumnIndex 0)
292 (sortOn snd)
293 $ f $ ColumnIndex 1
295benchShow Options{..} cfg func inp out =
296 if genGraphs
297 then func cfg {outputDir = Just out} inp
298 else ignoringErr $ report inp Nothing cfg
300main :: IO ()
301main = do
302 let cfg = defaultConfig
303 { presentation = Groups PercentDiff
304 , selectBenchmarks = selectBench
305 }
306 res <- parseOptions
308 case res of
309 Nothing -> do
310 putStrLn "cannot parse options"
311 return ()
312 Just opts@Options{..} ->
313 case benchType of
314 Linear -> benchShow opts cfg
315 { title = Just "100,000 elems" }
316 makeLinearGraphs
317 "charts/linear/results.csv"
318 "charts/linear"
319 LinearAsync -> benchShow opts cfg
320 { title = Just "Async 10,000 elems" }
321 makeLinearAsyncGraphs
322 "charts/linear-async/results.csv"
323 "charts/linear-async"
324 LinearRate -> benchShow opts cfg makeLinearRateGraphs
325 "charts/linear-rate/results.csv"
326 "charts/linear-rate"
327 Nested -> benchShow opts cfg
328 { title = Just "Nested loops 100 x 100 elems" }
329 makeNestedGraphs
330 "charts/nested/results.csv"
331 "charts/nested"
332 FileIO -> benchShow opts cfg
333 { title = Just "File IO" }
334 makeFileIOGraphs
335 "charts/fileio/results.csv"
336 "charts/fileio"
337 Base -> do
338 let cfg' = cfg { title = Just "100,000 elems" }
339 if groupDiff
340 then showStreamDVsK opts cfg'
341 "charts/base/results.csv"
342 "charts/base"
343 else do
344 showStreamD opts cfg'
345 "charts/base/results.csv"
346 "charts/base"
347 showStreamK opts cfg'
348 "charts/base/results.csv"
349 "charts/base"