-- | -- Module : BenchShow.Report -- Copyright : (c) 2018 Composewell Technologies -- -- License : BSD3 -- Maintainer : harendra.kumar@gmail.com -- Stability : experimental -- Portability : GHC -- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} module BenchShow.Report ( report ) where import Control.Applicative (ZipList(..)) import Control.Monad (forM_) import Data.Maybe (fromMaybe) import Statistics.Types (Estimate(..)) import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) import Text.Printf (printf) import BenchShow.Common import BenchShow.Analysis multiplesToPercentDiff :: Double -> Double multiplesToPercentDiff x = (if x > 0 then x - 1 else x + 1) * 100 colorCode :: Word -> Double -> Doc -> Doc colorCode thresh x = if x > fromIntegral thresh then dullred else if x < (-1) * fromIntegral thresh then dullgreen else id -- XXX in comparative reports render lower than baseline in green and higher -- than baseline in red genGroupReport :: RawReport -> Config -> IO () genGroupReport RawReport{..} cfg@Config{..} = do let diffStr = if length reportColumns > 1 then diffString presentation diffStrategy else Nothing case mkTitle of Just _ -> putStrLn $ maybe "" (\f -> f reportIdentifier) mkTitle Nothing -> putStrLn $ makeTitle reportIdentifier diffStr cfg let benchcol = "Benchmark" : reportRowIds groupcols = let firstCol : tailCols = reportColumns colorCol ReportColumn{..} = let f x = case presentation of Groups Diff -> if x > 0 then dullred else dullgreen Groups PercentDiff -> colorCode threshold x Groups Multiples -> let y = multiplesToPercentDiff x in colorCode threshold y _ -> id in map f colValues renderTailCols estimators col analyzed = let regular = renderGroupCol $ showCol col Nothing analyzed colored = zipWith ($) (id : id : colorCol col) $ renderGroupCol $ showCol col estimators analyzed in case presentation of Groups Diff -> colored Groups PercentDiff -> colored Groups Multiples -> colored _ -> regular in renderGroupCol (showFirstCol firstCol) : case reportEstimators of Just ests -> getZipList $ renderTailCols <$> ZipList (map Just $ tail ests) <*> ZipList tailCols <*> ZipList (tail reportAnalyzed) Nothing -> getZipList $ renderTailCols <$> pure Nothing <*> ZipList tailCols <*> ZipList (tail reportAnalyzed) rows = foldl (zipWith (<+>)) (renderCol benchcol) groupcols putDoc $ vcat rows putStrLn "\n" where renderCol [] = error "Bug: header row missing" renderCol col@(h : rows) = let maxlen = maximum (map length col) in map (fill maxlen . text) (h : replicate maxlen '-' : rows) renderGroupCol [] = error "Bug: There has to be at least one column in raw report" renderGroupCol col@(h : rows) = let maxlen = maximum (map length col) in map (\x -> indent (maxlen - length x) $ text x) (h : replicate maxlen '-' : rows) showEstimator est = case est of Mean -> "(mean)" Median -> "(medi)" Regression -> "(regr)" showEstVal estvals est = case est of Mean -> let sd = analyzedStdDev estvals val = analyzedMean estvals in if val /= 0 then printf "(%.2f)" $ sd / abs val else "" Median -> let x = ovFraction $ analyzedOutlierVar estvals in printf "(%.2f)" x Regression -> case analyzedRegRSq estvals of Just rsq -> printf "(%.2f)" (estPoint rsq) Nothing -> "" showFirstCol ReportColumn{..} = let showVal = printf "%.2f" withEstimator val estvals = showVal val ++ if verbose then showEstVal estvals estimator else "" withEstVal = zipWith withEstimator colValues (head reportAnalyzed) in colName : withEstVal showCol ReportColumn{..} estimators analyzed = colName : let showVal val = let showDiff = if val > 0 then printf "+%.2f" val else printf "%.2f" val in case presentation of Groups Diff -> showDiff Groups PercentDiff -> showDiff Groups Multiples -> if val > 0 then printf "%.2f" val else printf "1/%.2f" (negate val) _ -> printf "%.2f" val showEstAnnot est = case presentation of Groups Diff -> showEstimator est Groups PercentDiff -> showEstimator est Groups Multiples -> showEstimator est _ -> "" in case estimators of Just ests -> let withAnnot val estvals est = showVal val ++ if verbose then showEstVal estvals est ++ showEstAnnot est else "" in getZipList $ withAnnot <$> ZipList colValues <*> ZipList analyzed <*> ZipList ests Nothing -> let withEstVal val estvals est = showVal val ++ if verbose then showEstVal estvals est else "" in getZipList $ withEstVal <$> ZipList colValues <*> ZipList analyzed <*> pure estimator -- | Presents the benchmark results in a CSV input file as text reports -- according to the provided configuration. The first parameter is the input -- file name. The second parameter, when specified using 'Just', is the name -- prefix for the output SVG image file(s). One or more output files may be -- generated with the given prefix depending on the 'Presentation' setting. -- When the second parameter is 'Nothing' the reports are printed on the -- console. The last parameter is the configuration to customize the report, -- you can start with 'defaultConfig' as the base and override any of the -- fields that you may want to change. -- -- For example: -- -- @ -- report "bench-results.csv" Nothing 'defaultConfig' -- @ -- -- @since 0.2.0 report :: FilePath -> Maybe FilePath -> Config -> IO () report inputFile outputFile cfg@Config{..} = do let dir = fromMaybe "." outputDir (csvlines, fields) <- prepareToReport inputFile cfg (runs, matrices) <- prepareGroupMatrices cfg inputFile csvlines fields case presentation of Groups style -> forM_ fields $ reportComparingGroups style dir outputFile TextReport runs cfg genGroupReport matrices Fields -> do forM_ matrices $ reportPerGroup dir outputFile TextReport cfg genGroupReport Solo -> let funcs = map (\mx -> reportComparingGroups Absolute dir (fmap (++ "-" ++ groupName mx) outputFile) TextReport runs cfg genGroupReport [mx]) matrices in sequence_ $ funcs <*> fields