@@ -7,8 +7,10 @@ module Main where
77import Control.Exception (handle, catch, SomeException, ErrorCall(..))
88import Control.Monad.Trans.State
99import Control.Monad.Trans.Maybe
10+import Data.Function (on, (&))
1011import Data.List
1112import Data.List.Split
13+import Data.Maybe (mapMaybe)
1214import Data.Ord (comparing)
1315import System.Environment (getArgs)
1416import Control.Monad.IO.Class (liftIO)
@@ -100,21 +102,21 @@ ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
100102------------------------------------------------------------------------------
101103
102104makeLinearGraphs :: Config -> String -> IO ()
103−makeLinearGraphs cfg inputFile = do
105+makeLinearGraphs cfg@Config{..} inputFile = do
104106 ignoringErr $ graph inputFile "generation" $ cfg
105− { title = Just "Generation"
107+ { title = (++) <$> title <*> Just " generation"
106108 , classifyBenchmark =
107109 fmap ("Streamly",) . stripPrefix "serially/generation/"
108110 }
109111
110112 ignoringErr $ graph inputFile "elimination" $ cfg
111− { title = Just "Elimination"
113+ { title = (++) <$> title <*> Just " Elimination"
112114 , classifyBenchmark =
113115 fmap ("Streamly",) . stripPrefix "serially/elimination/"
114116 }
115117
116118 ignoringErr $ graph inputFile "transformation-zip" $ cfg
117− { title = Just "Transformation & Zip"
119+ { title = (++) <$> title <*> Just " Transformation & Zip"
118120 , classifyBenchmark = \b ->
119121 if "serially/transformation/" `isPrefixOf` b
120122 || "serially/zip" `isPrefixOf` b
@@ -123,34 +125,34 @@ makeLinearGraphs cfg inputFile = do
123125 }
124126
125127 ignoringErr $ graph inputFile "filtering" $ cfg
126− { title = Just "Filtering"
128+ { title = (++) <$> title <*> Just " Filtering"
127129 , classifyBenchmark =
128130 fmap ("Streamly",) . stripPrefix "serially/filtering/"
129131 }
130132
131133 ignoringErr $ graph inputFile "transformationX4" $ cfg
132− { title = Just "Transformation x 4"
134+ { title = (++) <$> title <*> Just " Transformation x 4"
133135 , classifyBenchmark =
134136 fmap ("Streamly",) . stripPrefix "serially/transformationX4/"
135137 }
136138
137139 ignoringErr $ graph inputFile "filteringX4"
138140 $ cfg
139− { title = Just "Filtering x 4"
141+ { title = (++) <$> title <*> Just " Filtering x 4"
140142 , classifyBenchmark =
141143 fmap ("Streamly",) . stripPrefix "serially/filteringX4/"
142144 }
143145
144146 ignoringErr $ graph inputFile "mixedX4"
145147 $ cfg
146− { title = Just "Mixed x 4"
148+ { title = (++) <$> title <*> Just " Mixed x 4"
147149 , classifyBenchmark =
148150 fmap ("Streamly",) . stripPrefix "serially/mixedX4/"
149151 }
150152
151153 ignoringErr $ graph inputFile "iterated"
152154 $ cfg
153− { title = Just "Iterate 10 x 100000"
155+ { title = Just "iterate 10,000 times over 10 elems"
154156 , classifyBenchmark =
155157 fmap ("Streamly",) . stripPrefix "serially/iterated/"
156158 }
@@ -161,23 +163,61 @@ makeLinearGraphs cfg inputFile = do
161163
162164makeNestedGraphs :: Config -> String -> IO ()
163165makeNestedGraphs cfg inputFile =
164− ignoringErr $ graph inputFile "nested-serial" $ cfg
165− { title = Just "Nested serial"
166− , classifyBenchmark = \b ->
167− let ls = splitOn "/" b
168− in case head ls of
169− "serially" -> Just (head ls, last ls)
170− _ -> Nothing
166+ ignoringErr $ graph inputFile "nested-all" $ cfg
167+ { presentation = Groups Absolute
168+ , classifyBenchmark = classifyNested
169+ , selectGroups = \gs ->
170+ groupBy ((==) `on` snd) gs
171+ & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)
172+ & concat
171173 }
172174
175+ where
176+
177+ order = ["serially", "asyncly", "wAsyncly", "aheadly", "parallely"]
178+
179+ classifyNested b
180+ | "serially/" `isPrefixOf` b =
181+ ("serially",) <$> stripPrefix "serially/" b
182+ | "asyncly/" `isPrefixOf` b =
183+ ("asyncly",) <$> stripPrefix "asyncly/" b
184+ | "wAsyncly/" `isPrefixOf` b =
185+ ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
186+ | "aheadly/" `isPrefixOf` b =
187+ ("aheadly",) <$> stripPrefix "aheadly/" b
188+ | "parallely/" `isPrefixOf` b =
189+ ("parallely",) <$> stripPrefix "parallely/" b
190+ | otherwise = Nothing
191+
173192------------------------------------------------------------------------------
174193-- Charts for parallel streams
175194------------------------------------------------------------------------------
176195
177196makeLinearAsyncGraphs :: Config -> String -> IO ()
178−makeLinearAsyncGraphs cfg inputFile = do
179− putStrLn "Not implemented"
180− return ()
197+makeLinearAsyncGraphs cfg inputFile =
198+ ignoringErr $ graph inputFile "linear-async" cfg
199+ { presentation = Groups Absolute
200+ , classifyBenchmark = classifyAsync
201+ , selectGroups = \gs ->
202+ groupBy ((==) `on` snd) gs
203+ & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)
204+ & concat
205+ }
206+
207+ where
208+
209+ order = ["asyncly", "wAsyncly", "aheadly", "parallely"]
210+
211+ classifyAsync b
212+ | "asyncly/" `isPrefixOf` b =
213+ ("asyncly",) <$> stripPrefix "asyncly/" b
214+ | "wAsyncly/" `isPrefixOf` b =
215+ ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
216+ | "aheadly/" `isPrefixOf` b =
217+ ("aheadly",) <$> stripPrefix "aheadly/" b
218+ | "parallely/" `isPrefixOf` b =
219+ ("parallely",) <$> stripPrefix "parallely/" b
220+ | otherwise = Nothing
181221
182222makeLinearRateGraphs :: Config -> String -> IO ()
183223makeLinearRateGraphs cfg inputFile = do
@@ -188,18 +228,22 @@ makeLinearRateGraphs cfg inputFile = do
188228-- Reports/Charts for base streams
189229------------------------------------------------------------------------------
190230
191−classifyBase b
192− | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
193− | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
194− | otherwise = Nothing
195−
196231showStreamDVsK Options{..} cfg inp out =
197232 let cfg' = cfg { classifyBenchmark = classifyBase }
198233 in if genGraphs
199234 then ignoringErr $ graph inp "streamD-vs-streamK"
200− cfg' {outputDir = Just out}
235+ cfg' { outputDir = Just out
236+ , presentation = Groups Absolute
237+ }
201238 else ignoringErr $ report inp Nothing cfg'
202239
240+ where
241+
242+ classifyBase b
243+ | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
244+ | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
245+ | otherwise = Nothing
246+
203247showStreamD Options{..} cfg inp out =
204248 let cfg' = cfg { classifyBenchmark = classifyStreamD }
205249 in if genGraphs
@@ -258,27 +302,34 @@ main = do
258302 return ()
259303 Just opts@Options{..} ->
260304 case benchType of
261− Linear -> benchShow opts cfg makeLinearGraphs
305+ Linear -> benchShow opts cfg
306+ { title = Just "100,000 elems" }
307+ makeLinearGraphs
262308 "charts/linear/results.csv"
263309 "charts/linear"
264− LinearAsync -> benchShow opts cfg makeLinearAsyncGraphs
310+ LinearAsync -> benchShow opts cfg
311+ { title = Just "Async 10,000 elems" }
312+ makeLinearAsyncGraphs
265313 "charts/linear-async/results.csv"
266314 "charts/linear-async"
267315 LinearRate -> benchShow opts cfg makeLinearRateGraphs
268316 "charts/linear-rate/results.csv"
269317 "charts/linear-rate"
270− Nested -> benchShow opts cfg makeNestedGraphs
318+ Nested -> benchShow opts cfg
319+ { title = Just "Nested loops 100 x 100 elems" }
320+ makeNestedGraphs
271321 "charts/nested/results.csv"
272322 "charts/nested"
273− Base ->
323+ Base -> do
324+ let cfg' = cfg { title = Just "100,000 elems" }
274325 if groupDiff
275− then showStreamDVsK opts cfg
326+ then showStreamDVsK opts cfg'
276327 "charts/base/results.csv"
277328 "charts/base"
278329 else do
279− showStreamD opts cfg
330+ showStreamD opts cfg'
280331 "charts/base/results.csv"
281332 "charts/base"
282− showStreamK opts cfg
333+ showStreamK opts cfg'
283334 "charts/base/results.csv"
284335 "charts/base"