@@ -0,0 +1,151 @@
1+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
4+import Control.Monad (forM_)
5+import Data.Accessor ((^=))
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)
16+import qualified Data.ByteString as B
17+import qualified Data.Map as M
18+import qualified Data.Text as T
23+ , rowMeanLB :: !Double
24+ , rowMeanUB :: !Double
25+ , rowStdDev :: !Double
26+ , rowStdDevLB :: !Double
27+ , rowStdDevUB :: !Double
30+parseRow :: Text -> Row
31+parseRow = f . T.split ","
32+ where f [n,m,ml,mu,s,sl,su] = Row {
43+readCSV :: FilePath -> IO [Row]
44+readCSV = fmap (map parseRow . tail . T.lines . decodeUtf8) . B.readFile
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
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 = '-'
65+instance BarsPlotValue LogValue where
66+ barsReference = LogValue 1e-300
67+ barsAdd (LogValue a) (LogValue b) = LogValue (a * b)
69+renderMark :: String -> [Row] -> Renderable ()
71+ | minimum values * 50 >= maximum values = toRenderable linLayout
72+ | otherwise = toRenderable logLayout
74+ values = map rowMean 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")]
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
87+ logLayout = layout1_title ^= "Timings for \"" ++ desc ++
89+ $ layout1_plots ^= [ Left (plotBars logBars) ]
90+ $ layout1_left_axis ^= logLeftAxis
91+ $ layout1_bottom_axis ^= bottomAxis
92+ $ defaultLayout1 :: Layout1 Double LogValue
94+ logLeftAxis = laxis_generate ^= autoScaledLogAxis logSecAxis
95+ $ laxis_reverse ^= False
98+ linLeftAxis = laxis_generate ^= autoScaledAxis linSecAxis
101+ bottomAxis = laxis_generate ^= autoScaledAxis typeAxis
104+ linBars = plot_bars_values ^= (zip [0.5,1.5..] . map (:[]) $ values)
107+ logBars = plot_bars_values ^= (zip [0.5,1.5..] . map ((:[]) . LogValue) $ values)
110+ typeAxis = la_labelf ^= (ix keys . floor)
111+ $ la_nLabels ^= length keys
114+ ix (x:xs) n | n <= 0 = x
115+ | otherwise = ix xs (n-1)
118+ linSecAxis = la_labelf ^= secs
121+ logSecAxis = loga_labelf ^= (secs . fromLV)
124+ fromLV (LogValue v) = v
126+-- | Try to render meaningful time-axis labels.
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
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