@@ -0,0 +1,151 @@
1+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
2+
3+import Data.Char
4+import Control.Monad (forM_)
5+import Data.Accessor ((^=))
6+import Data.Function
7+import Data.Maybe
8+import Data.List
9+import Debug.Trace
10+import Data.Text (Text)
11+import Data.Text.Encoding (decodeUtf8)
12+import Graphics.Rendering.Chart
13+import Graphics.Rendering.Chart.Gtk (renderableToWindow)
14+import System.Environment (getArgs)
15+import Text.Printf
16+import qualified Data.ByteString as B
17+import qualified Data.Map as M
18+import qualified Data.Text as T
19+
20+data Row = Row {
21+ rowName :: !Text
22+ , rowMean :: !Double
23+ , rowMeanLB :: !Double
24+ , rowMeanUB :: !Double
25+ , rowStdDev :: !Double
26+ , rowStdDevLB :: !Double
27+ , rowStdDevUB :: !Double
28+ } deriving (Show)
29+
30+parseRow :: Text -> Row
31+parseRow = f . T.split ","
32+ where f [n,m,ml,mu,s,sl,su] = Row {
33+ rowName = n
34+ , rowMean = r m
35+ , rowMeanLB = r ml
36+ , rowMeanUB = r mu
37+ , rowStdDev = r s
38+ , rowStdDevLB = r sl
39+ , rowStdDevUB = r su
40+ }
41+ r = read . T.unpack
42+
43+readCSV :: FilePath -> IO [Row]
44+readCSV = fmap (map parseRow . tail . T.lines . decodeUtf8) . B.readFile
45+
46+groupRows :: [Row] -> M.Map Text [Row]
47+groupRows = M.map (sortBy (compare `on` rowName)) . foldr f M.empty
48+ where f r m = let (p,s) = T.breakEnd "/" (rowName r)
49+ in M.insertWith' (++) (T.init . T.tail $ p)
50+ [r { rowName = T.init s}] m
51+
52+main = do
53+ args <- getArgs
54+ forM_ args $ \arg -> do
55+ d <- groupRows `fmap` readCSV arg
56+ forM_ (M.toList d) $ \(tdesc,rows) -> do
57+ let desc = T.unpack tdesc
58+ --renderableToWindow (renderMark desc rows) 400 160
59+ renderableToPNGFile (renderMark desc rows) 400 160
60+ (printf "time-%s.png" (map clean desc))
61+ where clean '/' = '-'
62+ clean c | isSpace c = '-'
63+ | otherwise = c
64+
65+instance BarsPlotValue LogValue where
66+ barsReference = LogValue 1e-300
67+ barsAdd (LogValue a) (LogValue b) = LogValue (a * b)
68+
69+renderMark :: String -> [Row] -> Renderable ()
70+renderMark desc rows
71+ | minimum values * 50 >= maximum values = toRenderable linLayout
72+ | otherwise = toRenderable logLayout
73+ where
74+ values = map rowMean rows
75+ keys = map git rows
76+ where git r = let n = T.unpack . rowName $ r
77+ in maybe n id . flip lookup mappings $ n
78+ mappings = [("bl", "lazy BS"), ("bs", "strict BS"), ("l", "list"),
79+ ("tl", "lazy T"), ("ts", "strict T")]
80+
81+ linLayout = layout1_title ^= "Timings for \"" ++ desc ++ "\""
82+ $ layout1_plots ^= [ Left (plotBars linBars) ]
83+ $ layout1_left_axis ^= linLeftAxis
84+ $ layout1_bottom_axis ^= bottomAxis
85+ $ defaultLayout1 :: Layout1 Double Double
86+
87+ logLayout = layout1_title ^= "Timings for \"" ++ desc ++
88+ "\" (log scale)"
89+ $ layout1_plots ^= [ Left (plotBars logBars) ]
90+ $ layout1_left_axis ^= logLeftAxis
91+ $ layout1_bottom_axis ^= bottomAxis
92+ $ defaultLayout1 :: Layout1 Double LogValue
93+
94+ logLeftAxis = laxis_generate ^= autoScaledLogAxis logSecAxis
95+ $ laxis_reverse ^= False
96+ $ defaultLayoutAxis
97+
98+ linLeftAxis = laxis_generate ^= autoScaledAxis linSecAxis
99+ $ defaultLayoutAxis
100+
101+ bottomAxis = laxis_generate ^= autoScaledAxis typeAxis
102+ $ defaultLayoutAxis
103+
104+ linBars = plot_bars_values ^= (zip [0.5,1.5..] . map (:[]) $ values)
105+ $ defaultPlotBars
106+
107+ logBars = plot_bars_values ^= (zip [0.5,1.5..] . map ((:[]) . LogValue) $ values)
108+ $ defaultPlotBars
109+
110+ typeAxis = la_labelf ^= (ix keys . floor)
111+ $ la_nLabels ^= length keys
112+ $ defaultLinearAxis
113+
114+ ix (x:xs) n | n <= 0 = x
115+ | otherwise = ix xs (n-1)
116+ ix [] _ = ""
117+
118+ linSecAxis = la_labelf ^= secs
119+ $ defaultLinearAxis
120+
121+ logSecAxis = loga_labelf ^= (secs . fromLV)
122+ $ defaultLogAxis
123+
124+ fromLV (LogValue v) = v
125+
126+-- | Try to render meaningful time-axis labels.
127+--
128+-- /FIXME/: Trouble is, we need to know the range of times for this to
129+-- work properly, so that we don't accidentally display consecutive
130+-- values that appear identical (e.g. \"43 ms, 43 ms\").
131+secs :: Double -> String
132+secs k
133+ | k < 0 = '-' : secs (-k)
134+ | k >= 1e9 = (k/1e9) `with` "Gs"
135+ | k >= 1e6 = (k/1e6) `with` "Ms"
136+ | k >= 1e4 = (k/1e3) `with` "Ks"
137+ | k >= 1 = k `with` "s"
138+ | k >= 1e-3 = (k*1e3) `with` "ms"
139+ | k >= 1e-6 = (k*1e6) `with` "µs"
140+ | k >= 1e-9 = (k*1e9) `with` "ns"
141+ | k >= 1e-12 = (k*1e12) `with` "ps"
142+ | otherwise = printf "%g s" k
143+ where with (t :: Double) (u :: String)
144+ | t >= 1e9 = printf "%.4g %s" t u
145+ | t >= 1e6 = printf "%.0f %s" t u
146+ | t >= 1e5 = printf "%.0f %s" t u
147+ | t >= 1e4 = printf "%.0f %s" t u
148+ | t >= 1e3 = printf "%.0f %s" t u
149+ | t >= 1e2 = printf "%.0f %s" t u
150+ | t >= 1e1 = printf "%.0f %s" t u
151+ | otherwise = printf "%.0f %s" t u