-- |
-- Module      : BenchShow.Internal.Graph
-- Copyright   : (c) 2018 Composewell Technologies
--
-- License     : BSD3
-- Maintainer  : harendra.kumar@gmail.com
-- Stability   : experimental
-- Portability : GHC
--

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

module BenchShow.Internal.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.Internal.Common

-------------------------------------------------------------------------------
-- Benchmarking field specific handling
-------------------------------------------------------------------------------

-- XXX need the ability to specify Units in the scale
yindexes :: Maybe (Double, Double)
         -> Maybe FieldTick
         -> Double
         -> Maybe [Double]
yindexes :: Maybe (Double, Double)
-> Maybe FieldTick -> Double -> Maybe [Double]
yindexes Maybe (Double, Double)
fieldRange Maybe FieldTick
granularity Double
multiplier =
    case (Maybe (Double, Double)
fieldRange, Maybe FieldTick
granularity) of
        (Just (Double
rangeMin, Double
rangeMax), Just FieldTick
g) ->
            let range :: Double
range = Double
rangeMax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rangeMin
                (Double
size, Int
count) =
                    case FieldTick
g of
                        TickSize Int
n ->
                            (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
range Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
                        TickCount Int
n -> (Double
range Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, Int
n)
            in let size' :: Double
size' = Double
size Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
multiplier
                   rmin :: Double
rmin  = Double
rangeMin Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
multiplier
               in [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just ([Double] -> Maybe [Double]) -> [Double] -> Maybe [Double]
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Double
rmin, Double
rmin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
size'..]
        (Maybe (Double, Double), Maybe FieldTick)
_ -> Maybe [Double]
forall a. Maybe a
Nothing

-------------------------------------------------------------------------------

transformColumns :: [ReportColumn] -> [ReportColumn]
transformColumns :: [ReportColumn] -> [ReportColumn]
transformColumns [ReportColumn]
columns =
    if [ReportColumn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ReportColumn]
columns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
    -- workaround for a bug that renders the plot badly when using
    -- a single cluster in the bar chart.
    then [ReportColumn]
columns [ReportColumn] -> [ReportColumn] -> [ReportColumn]
forall a. [a] -> [a] -> [a]
++ [ReportColumn :: String
-> RelativeUnit -> [Double] -> [AnalyzedField] -> ReportColumn
ReportColumn
            { colName :: String
colName = String
""
            , colUnit :: RelativeUnit
colUnit = String -> Double -> RelativeUnit
RelativeUnit String
"" Double
1
            , colValues :: [Double]
colValues = []
            , colAnalyzed :: [AnalyzedField]
colAnalyzed = []
            }]
     else [ReportColumn]
columns

-- We do not want to see the band of values between -1 and 1, in fact there are
-- no values possible in that band.  Shift the positive values by -1 and
-- negative values by +1 to map them to a 0 based scale on the graph. We change
-- the labels as well accordingly.
transformFractionValue :: ReportColumn -> ReportColumn
transformFractionValue :: ReportColumn -> ReportColumn
transformFractionValue ReportColumn{String
[Double]
[AnalyzedField]
RelativeUnit
colAnalyzed :: [AnalyzedField]
colValues :: [Double]
colUnit :: RelativeUnit
colName :: String
colAnalyzed :: ReportColumn -> [AnalyzedField]
colValues :: ReportColumn -> [Double]
colUnit :: ReportColumn -> RelativeUnit
colName :: ReportColumn -> String
..} =
    ReportColumn :: String
-> RelativeUnit -> [Double] -> [AnalyzedField] -> ReportColumn
ReportColumn
        { colName :: String
colName = String
colName
        , colUnit :: RelativeUnit
colUnit = RelativeUnit
colUnit
        , colValues :: [Double]
colValues = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
val ->
            case Double
val of
                Double
x | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 -> Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1
                Double
x | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< (-Double
1) -> Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1
                Double
x -> String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"BenchShow.Internal.Graph.transformFractionValue: unhandled: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
x
                ) [Double]
colValues
        , colAnalyzed :: [AnalyzedField]
colAnalyzed = [AnalyzedField]
colAnalyzed
        }

transformFractionLabels :: LinearAxisParams Double
transformFractionLabels :: LinearAxisParams Double
transformFractionLabels =
    ((LinearAxisParams Double
forall a. Default a => a
def :: (LinearAxisParams Double)) { _la_labelf :: [Double] -> [String]
_la_labelf = \[Double]
xs ->
        let shiftVals :: a -> a
shiftVals a
v = if a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 then a
v a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 else a
v a -> a -> a
forall a. Num a => a -> a -> a
- a
1
            replaceMinus :: String -> String
replaceMinus (Char
'-' : String
ys) = String
"1/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ys
            replaceMinus String
ys = String
ys
        in (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
replaceMinus (LinearAxisParams Double -> [Double] -> [String]
forall a. LinearAxisParams a -> [a] -> [String]
_la_labelf LinearAxisParams Double
forall a. Default a => a
def ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a. (Ord a, Num a) => a -> a
shiftVals [Double]
xs))
    })

genGroupGraph :: RawReport -> Config -> IO ()
genGroupGraph :: RawReport -> Config -> IO ()
genGroupGraph RawReport{String
[String]
[ReportColumn]
Maybe String
Maybe [[Estimator]]
reportEstimators :: RawReport -> Maybe [[Estimator]]
reportColumns :: RawReport -> [ReportColumn]
reportRowIds :: RawReport -> [String]
reportIdentifier :: RawReport -> String
reportOutputFile :: RawReport -> Maybe String
reportEstimators :: Maybe [[Estimator]]
reportColumns :: [ReportColumn]
reportRowIds :: [String]
reportIdentifier :: String
reportOutputFile :: Maybe String
..} cfg :: Config
cfg@Config{Bool
[(String, FieldTick)]
[(String, Double, Double)]
[TitleAnnotation]
Maybe String
Maybe (String -> String)
Word
Estimator
DiffStrategy
Presentation
String -> Maybe (String, String)
[String] -> [String]
[(String, Int)] -> [(String, Int)]
(SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectBenchmarks :: Config
-> (SortColumn
    -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectGroups :: Config -> [(String, Int)] -> [(String, Int)]
classifyBenchmark :: Config -> String -> Maybe (String, String)
fieldTicks :: Config -> [(String, FieldTick)]
fieldRanges :: Config -> [(String, Double, Double)]
selectFields :: Config -> [String] -> [String]
omitBaseline :: Config -> Bool
diffStrategy :: Config -> DiffStrategy
threshold :: Config -> Word
estimator :: Config -> Estimator
presentation :: Config -> Presentation
titleAnnotations :: Config -> [TitleAnnotation]
title :: Config -> Maybe String
mkTitle :: Config -> Maybe (String -> String)
outputDir :: Config -> Maybe String
verbose :: Config -> Bool
selectBenchmarks :: (SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectGroups :: [(String, Int)] -> [(String, Int)]
classifyBenchmark :: String -> Maybe (String, String)
fieldTicks :: [(String, FieldTick)]
fieldRanges :: [(String, Double, Double)]
selectFields :: [String] -> [String]
omitBaseline :: Bool
diffStrategy :: DiffStrategy
threshold :: Word
estimator :: Estimator
presentation :: Presentation
titleAnnotations :: [TitleAnnotation]
title :: Maybe String
mkTitle :: Maybe (String -> String)
outputDir :: Maybe String
verbose :: Bool
..} = do
    let outputFile :: String
outputFile  = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
forall a. HasCallStack => a
undefined Maybe String
reportOutputFile
        fieldRange :: Maybe (Double, Double)
fieldRange  = String -> Config -> Maybe (Double, Double)
getFieldRange String
reportIdentifier Config
cfg
        granularity :: Maybe FieldTick
granularity = String -> Config -> Maybe FieldTick
getFieldTick String
reportIdentifier Config
cfg
        -- XXX assert that the unit for all columns is the same
        RelativeUnit String
ulabel Double
multiplier = ReportColumn -> RelativeUnit
colUnit ([ReportColumn] -> ReportColumn
forall a. [a] -> a
head [ReportColumn]
reportColumns)
        replaceMu :: Char -> Char
replaceMu Char
'μ' = Char
'u'
        replaceMu Char
x = Char
x
        unitLabel :: String
unitLabel = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
replaceMu String
ulabel
        columns :: [ReportColumn]
columns = [ReportColumn] -> [ReportColumn]
transformColumns [ReportColumn]
reportColumns
        diffStr :: Maybe String
diffStr =
            if [ReportColumn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ReportColumn]
reportColumns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
            then Presentation -> DiffStrategy -> Maybe String
diffString Presentation
presentation DiffStrategy
diffStrategy
            else Maybe String
forall a. Maybe a
Nothing
        atitle :: String
atitle = case Maybe (String -> String)
mkTitle of
            Just String -> String
f -> String -> String
f String
reportIdentifier
            Maybe (String -> String)
Nothing -> String -> Maybe String -> Config -> String
makeTitle String
reportIdentifier Maybe String
diffStr Config
cfg

    FileOptions -> String -> EC (Layout PlotIndex Double) () -> IO ()
forall r.
(Default r, ToRenderable r) =>
FileOptions -> String -> EC r () -> IO ()
toFile FileOptions
forall a. Default a => a
def String
outputFile (EC (Layout PlotIndex Double) () -> IO ())
-> EC (Layout PlotIndex Double) () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (String -> Identity String)
-> Layout PlotIndex Double -> Identity (Layout PlotIndex Double)
forall x y. Lens' (Layout x y) String
layout_title ((String -> Identity String)
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> String -> EC (Layout PlotIndex Double) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= String
atitle
        (FontStyle -> Identity FontStyle)
-> Layout PlotIndex Double -> Identity (Layout PlotIndex Double)
forall x y. Lens' (Layout x y) FontStyle
layout_title_style ((FontStyle -> Identity FontStyle)
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> ((Double -> Identity Double) -> FontStyle -> Identity FontStyle)
-> (Double -> Identity Double)
-> Layout PlotIndex Double
-> Identity (Layout PlotIndex Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double) -> FontStyle -> Identity FontStyle
Lens' FontStyle Double
font_size ((Double -> Identity Double)
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> Double -> EC (Layout PlotIndex Double) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Double
25

        (LayoutAxis PlotIndex -> Identity (LayoutAxis PlotIndex))
-> Layout PlotIndex Double -> Identity (Layout PlotIndex Double)
forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis ((LayoutAxis PlotIndex -> Identity (LayoutAxis PlotIndex))
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> ((AxisFn PlotIndex -> Identity (AxisFn PlotIndex))
    -> LayoutAxis PlotIndex -> Identity (LayoutAxis PlotIndex))
-> (AxisFn PlotIndex -> Identity (AxisFn PlotIndex))
-> Layout PlotIndex Double
-> Identity (Layout PlotIndex Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AxisFn PlotIndex -> Identity (AxisFn PlotIndex))
-> LayoutAxis PlotIndex -> Identity (LayoutAxis PlotIndex)
forall x. Lens' (LayoutAxis x) (AxisFn x)
laxis_generate ((AxisFn PlotIndex -> Identity (AxisFn PlotIndex))
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> AxisFn PlotIndex -> EC (Layout PlotIndex Double) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
            [String] -> AxisFn PlotIndex
forall i. Integral i => [String] -> [i] -> AxisData i
autoIndexAxis ((ReportColumn -> String) -> [ReportColumn] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
replaceMu (String -> String)
-> (ReportColumn -> String) -> ReportColumn -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportColumn -> String
colName) [ReportColumn]
columns)
        (LayoutAxis PlotIndex -> Identity (LayoutAxis PlotIndex))
-> Layout PlotIndex Double -> Identity (Layout PlotIndex Double)
forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis ((LayoutAxis PlotIndex -> Identity (LayoutAxis PlotIndex))
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> ((Double -> Identity Double)
    -> LayoutAxis PlotIndex -> Identity (LayoutAxis PlotIndex))
-> (Double -> Identity Double)
-> Layout PlotIndex Double
-> Identity (Layout PlotIndex Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AxisStyle -> Identity AxisStyle)
-> LayoutAxis PlotIndex -> Identity (LayoutAxis PlotIndex)
forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style ((AxisStyle -> Identity AxisStyle)
 -> LayoutAxis PlotIndex -> Identity (LayoutAxis PlotIndex))
-> ((Double -> Identity Double) -> AxisStyle -> Identity AxisStyle)
-> (Double -> Identity Double)
-> LayoutAxis PlotIndex
-> Identity (LayoutAxis PlotIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontStyle -> Identity FontStyle)
-> AxisStyle -> Identity AxisStyle
Lens' AxisStyle FontStyle
axis_label_style ((FontStyle -> Identity FontStyle)
 -> AxisStyle -> Identity AxisStyle)
-> ((Double -> Identity Double) -> FontStyle -> Identity FontStyle)
-> (Double -> Identity Double)
-> AxisStyle
-> Identity AxisStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double) -> FontStyle -> Identity FontStyle
Lens' FontStyle Double
font_size ((Double -> Identity Double)
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> Double -> EC (Layout PlotIndex Double) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Double
16

        (LayoutAxis Double -> Identity (LayoutAxis Double))
-> Layout PlotIndex Double -> Identity (Layout PlotIndex Double)
forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis ((LayoutAxis Double -> Identity (LayoutAxis Double))
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> ((Double -> Identity Double)
    -> LayoutAxis Double -> Identity (LayoutAxis Double))
-> (Double -> Identity Double)
-> Layout PlotIndex Double
-> Identity (Layout PlotIndex Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AxisStyle -> Identity AxisStyle)
-> LayoutAxis Double -> Identity (LayoutAxis Double)
forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style ((AxisStyle -> Identity AxisStyle)
 -> LayoutAxis Double -> Identity (LayoutAxis Double))
-> ((Double -> Identity Double) -> AxisStyle -> Identity AxisStyle)
-> (Double -> Identity Double)
-> LayoutAxis Double
-> Identity (LayoutAxis Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontStyle -> Identity FontStyle)
-> AxisStyle -> Identity AxisStyle
Lens' AxisStyle FontStyle
axis_label_style ((FontStyle -> Identity FontStyle)
 -> AxisStyle -> Identity AxisStyle)
-> ((Double -> Identity Double) -> FontStyle -> Identity FontStyle)
-> (Double -> Identity Double)
-> AxisStyle
-> Identity AxisStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double) -> FontStyle -> Identity FontStyle
Lens' FontStyle Double
font_size ((Double -> Identity Double)
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> Double -> EC (Layout PlotIndex Double) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Double
14
        -- delete the -1x to 1x band of values which are not possible in case
        -- of fraction style
        [ReportColumn]
cols' <-
                case Presentation
presentation of
                    Groups GroupStyle
Multiples -> do
                        (LayoutAxis Double -> Identity (LayoutAxis Double))
-> Layout PlotIndex Double -> Identity (Layout PlotIndex Double)
forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis ((LayoutAxis Double -> Identity (LayoutAxis Double))
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> ((AxisFn Double -> Identity (AxisFn Double))
    -> LayoutAxis Double -> Identity (LayoutAxis Double))
-> (AxisFn Double -> Identity (AxisFn Double))
-> Layout PlotIndex Double
-> Identity (Layout PlotIndex Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AxisFn Double -> Identity (AxisFn Double))
-> LayoutAxis Double -> Identity (LayoutAxis Double)
forall x. Lens' (LayoutAxis x) (AxisFn x)
laxis_generate ((AxisFn Double -> Identity (AxisFn Double))
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> AxisFn Double -> EC (Layout PlotIndex Double) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= LinearAxisParams Double -> AxisFn Double
forall a. RealFloat a => LinearAxisParams a -> AxisFn a
autoScaledAxis
                                        LinearAxisParams Double
transformFractionLabels
                        [ReportColumn]
-> StateT (Layout PlotIndex Double) (State CState) [ReportColumn]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ReportColumn]
 -> StateT (Layout PlotIndex Double) (State CState) [ReportColumn])
-> [ReportColumn]
-> StateT (Layout PlotIndex Double) (State CState) [ReportColumn]
forall a b. (a -> b) -> a -> b
$ (ReportColumn -> ReportColumn) -> [ReportColumn] -> [ReportColumn]
forall a b. (a -> b) -> [a] -> [b]
map ReportColumn -> ReportColumn
transformFractionValue [ReportColumn]
columns
                    Presentation
_ -> [ReportColumn]
-> StateT (Layout PlotIndex Double) (State CState) [ReportColumn]
forall (m :: * -> *) a. Monad m => a -> m a
return [ReportColumn]
columns

        Layout PlotIndex Double
layout <- StateT
  (Layout PlotIndex Double) (State CState) (Layout PlotIndex Double)
forall (m :: * -> *) s. Monad m => StateT s m s
get
        case Layout PlotIndex Double -> Maybe LegendStyle
forall x y. Layout x y -> Maybe LegendStyle
_layout_legend Layout PlotIndex Double
layout of
            Maybe LegendStyle
Nothing -> () -> EC (Layout PlotIndex Double) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just style :: LegendStyle
style@LegendStyle{Double
LegendOrientation
LegendPosition
FontStyle
_legend_label_style :: LegendStyle -> FontStyle
_legend_margin :: LegendStyle -> Double
_legend_plot_size :: LegendStyle -> Double
_legend_orientation :: LegendStyle -> LegendOrientation
_legend_position :: LegendStyle -> LegendPosition
_legend_position :: LegendPosition
_legend_orientation :: LegendOrientation
_legend_plot_size :: Double
_legend_margin :: Double
_legend_label_style :: FontStyle
..} -> do
                let s :: LegendStyle
s = LegendStyle
style { _legend_plot_size :: Double
_legend_plot_size = Double
22
                              -- , _legend_margin = 40
                              -- This is not available in versions <= 1.8.2
                              -- , _legend_position = LegendBelow
                              , _legend_label_style :: FontStyle
_legend_label_style = FontStyle
_legend_label_style
                                    { _font_size :: Double
_font_size = Double
14 }
                              }
                Layout PlotIndex Double -> EC (Layout PlotIndex Double) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Layout PlotIndex Double -> EC (Layout PlotIndex Double) ())
-> Layout PlotIndex Double -> EC (Layout PlotIndex Double) ()
forall a b. (a -> b) -> a -> b
$ Layout PlotIndex Double
layout { _layout_legend :: Maybe LegendStyle
_layout_legend = LegendStyle -> Maybe LegendStyle
forall a. a -> Maybe a
Just LegendStyle
s }

        -- layout_y_axis . laxis_override .= axisGridAtTicks
        let modifyLabels :: AxisData x -> AxisData x
modifyLabels AxisData x
ad = AxisData x
ad {
                _axis_labels :: [[(x, String)]]
_axis_labels = ([(x, String)] -> [(x, String)])
-> [[(x, String)]] -> [[(x, String)]]
forall a b. (a -> b) -> [a] -> [b]
map (((x, String) -> (x, String)) -> [(x, String)] -> [(x, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> (x, String) -> (x, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
unitLabel)))
                                   (AxisData x -> [[(x, String)]]
forall x. AxisData x -> [[(x, String)]]
_axis_labels AxisData x
ad)
            }
        Bool
-> EC (Layout PlotIndex Double) ()
-> EC (Layout PlotIndex Double) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Presentation
presentation Presentation -> Presentation -> Bool
forall a. Eq a => a -> a -> Bool
/= Presentation
Fields) (EC (Layout PlotIndex Double) ()
 -> EC (Layout PlotIndex Double) ())
-> EC (Layout PlotIndex Double) ()
-> EC (Layout PlotIndex Double) ()
forall a b. (a -> b) -> a -> b
$
            (LayoutAxis Double -> Identity (LayoutAxis Double))
-> Layout PlotIndex Double -> Identity (Layout PlotIndex Double)
forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis ((LayoutAxis Double -> Identity (LayoutAxis Double))
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> (((AxisData Double -> AxisData Double)
     -> Identity (AxisData Double -> AxisData Double))
    -> LayoutAxis Double -> Identity (LayoutAxis Double))
-> ((AxisData Double -> AxisData Double)
    -> Identity (AxisData Double -> AxisData Double))
-> Layout PlotIndex Double
-> Identity (Layout PlotIndex Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AxisData Double -> AxisData Double)
 -> Identity (AxisData Double -> AxisData Double))
-> LayoutAxis Double -> Identity (LayoutAxis Double)
forall x. Lens' (LayoutAxis x) (AxisData x -> AxisData x)
laxis_override (((AxisData Double -> AxisData Double)
  -> Identity (AxisData Double -> AxisData Double))
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> (AxisData Double -> AxisData Double)
-> EC (Layout PlotIndex Double) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AxisData Double -> AxisData Double
forall x. AxisData x -> AxisData x
modifyLabels

        case Maybe (Double, Double)
-> Maybe FieldTick -> Double -> Maybe [Double]
yindexes Maybe (Double, Double)
fieldRange Maybe FieldTick
granularity Double
multiplier of
            Maybe [Double]
Nothing -> () -> EC (Layout PlotIndex Double) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just [Double]
indexes ->
                (LayoutAxis Double -> Identity (LayoutAxis Double))
-> Layout PlotIndex Double -> Identity (Layout PlotIndex Double)
forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis ((LayoutAxis Double -> Identity (LayoutAxis Double))
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> (((AxisData Double -> AxisData Double)
     -> Identity (AxisData Double -> AxisData Double))
    -> LayoutAxis Double -> Identity (LayoutAxis Double))
-> ((AxisData Double -> AxisData Double)
    -> Identity (AxisData Double -> AxisData Double))
-> Layout PlotIndex Double
-> Identity (Layout PlotIndex Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AxisData Double -> AxisData Double)
 -> Identity (AxisData Double -> AxisData Double))
-> LayoutAxis Double -> Identity (LayoutAxis Double)
forall x. Lens' (LayoutAxis x) (AxisData x -> AxisData x)
laxis_override (((AxisData Double -> AxisData Double)
  -> Identity (AxisData Double -> AxisData Double))
 -> Layout PlotIndex Double -> Identity (Layout PlotIndex Double))
-> (AxisData Double -> AxisData Double)
-> EC (Layout PlotIndex Double) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= \AxisData Double
_ ->
                    ([Double] -> [String])
-> ([Double], [Double], [Double]) -> AxisData Double
forall x.
PlotValue x =>
([x] -> [String]) -> ([x], [x], [x]) -> AxisData x
makeAxis (let f :: Double -> Int
f = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor :: Double -> Int
                              in (Double -> String) -> [Double] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
unitLabel) (String -> String) -> (Double -> String) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Double -> Int) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
f))
                             ([Double]
indexes, [], [])

        EC (Layout PlotIndex Double) (Plot PlotIndex Double)
-> EC (Layout PlotIndex Double) ()
forall (p :: * -> * -> *) x y.
ToPlot p =>
EC (Layout x y) (p x y) -> EC (Layout x y) ()
plot (EC (Layout PlotIndex Double) (Plot PlotIndex Double)
 -> EC (Layout PlotIndex Double) ())
-> EC (Layout PlotIndex Double) (Plot PlotIndex Double)
-> EC (Layout PlotIndex Double) ()
forall a b. (a -> b) -> a -> b
$ (PlotBars PlotIndex Double -> Plot PlotIndex Double)
-> StateT
     (Layout PlotIndex Double)
     (State CState)
     (PlotBars PlotIndex Double)
-> EC (Layout PlotIndex Double) (Plot PlotIndex Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlotBars PlotIndex Double -> Plot PlotIndex Double
forall y x. BarsPlotValue y => PlotBars x y -> Plot x y
plotBars (StateT
   (Layout PlotIndex Double)
   (State CState)
   (PlotBars PlotIndex Double)
 -> EC (Layout PlotIndex Double) (Plot PlotIndex Double))
-> StateT
     (Layout PlotIndex Double)
     (State CState)
     (PlotBars PlotIndex Double)
-> EC (Layout PlotIndex Double) (Plot PlotIndex Double)
forall a b. (a -> b) -> a -> b
$ [String]
-> [(PlotIndex, [Double])]
-> StateT
     (Layout PlotIndex Double)
     (State CState)
     (PlotBars PlotIndex Double)
forall x y l.
(PlotValue x, BarsPlotValue y) =>
[String] -> [(x, [y])] -> EC l (PlotBars x y)
bars [String]
reportRowIds
            ([(PlotIndex, [Double])]
 -> StateT
      (Layout PlotIndex Double)
      (State CState)
      (PlotBars PlotIndex Double))
-> [(PlotIndex, [Double])]
-> StateT
     (Layout PlotIndex Double)
     (State CState)
     (PlotBars PlotIndex Double)
forall a b. (a -> b) -> a -> b
$ ([[Double]] -> [(PlotIndex, [Double])]
forall a. [a] -> [(PlotIndex, a)]
addIndexes ([[Double]] -> [(PlotIndex, [Double])])
-> [[Double]] -> [(PlotIndex, [Double])]
forall a b. (a -> b) -> a -> b
$ (ReportColumn -> [Double]) -> [ReportColumn] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
map ReportColumn -> [Double]
colValues [ReportColumn]
cols')

-- | Presents the benchmark results in a CSV input file as graphical bar charts
-- according to the provided configuration.  The first parameter is the input
-- file name, the second parameter is the name prefix for the output SVG image
-- file(s). One or more output files may be generated depending on the
-- 'Presentation' setting.  The last parameter is the configuration to
-- customize the graph, you can start with 'defaultConfig' as the base and
-- override any of the fields that you may want to change.
--
-- For example:
--
-- @
-- graph "bench-results.csv" "output-graph" 'defaultConfig'
-- @
--
-- @since 0.2.0
graph :: FilePath -> FilePath -> Config -> IO ()
graph :: String -> String -> Config -> IO ()
graph String
inputFile String
outputFile cfg :: Config
cfg@Config{Bool
[(String, FieldTick)]
[(String, Double, Double)]
[TitleAnnotation]
Maybe String
Maybe (String -> String)
Word
Estimator
DiffStrategy
Presentation
String -> Maybe (String, String)
[String] -> [String]
[(String, Int)] -> [(String, Int)]
(SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectBenchmarks :: (SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectGroups :: [(String, Int)] -> [(String, Int)]
classifyBenchmark :: String -> Maybe (String, String)
fieldTicks :: [(String, FieldTick)]
fieldRanges :: [(String, Double, Double)]
selectFields :: [String] -> [String]
omitBaseline :: Bool
diffStrategy :: DiffStrategy
threshold :: Word
estimator :: Estimator
presentation :: Presentation
titleAnnotations :: [TitleAnnotation]
title :: Maybe String
mkTitle :: Maybe (String -> String)
outputDir :: Maybe String
verbose :: Bool
selectBenchmarks :: Config
-> (SortColumn
    -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectGroups :: Config -> [(String, Int)] -> [(String, Int)]
classifyBenchmark :: Config -> String -> Maybe (String, String)
fieldTicks :: Config -> [(String, FieldTick)]
fieldRanges :: Config -> [(String, Double, Double)]
selectFields :: Config -> [String] -> [String]
omitBaseline :: Config -> Bool
diffStrategy :: Config -> DiffStrategy
threshold :: Config -> Word
estimator :: Config -> Estimator
presentation :: Config -> Presentation
titleAnnotations :: Config -> [TitleAnnotation]
title :: Config -> Maybe String
mkTitle :: Config -> Maybe (String -> String)
outputDir :: Config -> Maybe String
verbose :: Config -> Bool
..} = do
    let dir :: String
dir = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"." Maybe String
outputDir
    (CSV
csvlines, [String]
fields) <- String -> Config -> IO (CSV, [String])
prepareToReport String
inputFile Config
cfg
    (Int
runs, [GroupMatrix]
matrices) <- Config -> String -> CSV -> [String] -> IO (Int, [GroupMatrix])
prepareGroupMatrices Config
cfg String
inputFile CSV
csvlines [String]
fields
    case Presentation
presentation of
        Groups GroupStyle
style ->
            [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
fields ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
                GroupStyle
-> String
-> Maybe String
-> ReportType
-> Int
-> Config
-> (RawReport -> Config -> IO ())
-> [GroupMatrix]
-> String
-> IO ()
reportComparingGroups GroupStyle
style String
dir (String -> Maybe String
forall a. a -> Maybe a
Just String
outputFile)
                                      ReportType
GraphicalChart Int
runs Config
cfg
                                      RawReport -> Config -> IO ()
genGroupGraph [GroupMatrix]
matrices
        Presentation
Fields -> do
            [GroupMatrix] -> (GroupMatrix -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GroupMatrix]
matrices ((GroupMatrix -> IO ()) -> IO ())
-> (GroupMatrix -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
                String
-> Maybe String
-> ReportType
-> Config
-> (RawReport -> Config -> IO ())
-> GroupMatrix
-> IO ()
reportPerGroup String
dir (String -> Maybe String
forall a. a -> Maybe a
Just String
outputFile) ReportType
GraphicalChart
                               Config
cfg RawReport -> Config -> IO ()
genGroupGraph
        Presentation
Solo ->
            let funcs :: [String -> IO ()]
funcs = (GroupMatrix -> String -> IO ())
-> [GroupMatrix] -> [String -> IO ()]
forall a b. (a -> b) -> [a] -> [b]
map
                    (\GroupMatrix
mx -> GroupStyle
-> String
-> Maybe String
-> ReportType
-> Int
-> Config
-> (RawReport -> Config -> IO ())
-> [GroupMatrix]
-> String
-> IO ()
reportComparingGroups GroupStyle
Absolute String
dir
                        (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
outputFile String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GroupMatrix -> String
groupName GroupMatrix
mx)
                        ReportType
GraphicalChart Int
runs Config
cfg RawReport -> Config -> IO ()
genGroupGraph [GroupMatrix
mx])
                    [GroupMatrix]
matrices
             in [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String -> IO ()]
funcs [String -> IO ()] -> [String] -> [IO ()]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String]
fields