{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module BenchShow.Graph
(
graph
) where
import Control.Arrow (second)
import Control.Monad (forM_, when)
import Control.Monad.Trans.State.Lazy (get, put)
import Data.Maybe (fromMaybe)
import Graphics.Rendering.Chart.Easy
import Graphics.Rendering.Chart.Backend.Diagrams
import BenchShow.Common
yindexes :: Maybe (Double, Double)
-> Maybe FieldTick
-> Double
-> Maybe [Double]
yindexes fieldRange granularity multiplier =
case (fieldRange, granularity) of
(Just (rangeMin, rangeMax), Just g) ->
let range = rangeMax - rangeMin
(size, count) =
case g of
TickSize n ->
(fromIntegral n, round $ range / fromIntegral n)
TickCount n -> (range / fromIntegral n, n)
in let size' = size / multiplier
rmin = rangeMin / multiplier
in Just $ take (count + 1) [rmin, rmin + size'..]
_ -> Nothing
transformColumns :: [ReportColumn] -> [ReportColumn]
transformColumns columns =
if length columns == 1
then columns ++ [ReportColumn
{ colName = ""
, colUnit = RelativeUnit "" 1
, colValues = []
}]
else columns
genGroupGraph :: RawReport -> Config -> IO ()
genGroupGraph RawReport{..} cfg@Config{..} = do
let outputFile = fromMaybe undefined reportOutputFile
fieldRange = getFieldRange reportIdentifier cfg
granularity = getFieldTick reportIdentifier cfg
RelativeUnit ulabel multiplier = colUnit (head reportColumns)
replaceMu 'μ' = 'u'
replaceMu x = x
unitLabel = map replaceMu ulabel
columns = transformColumns reportColumns
diffStr =
if length reportColumns > 1
then diffString presentation diffStrategy
else Nothing
atitle = makeTitle reportIdentifier diffStr cfg
toFile def outputFile $ do
layout_title .= atitle
layout_title_style . font_size .= 25
layout_x_axis . laxis_generate .=
autoIndexAxis (map (map replaceMu . colName) columns)
layout_x_axis . laxis_style . axis_label_style . font_size .= 16
layout_y_axis . laxis_style . axis_label_style . font_size .= 14
layout <- get
case _layout_legend layout of
Nothing -> return ()
Just style@LegendStyle{..} -> do
let s = style { _legend_plot_size = 22
, _legend_label_style = _legend_label_style
{ _font_size = 14 }
}
put $ layout { _layout_legend = Just s }
let modifyLabels ad = ad {
_axis_labels = map (map (second (++ " " ++ unitLabel)))
(_axis_labels ad)
}
when (presentation /= Fields) $
layout_y_axis . laxis_override .= modifyLabels
case yindexes fieldRange granularity multiplier of
Nothing -> return ()
Just indexes ->
layout_y_axis . laxis_override .= \_ ->
makeAxis (let f = floor :: Double -> Int
in map ((++ " " ++ unitLabel) . show . f))
(indexes, [], [])
plot $ fmap plotBars $ bars reportRowIds
$ (addIndexes $ map colValues columns)
graph :: FilePath -> FilePath -> Config -> IO ()
graph inputFile outputFile cfg@Config{..} = do
let dir = fromMaybe "." outputDir
(csvlines, fields) <- prepareToReport inputFile cfg
(runs, matrices) <- prepareGroupMatrices cfg csvlines fields
case presentation of
Groups style ->
forM_ fields $
reportComparingGroups style dir (Just outputFile)
GraphicalChart runs cfg
genGroupGraph matrices
Fields -> do
forM_ matrices $
reportPerGroup dir (Just outputFile) GraphicalChart
cfg genGroupGraph
Solo ->
let funcs = map
(\mx -> reportComparingGroups Absolute dir
(Just $ outputFile ++ "-" ++ groupName mx)
GraphicalChart runs cfg genGroupGraph [mx])
matrices
in sequence_ $ funcs <*> fields