git.iko.soy/text
on builder help sign in
text/tests/Chartem.hs
153 lines 5.5 kB history raw
1{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
3import Data.Char
4import Control.Monad (forM_)
5import Data.Accessor ((^=))
6import Data.Function
7import Data.Maybe
8import Data.List
9import Debug.Trace
10import Data.Text (Text)
11import Data.Text.Encoding (decodeUtf8)
12import Graphics.Rendering.Chart
13import Graphics.Rendering.Chart.Gtk (renderableToWindow)
14import System.Environment (getArgs)
15import Text.Printf
16import qualified Data.ByteString as B
17import qualified Data.Map as M
18import qualified Data.Text as T
20data 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)
30parseRow :: Text -> Row
31parseRow = 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
43readCSV :: FilePath -> IO [Row]
44readCSV = fmap (map parseRow . tail . T.lines . decodeUtf8) . B.readFile
46groupRows :: [Row] -> M.Map Text [Row]
47groupRows = 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
52main = do
53 args <- getArgs
54 groups <- mapM (fmap groupRows . readCSV) args
55 let dd = M.unionsWith (++) . map (M.map (:[])) $ groups
56 forM_ (M.toList dd) $ \(tdesc,rows) -> do
57 let desc = T.unpack tdesc
58 if False
59 then renderableToWindow (renderMark desc rows) 400 160
60 else renderableToPNGFile (renderMark desc rows) 400 160
61 (printf "time-%s.png" (map clean desc))
62 where clean '/' = '-'
63 clean c | isSpace c = '-'
64 | otherwise = c
66instance BarsPlotValue LogValue where
67 barsReference = LogValue 1e-300
68 barsAdd (LogValue a) (LogValue b) = LogValue (a * b)
70renderMark :: String -> [[Row]] -> Renderable ()
71renderMark desc rows
72 | useLog = toRenderable linLayout
73 | otherwise = toRenderable logLayout
74 where
75 useLog = minimum (map minimum values) >= maximum (map maximum values) / 25
76 values = transpose . map (map rowMean) $ rows
77 keys = map git (head rows)
78 where git r = let n = T.unpack . rowName $ r
79 in maybe n id . flip lookup mappings $ n
80 mappings = [("bl", "lazy BS"), ("bs", "strict BS"), ("l", "list"),
81 ("tl", "lazy T"), ("ts", "strict T")]
83 linLayout = layout1_title ^= "Timings for \"" ++ desc ++ "\""
84 $ layout1_plots ^= [ Left (plotBars linBars) ]
85 $ layout1_left_axis ^= linLeftAxis
86 $ layout1_bottom_axis ^= bottomAxis
87 $ defaultLayout1 :: Layout1 Double Double
89 logLayout = layout1_title ^= "Timings for \"" ++ desc ++
90 "\" (log scale)"
91 $ layout1_plots ^= [ Left (plotBars logBars) ]
92 $ layout1_left_axis ^= logLeftAxis
93 $ layout1_bottom_axis ^= bottomAxis
94 $ defaultLayout1 :: Layout1 Double LogValue
96 logLeftAxis = laxis_generate ^= autoScaledLogAxis logSecAxis
97 $ laxis_reverse ^= False
98 $ defaultLayoutAxis
100 linLeftAxis = laxis_generate ^= autoScaledAxis linSecAxis
101 $ defaultLayoutAxis
103 bottomAxis = laxis_generate ^= autoScaledAxis typeAxis
104 $ defaultLayoutAxis
106 linBars = plot_bars_values ^= (zip [0.5,1.5..] values)
107 $ defaultPlotBars
109 logBars = plot_bars_values ^= (zip [0.5,1.5..] . map (map LogValue) $ values)
110 $ defaultPlotBars
112 typeAxis = la_labelf ^= (ix keys . floor)
113 $ la_nLabels ^= length keys
114 $ defaultLinearAxis
116 ix (x:xs) n | n <= 0 = x
117 | otherwise = ix xs (n-1)
118 ix [] _ = ""
120 linSecAxis = la_labelf ^= secs
121 $ defaultLinearAxis
123 logSecAxis = loga_labelf ^= (secs . fromLV)
124 $ defaultLogAxis
126 fromLV (LogValue v) = v
128-- | Try to render meaningful time-axis labels.
129--
130-- /FIXME/: Trouble is, we need to know the range of times for this to
131-- work properly, so that we don't accidentally display consecutive
132-- values that appear identical (e.g. \"43 ms, 43 ms\").
133secs :: Double -> String
134secs k
135 | k < 0 = '-' : secs (-k)
136 | k >= 1e9 = (k/1e9) `with` "Gs"
137 | k >= 1e6 = (k/1e6) `with` "Ms"
138 | k >= 1e4 = (k/1e3) `with` "Ks"
139 | k >= 1 = k `with` "s"
140 | k >= 1e-3 = (k*1e3) `with` "ms"
141 | k >= 1e-6 = (k*1e6) `with` "µs"
142 | k >= 1e-9 = (k*1e9) `with` "ns"
143 | k >= 1e-12 = (k*1e12) `with` "ps"
144 | otherwise = printf "%g s" k
145 where with (t :: Double) (u :: String)
146 | t >= 1e9 = printf "%.4g %s" t u
147 | t >= 1e6 = printf "%.0f %s" t u
148 | t >= 1e5 = printf "%.0f %s" t u
149 | t >= 1e4 = printf "%.0f %s" t u
150 | t >= 1e3 = printf "%.0f %s" t u
151 | t >= 1e2 = printf "%.0f %s" t u
152 | t >= 1e1 = printf "%.0f %s" t u
153 | otherwise = printf "%.0f %s" t u