module Criterion.Plot
(
plotKDE
, plotTiming
, plotWith
) where
import Control.Monad.Trans (liftIO)
import Criterion.Config
import Criterion.Monad (ConfigM, getConfigItem)
import Data.Array.Vector
import Data.Char (isSpace, toLower)
import Data.Foldable (forM_)
import Data.List (group, intersperse)
import Statistics.KernelDensity (Points, fromPoints)
import Statistics.Types (Sample)
import System.FilePath (pathSeparator)
import System.IO (IOMode(..), Handle, hPutStr, withBinaryFile)
import Text.Printf (printf)
import qualified Criterion.MultiMap as M
#ifdef HAVE_CHART
import Data.Accessor ((^=))
import Graphics.Rendering.Chart hiding (Plot,c)
import Graphics.Rendering.Chart.Gtk (renderableToWindow)
#else
import Criterion.IO (printError)
#endif
plotWith :: Plot -> (PlotOutput -> IO ()) -> ConfigM ()
plotWith p plot = getConfigItem (M.lookup p . cfgPlot)
>>= maybe (return ()) (liftIO . flip forM_ plot)
plotTiming :: PlotOutput
-> String
-> Sample
-> IO ()
plotTiming CSV desc times = do
writeTo (mangle $ printf "%s timings.csv" desc) $ \h -> do
putRow h ["sample", "execution time"]
forM_ (fromU $ indexedU times) $ \(x :*: y) ->
putRow h [show x, show y]
#ifdef HAVE_CHART
plotTiming (PDF x y) desc times =
renderableToPDFFile (renderTiming desc times) x y
(mangle $ printf "%s timings %dx%d.pdf" desc x y)
plotTiming (PNG x y) desc times =
renderableToPNGFile (renderTiming desc times) x y
(mangle $ printf "%s timings %dx%d.png" desc x y)
plotTiming (SVG x y) desc times =
renderableToSVGFile (renderTiming desc times) x y
(mangle $ printf "%s timings %dx%d.svg" desc x y)
plotTiming (Window x y) desc times =
renderableToWindow (renderTiming desc times) x y
#else
plotTiming output _desc _times =
printError "ERROR: output type %s not supported on this platform\n"
(show output)
#endif
plotKDE :: PlotOutput
-> String
-> Maybe (Double :*: Double)
-> Points
-> UArr Double
-> IO ()
plotKDE CSV desc _exs points pdf = do
writeTo (mangle $ printf "%s densities.csv" desc) $ \h -> do
putRow h ["execution time", "probability"]
forM_ (zip (fromU pdf) (fromU (fromPoints points))) $ \(x, y) ->
putRow h [show x, show y]
#ifdef HAVE_CHART
plotKDE (PDF x y) desc exs points pdf =
renderableToPDFFile (renderKDE desc exs points pdf) x y
(mangle $ printf "%s densities %dx%d.pdf" desc x y)
plotKDE (PNG x y) desc exs points pdf =
renderableToPNGFile (renderKDE desc exs points pdf) x y
(mangle $ printf "%s densities %dx%d.png" desc x y)
plotKDE (SVG x y) desc exs points pdf =
renderableToSVGFile (renderKDE desc exs points pdf) x y
(mangle $ printf "%s densities %dx%d.svg" desc x y)
plotKDE (Window x y) desc exs points pdf =
renderableToWindow (renderKDE desc exs points pdf) x y
#else
plotKDE output _desc _exs _points _pdf =
printError "ERROR: output type %s not supported on this platform\n"
(show output)
#endif
#ifdef HAVE_CHART
renderTiming :: String -> Sample -> Renderable ()
renderTiming desc times = toRenderable layout
where
layout = layout1_title ^= "Execution times for \"" ++ desc ++ "\""
$ layout1_plots ^= [ Left (plotBars bars) ]
$ layout1_left_axis ^= leftAxis
$ layout1_bottom_axis ^= bottomAxis
$ defaultLayout1 :: Layout1 Double Double
leftAxis = laxis_generate ^= autoScaledAxis secAxis
$ laxis_title ^= "execution time"
$ defaultLayoutAxis
bottomAxis = laxis_title ^= "number of samples"
$ defaultLayoutAxis
bars = plot_bars_values ^= (zip [0.5,1.5..] . map (:[]) . fromU $ times)
$ plot_bars_item_styles ^= [ (solidFillStyle c, Nothing) | c <- defaultColorSeq ]
$ plot_bars_spacing ^= BarsFixGap 0
$ defaultPlotBars
renderKDE :: String -> Maybe (Double :*: Double) -> Points -> UArr Double
-> Renderable ()
renderKDE desc exs points pdf = toRenderable layout
where
layout = layout1_title ^= "Densities of execution times for \"" ++
desc ++ "\""
$ layout1_plots ^= [ Left (toPlot info) ]
$ layout1_left_axis ^= leftAxis
$ layout1_bottom_axis ^= bottomAxis
$ defaultLayout1 :: Layout1 Double Double
leftAxis = laxis_title ^= "estimate of probability density"
$ defaultLayoutAxis
bottomAxis = laxis_generate ^= semiAutoScaledAxis secAxis
$ laxis_title ^= "execution time"
$ defaultLayoutAxis
semiAutoScaledAxis opts ps = autoScaledAxis opts (extremities ++ ps)
extremities = maybe [] (\(lo :*: hi) -> [lo, hi]) exs
info = plot_lines_values ^= [zip (fromU (fromPoints points)) (fromU spdf)]
$ defaultPlotLines
spdf = mapU (/ sumU pdf) pdf
secAxis :: LinearAxisParams Double
secAxis = la_labelf ^= secs
$ defaultLinearAxis
secs :: Double -> String
secs k
| k < 0 = '-' : secs (k)
| k >= 1e9 = (k/1e9) `with` "Gs"
| k >= 1e6 = (k/1e6) `with` "Ms"
| k >= 1e4 = (k/1e3) `with` "Ks"
| k >= 1 = k `with` "s"
| k >= 1e-3 = (k*1e3) `with` "ms"
| k >= 1e-6 = (k*1e6) `with` "us"
| k >= 1e-9 = (k*1e9) `with` "ns"
| k >= 1e-12 = (k*1e12) `with` "ps"
| otherwise = printf "%g s" k
where with (t :: Double) (u :: String)
| t >= 1e9 = printf "%.4g %s" t u
| t >= 1e6 = printf "%.0f %s" t u
| t >= 1e5 = printf "%.0f %s" t u
| t >= 1e4 = printf "%.0f %s" t u
| t >= 1e3 = printf "%.0f %s" t u
| t >= 1e2 = printf "%.0f %s" t u
| t >= 1e1 = printf "%.1f %s" t u
| otherwise = printf "%.2f %s" t u
#endif
writeTo :: FilePath -> (Handle -> IO a) -> IO a
writeTo path = withBinaryFile path WriteMode
escapeCSV :: String -> String
escapeCSV xs | any (`elem`xs) escapes = '"' : concatMap esc xs ++ "\""
| otherwise = xs
where esc '"' = "\"\""
esc c = [c]
escapes = "\"\r\n,"
putRow :: Handle -> [String] -> IO ()
putRow h s = hPutStr h (concat (intersperse "," (map escapeCSV s)) ++ "\r\n")
mangle :: String -> FilePath
mangle = concatMap (replace ((==) '-' . head) "-")
. group
. map (replace isSpace '-' . replace (==pathSeparator) '-' . toLower)
where replace p r c | p c = r
| otherwise = c