bench-show 0.3.1 → 0.3.2

raw patch · 22 files changed

+2674/−2269 lines, 22 filesdep −semigroupsdep ~ansi-wl-pprintdep ~filepathdep ~optparse-applicativenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies removed: semigroups

Dependency ranges changed: ansi-wl-pprint, filepath, optparse-applicative, statistics, text, transformers, vector

API changes (from Hackage documentation)

Files

• .github/workflows/packcheck.yml +197/−0
• .gitignore +6/−0
• Changelog.md +7/−0
• LICENSE +33/−0
• README.md +3/−3
• TODO.md +23/−0
• app/Main.hs +13/−1
• appveyor.yml +90/−0
• bench-show.cabal +50/−43
• lib/BenchShow.hs +3/−3
• lib/BenchShow/Analysis.hs +0/−397
• lib/BenchShow/Common.hs +0/−1372
• lib/BenchShow/Graph.hs +0/−199
• lib/BenchShow/Internal/Analysis.hs +397/−0
• lib/BenchShow/Internal/Common.hs +1370/−0
• lib/BenchShow/Internal/Graph.hs +201/−0
• lib/BenchShow/Internal/Pretty.hs +58/−0
• lib/BenchShow/Internal/Report.hs +220/−0
• lib/BenchShow/Report.hs +0/−222
• lib/BenchShow/Tutorial.hs +2/−2
• stack-8.2.yaml +0/−17
• stack.yaml +1/−10

@@ -0,0 +1,197 @@+# packcheck+# You can use any of the options supported by packcheck as environment+# variables here.  See https://github.com/composewell/packcheck for all+# options and their explanation.++name: packcheck++#-----------------------------------------------------------------------------+# Events on which the build should be triggered+#-----------------------------------------------------------------------------++on:+  push:+    branches:+      - master+  pull_request:+++#-----------------------------------------------------------------------------+# Build matrix+#-----------------------------------------------------------------------------++jobs:+  build:+    name: ${{ matrix.name }}+    env:+      # ------------------------------------------------------------------------+      # Common options+      # ------------------------------------------------------------------------+      # GHC_OPTIONS: "-Werror"+      CABAL_REINIT_CONFIG: y+      LC_ALL: C.UTF-8++      # ------------------------------------------------------------------------+      # What to build+      # ------------------------------------------------------------------------+      # DISABLE_TEST: "y"+      # DISABLE_BENCH: "y"+      # DISABLE_DOCS: "y"+      # DISABLE_SDIST_BUILD: "y"+      # DISABLE_SDIST_GIT_CHECK: "y"+      # DISABLE_DIST_CHECKS: "y"++      # ------------------------------------------------------------------------+      # stack options+      # ------------------------------------------------------------------------+      # Note requiring a specific version of stack using STACKVER may fail due to+      # github API limit while checking and upgrading/downgrading to the specific+      # version.+      #STACKVER: "1.6.5"+      #STACK_UPGRADE: "y"+      #RESOLVER: "lts-12"++      # ------------------------------------------------------------------------+      # cabal options+      # ------------------------------------------------------------------------+      CABAL_CHECK_RELAX: y+      CABAL_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com"++      # ------------------------------------------------------------------------+      # Where to find the required tools+      # ------------------------------------------------------------------------+      PATH: /opt/ghc/bin:/sbin:/usr/sbin:/bin:/usr/bin+      #TOOLS_DIR: /opt++      # ------------------------------------------------------------------------+      # Location of packcheck.sh (the shell script invoked to perform CI tests ).+      # ------------------------------------------------------------------------+      # You can either commit the packcheck.sh script at this path in your repo or+      # you can use it by specifying the PACKCHECK_REPO_URL option below in which+      # case it will be automatically copied from the packcheck repo to this path+      # during CI tests. In any case it is finally invoked from this path.+      PACKCHECK: "./packcheck.sh"+      # If you have not committed packcheck.sh in your repo at PACKCHECK+      # then it is automatically pulled from this URL.+      PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"+      PACKCHECK_GITHUB_COMMIT: "v0.6.0"++      # ------------------------------------------------------------------------+      # Final build variables+      # ------------------------------------------------------------------------+      PACKCHECK_COMMAND: ${{ matrix.command }} ${{ matrix.pack_options }}++    runs-on: ${{ matrix.runner }}+    strategy:+      fail-fast: false+      matrix:++        include:++          - name: 8.4.4+            ghc_version: 8.4.4+            runner: ubuntu-latest+            cabal_version: 3.2+            command: cabal-v2++          - name: 8.6.5+            ghc_version: 8.6.5+            runner: ubuntu-latest+            cabal_version: 3.2+            command: cabal-v2++          - name: 8.8.4+            ghc_version: 8.8.4+            runner: ubuntu-latest+            cabal_version: 3.2+            command: cabal-v2++          - name: 8.10.7+            ghc_version: 8.10.7+            runner: ubuntu-latest+            cabal_version: 3.2+            command: cabal-v2++          - name: 8.10.7+no-charts+            ghc_version: 8.10.7+            runner: ubuntu-latest+            cabal_version: 3.2+            command: cabal-v2+            pack_options: >-+              CABAL_BUILD_OPTIONS="-f no-charts"+              DISABLE_TEST=y++          - name: 8.10.7+no-colors+            ghc_version: 8.10.7+            runner: ubuntu-latest+            cabal_version: 3.2+            command: cabal-v2+            pack_options: >-+              CABAL_BUILD_OPTIONS="-f no-colors"++          - name: 9.0.1+            ghc_version: 9.0.1+            runner: ubuntu-latest+            cabal_version: 3.2+            command: cabal-v2++          # - name: 9.2.1+          #   ghc_version: 9.2.1+          #   runner: ubuntu-latest+          #   cabal_version: 3.6+          #   command: cabal-v2+          #   pack_options: >-+          #     DISABLE_TEST=y+          #     DISABLE_BENCH=y++          # - name: hlint+          #   command: cabal-v2+          #   runner: ubuntu-latest+          #   pack_options: >-+          #     HLINT_OPTIONS="lint"+          #     HLINT_TARGETS="app lib"++    steps:+    - uses: actions/checkout@v2++    - uses: haskell/actions/setup@v1+      with:+        ghc-version: ${{ matrix.ghc_version }}+        cabal-version: ${{ matrix.cabal_version }}++    - uses: actions/cache@v2+      name: Cache common directories+      with:+        path: |+          ~/.cabal+          ~/.ghc+          ~/.local+          ~/.stack+        key: ${{ matrix.ghc_version }}-${{ matrix.runner }}++    - name: Run installer+      if: ${{ matrix.installer != '' }}+      run: ${{ matrix.installer }}++    - name: Setup stack+      if: ${{ matrix.command == 'stack' }}+      run: |+        # required for packcheck+        sudo apt-get install -y curl+        # required for outbound https for stack and for stack setup+        sudo apt-get install -y netbase xz-utils make+        # If a custom stack-yaml is specified, replace the default with that+        if test -e "$STACK_YAML"; then rm -f stack.yaml && ln -sv $STACK_YAML stack.yaml; else true; fi+        unset STACK_YAML++    - name: Download packcheck+      run: |+        # Get packcheck if needed+        CURL=$(which curl)+        PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh+        if test ! -e "$PACKCHECK"; then $CURL -sL -o "$PACKCHECK" $PACKCHECK_URL; fi;+        chmod +x $PACKCHECK++    - name: Run packcheck+      run: |+        bash -c "$PACKCHECK $PACKCHECK_COMMAND"

@@ -0,0 +1,6 @@+/.gitignore+/.stack-work/+/dist/+/dist-newstyle/+/.cabal-sandbox/+/.packcheck/

@@ -1,3 +1,10 @@+## 0.3.2 (Feb 2022)++* Show an empty report on the selection of no benchmarks instead of erroring+  out.+* Add a few flags to build a minimal version of the library.+* Expose all available modules under the `Internal` namespace.+ ## 0.3.1  ### Bug Fixes

@@ -25,3 +25,36 @@ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-------------------------------------------------------------------------------+This distribution includes portions of code from the "criterion" package+(https://github.com/haskell/criterion/) package available under BSD3 license as+described below.+-------------------------------------------------------------------------------++Copyright (c) 2009, 2010 Bryan O'Sullivan+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,8 +1,8 @@ # bench-show  [![Hackage](https://img.shields.io/hackage/v/bench-show.svg?style=flat)](https://hackage.haskell.org/package/bench-show)-[![Build Status](https://travis-ci.com/composewell/bench-show.svg?branch=master)](https://travis-ci.org/composewell/bench-show)-[![Windows Build status](https://ci.appveyor.com/api/projects/status/5u19xvm7sn7salrh?svg=true)](https://ci.appveyor.com/project/harendra-kumar/bench-show)+[![Github CI Build Status](https://github.com/composewell/bench-show/actions/workflows/packcheck.yml/badge.svg)](https://github.com/composewell/bench-show/actions/workflows/packcheck.yml/badge.svg)+[![Appveyor Build status](https://ci.appveyor.com/api/projects/status/5u19xvm7sn7salrh?svg=true)](https://ci.appveyor.com/project/harendra-kumar/bench-show)  Generate text reports and graphical charts from the benchmark results generated by `gauge` or `criterion` and stored in a CSV file. This tool is especially@@ -146,7 +146,7 @@               reverse               $ map fst               $ sortBy (comparing snd)-              $ either error id $ f $ ColumnIndex 1+              $ either error id $ f (ColumnIndex 1) Nothing          } ``` 

@@ -0,0 +1,23 @@+The following are some of the features that can be considered for addition to+this package. These are just thoughts and not carved in stone, we may end up+implementing variations of these, or not implement them at all or implement+other features that are not listed here.++* Optionally annotate each benchmark with its description i.e. how the+  benchmark was performed and what parameters were used. This can be included+  in a detailed report. Other than individual benchmark descriptions we can+  also have a common description for the whole group of benchmarks in a report.++* Ability to generate graphs using a logarithmic axis. Also the abiliy to+  choose the log axis automatically when the range being plotted is too wide.++* Try [chart-unit](https://hackage.haskell.org/package/chart-unit) as an+  alternative charting backend in addition to the current+  `Chart`/`Chart-diagrams`.++* Add a custom column in the csv file during benchmarking. This column can+  record a parameter specified in the benchmark and then we can plot graphs+  based on this parameter. For example, we can measure an append benchmark for+  10, 100, 1000 and 10000 element streams and then plot the number of elements+  vs timing. In this case, the custom column may be "stream-size" and it may+  record the number of elements in the stream used for that measurement.

@@ -18,12 +18,17 @@ -- module Main where -import Data.Semigroup ((<>)) import Options.Applicative.Simple (addCommand, simpleOptions, simpleVersion) import Paths_bench_show (version)  import Options.Applicative++#ifndef NO_CHARTS import BenchShow+#else+import BenchShow.Internal.Common+import BenchShow.Internal.Report+#endif  -- The command line interface provides subcommands for each task.  There are -- some common options that apply to all subcommands. Subcommands may have@@ -144,6 +149,8 @@ -- "graph" subcommand ------------------------------------------------------------------------------- +#ifndef NO_CHARTS+ data GraphOpts = GraphOpts     { graphInput :: FilePath     , graphOutput :: FilePath@@ -160,6 +167,8 @@ cmdGraph :: GraphOpts -> Config -> IO () cmdGraph GraphOpts{..} cfg = graph graphInput graphOutput cfg +#endif+ ------------------------------------------------------------------------------- -- Build and run a subcommand parser -------------------------------------------------------------------------------@@ -178,10 +187,13 @@                        "Generate a text report"                        cmdReport                        pReportOpts++#ifndef NO_CHARTS             addCommand "graph"                        "Generate a graphical report"                        cmdGraph                        pGraphOpts+#endif  main :: IO () main = cmdLineParser pConfig

@@ -0,0 +1,90 @@+# packcheck-0.4.2+# You can use any of the options supported by packcheck as environment+# variables here.  See https://github.com/composewell/packcheck for all+# options and their explanation.++environment:+    # ------------------------------------------------------------------------+    # Global options, you can use these per build as well+    # ------------------------------------------------------------------------+  global:+    # ------------------------------------------------------------------------+    # Common options+    # ------------------------------------------------------------------------+    # GHC_OPTIONS: "-Werror"+    CABAL_REINIT_CONFIG: "y"+    LC_ALL: "C.UTF-8"++    # ------------------------------------------------------------------------+    # What to build+    # ------------------------------------------------------------------------+    # DISABLE_TEST: "y"+    # DISABLE_BENCH: "y"+    # DISABLE_DOCS: "y"+    # DISABLE_SDIST_BUILD: "y"+    # DISABLE_DIST_CHECKS: "y"+    ENABLE_INSTALL: "y"++    # ------------------------------------------------------------------------+    # stack options+    # ------------------------------------------------------------------------+    # Note requiring a specific version of stack using STACKVER may fail due to+    # github API limit while checking and upgrading/downgrading to the specific+    # version.+    #STACKVER: "1.6.5"+    STACK_UPGRADE: "y"+    RESOLVER: "lts-13"+    STACK_ROOT: "c:\\sr"++    # ------------------------------------------------------------------------+    # cabal options+    # ------------------------------------------------------------------------+    CABAL_CHECK_RELAX: "y"+    CABAL_NO_SANDBOX: "y"+    CABAL_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com"++    # ------------------------------------------------------------------------+    # Where to find the required tools+    # ------------------------------------------------------------------------+    PATH: "%PATH%;%APPDATA%\\local\\bin"+    LOCAL_BIN: "%APPDATA%\\local\\bin"++    # ------------------------------------------------------------------------+    # Location of packcheck.sh (the shell script invoked to perform CI tests ).+    # ------------------------------------------------------------------------+    # You can either commit the packcheck.sh script at this path in your repo or+    # you can use it by specifying the PACKCHECK_REPO_URL option below in which+    # case it will be automatically copied from the packcheck repo to this path+    # during CI tests. In any case it is finally invoked from this path.+    PACKCHECK_LOCAL_PATH: "./packcheck.sh"+    # If you have not committed packcheck.sh in your repo at PACKCHECK_LOCAL_PATH+    # then it is automatically pulled from this URL.+    PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/harendra-kumar/packcheck"+    PACKCHECK_GITHUB_COMMIT: "3d48b1711a099fb30fe202b620f6fcf70ed3410b"++    # Override the temp directory to avoid sed escaping issues+    # See https://github.com/haskell/cabal/issues/5386+    TMP: "c:\\tmp"++cache:+  - "%STACK_ROOT%"+  - "%LOCAL_BIN%"+  - "%APPDATA%\\cabal"+  - "%APPDATA%\\ghc"+# - "%LOCALAPPDATA%\\Programs\\stack"++clone_folder: "c:\\pkg"+build: off++before_test:+- if not exist %PACKCHECK_LOCAL_PATH% curl -sSkL -o%PACKCHECK_LOCAL_PATH% %PACKCHECK_GITHUB_URL%/%PACKCHECK_GITHUB_COMMIT%/packcheck.sh+- if not exist %LOCAL_BIN% mkdir %LOCAL_BIN%+- where stack.exe || curl -sSkL -ostack.zip http://www.stackage.org/stack/windows-x86_64 && 7z x stack.zip stack.exe && move stack.exe %LOCAL_BIN%+- if defined STACKVER (stack upgrade --binary-only --binary-version %STACKVER%) else (stack upgrade --binary-only || ver > nul)+- stack --version++test_script:+- stack setup > nul+- for /f "usebackq tokens=*" %%i in (`where 7z.exe`) do set PATH7Z=%%i\..+- for /f "usebackq tokens=*" %%i in (`where git.exe`) do set PATHGIT=%%i\..+- chcp 65001 && stack exec bash -- -c "chmod +x %PACKCHECK_LOCAL_PATH%; %PACKCHECK_LOCAL_PATH% stack PATH=/usr/bin:\"%PATH7Z%\":\"%PATHGIT%\""

@@ -1,5 +1,5 @@ name:               bench-show-version:            0.3.1+version:            0.3.2 license:            BSD3 author:             Harendra Kumar maintainer:         harendra.kumar@gmail.com@@ -60,10 +60,11 @@ category:            Performance, Benchmarking homepage:            https://github.com/composewell/bench-show license-file:        LICENSE-tested-with:           GHC==8.6.5-                     , GHC==8.4.4-                     , GHC==8.2.2-                     , GHC==7.10.3+tested-with:         GHC==8.4.4+                   , GHC==8.6.5+                   , GHC==8.8.4+                   , GHC==8.10.7+                   , GHC==9.0.1 copyright:           2017, 2018 Composewell Technologies stability:           Experimental build-type:          Simple@@ -73,20 +74,15 @@     Changelog.md     README.md     stack.yaml-    stack-8.2.yaml     test/results.csv     test/results.csvraw     test/results-doc.csv     test/results-doc-multi.csv -    docs/full-median-time.svg-    docs/grouped-median-time.svg-    docs/grouped-delta-median-time.svg-    docs/grouped-percent-delta-coeff-time.svg-    docs/grouped-percent-delta-median-time.svg-    docs/grouped-percent-delta-sorted-median-time.svg-    docs/grouped-single-estimator-coeff-time.svg-    docs/regression-percent-descending-median-time.svg+    appveyor.yml+    .github/workflows/packcheck.yml+    .gitignore+    TODO.md  extra-doc-files:     docs/full-median-time.svg@@ -102,14 +98,22 @@     type: git     location: https://github.com/composewell/bench-show +flag no-charts+  description: Don't build the modules that provide charting functionality+  manual: True+  default: False++flag no-colors+  description: Use pretty printing without colors+  manual: True+  default: False+ library     hs-source-dirs:   lib-    exposed-modules:  BenchShow-                    , BenchShow.Tutorial-    other-modules:    BenchShow.Analysis-                    , BenchShow.Common-                    , BenchShow.Graph-                    , BenchShow.Report+    exposed-modules:  BenchShow.Internal.Analysis+                    , BenchShow.Internal.Common+                    , BenchShow.Internal.Report+                    , BenchShow.Internal.Pretty     default-language: Haskell2010     default-extensions:         OverloadedStrings@@ -117,17 +121,26 @@     ghc-options: -Wall     build-depends:           base              >= 4.8     && < 5-        , Chart             >= 1.6     && < 2-        , Chart-diagrams    >= 1.6     && < 2         , csv               >= 0.1     && < 0.2         , filepath          >= 1.3     && < 1.5-        , mwc-random        >= 0.13    && < 0.15+        , mwc-random        >= 0.13    && < 0.16         , directory         >= 1.2     && < 1.4-        , transformers      >= 0.4     && < 0.6-        , ansi-wl-pprint    >= 0.6     && < 0.7+        , transformers      >= 0.4     && < 0.7         , split             >= 0.2     && < 0.3-        , statistics        >= 0.15    && < 0.16+        , statistics        >= 0.15    && < 0.17         , vector            >= 0.10    && < 0.13+    if !flag(no-charts)+      exposed-modules:      BenchShow+                            BenchShow.Tutorial+                            BenchShow.Internal.Graph+      build-depends:+          Chart             >= 1.6     && < 2+        , Chart-diagrams    >= 1.6     && < 2+    if !flag(no-colors)+       build-depends:+          ansi-wl-pprint    >= 0.6     && < 0.7+    else+       cpp-options: -DNO_COLORS  executable bench-show   default-language: Haskell2010@@ -136,24 +149,16 @@   other-modules: Paths_bench_show   ghc-options: -Wall   build-depends:-          base                 >= 4.8     && < 5-        , Chart                >= 1.6     && < 2-        , Chart-diagrams       >= 1.6     && < 2-        , csv                  >= 0.1     && < 0.2-        , filepath             >= 1.3     && < 1.5-        , mwc-random           >= 0.13    && < 0.15-        , directory            >= 1.2     && < 1.4-        , transformers         >= 0.4     && < 0.6-        , ansi-wl-pprint       >= 0.6     && < 0.7-        , split                >= 0.2     && < 0.3-        , statistics           >= 0.15    && < 0.16-        , vector               >= 0.10    && < 0.13-        , semigroups           >= 0.18    && < 0.20-        , optparse-applicative >= 0.14.2  && < 0.16+          base                 >= 4.8     && < 4.17+        , optparse-applicative >= 0.14.2  && < 0.18         , optparse-simple      >= 0.1.0   && < 0.2         , bench-show+  if flag(no-charts)+    cpp-options: -DNO_CHARTS  test-suite test+    if flag(no-charts)+      buildable: False     type: exitcode-stdio-1.0     default-language: Haskell2010     default-extensions:@@ -165,12 +170,14 @@      build-depends:           bench-show-        , base              >= 4.8 && < 5+        , base              >= 4.8     && < 4.17         , split             >= 0.2     && < 0.3-        , text              >= 1.1.1   && < 1.3+        , text              >= 1.1.1   && < 2.1         -- , typed-process     >= 0.1.0.0 && < 0.3  test-suite doc+    if flag(no-charts)+      buildable: False     type: exitcode-stdio-1.0     default-language: Haskell2010     default-extensions:@@ -182,5 +189,5 @@      build-depends:           bench-show-        , base              >= 4.8 && < 5+        , base              >= 4.8 && < 4.17         , split             >= 0.2 && < 0.3

@@ -96,6 +96,6 @@     , graph     ) where -import BenchShow.Common-import BenchShow.Graph-import BenchShow.Report+import BenchShow.Internal.Common+import BenchShow.Internal.Graph+import BenchShow.Internal.Report

@@ -1,397 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      : BenchShow.Analysis--- Copyright   : (c) 2009-2014 Bryan O'Sullivan---               (c) 2018 Composewell Technologies------ License     : BSD-style--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC--module BenchShow.Analysis-    ( OutlierEffect(..)-    , OutlierVariance(..)-    , countOutliers-    , Estimator(..)-    , AnalyzedField(..)-    , getAnalyzedValue-    , BenchmarkMatrix(..)-    , BenchmarkIterMatrix(..)-    , foldBenchmark-    , filterSamples-    , isMaxField-    ) where--import Control.Applicative-import Data.Char (toLower)-import Data.Data (Data, Typeable)-import Data.Int (Int64)-import Data.List (elemIndex, transpose)-import Data.Maybe (fromMaybe)-import Data.Traversable-import GHC.Generics (Generic)-import Statistics.Function (sort)-import Statistics.Quantile (weightedAvg)-import Statistics.Regression (bootstrapRegress, olsRegress)-import Statistics.Resampling (resample)-import Statistics.Resampling.Bootstrap (bootstrapBCA)-import Statistics.Sample (mean, stdDev)-import Statistics.Sample.KernelDensity (kde)-import Statistics.Types (Sample, Estimate(..), ConfInt(..), cl95, CL)-import System.Random.MWC (GenIO, createSystemRandom)-import Prelude hiding (sequence, mapM)--import qualified Statistics.Resampling as St-import qualified Data.Vector.Generic as G-import qualified Data.Vector.Unboxed as U------------------------------------------------------------------------------------ Outliers------------------------------------------------------------------------------------ | Outliers from sample data, calculated using the boxplot--- technique.-data Outliers = Outliers {-      samplesSeen :: !Int64-    , lowSevere   :: !Int64-    -- ^ More than 3 times the interquartile range (IQR) below the-    -- first quartile.-    , lowMild     :: !Int64-    -- ^ Between 1.5 and 3 times the IQR below the first quartile.-    , highMild    :: !Int64-    -- ^ Between 1.5 and 3 times the IQR above the third quartile.-    , highSevere  :: !Int64-    -- ^ More than 3 times the IQR above the third quartile.-    } deriving (Eq, Show, Typeable, Data, Generic)---- | A description of the extent to which outliers in the sample data--- affect the sample mean and standard deviation.-data OutlierEffect = Unaffected -- ^ Less than 1% effect.-                   | Slight     -- ^ Between 1% and 10%.-                   | Moderate   -- ^ Between 10% and 50%.-                   | Severe     -- ^ Above 50% (i.e. measurements-                                -- are useless).-                     deriving (Eq, Ord, Show, Typeable, Data, Generic)--outliersEmpty :: Outliers-outliersEmpty = Outliers 0 0 0 0 0--addOutliers :: Outliers -> Outliers -> Outliers-addOutliers (Outliers s a b c d) (Outliers t w x y z) =-    Outliers (s+t) (a+w) (b+x) (c+y) (d+z)-{-# INLINE addOutliers #-}---- | Analysis of the extent to which outliers in a sample affect its--- standard deviation (and to some extent, its mean).-data OutlierVariance = OutlierVariance {-      ovEffect   :: !OutlierEffect-    -- ^ Qualitative description of effect.-    , ovDesc     :: !String-    -- ^ Brief textual description of effect.-    , ovFraction :: !Double-    -- ^ Quantitative description of effect (a fraction between 0 and 1).-    } deriving (Eq, Show, Typeable, Data, Generic)---- | Classify outliers in a data set, using the boxplot technique.-classifyOutliers :: Sample -> Outliers-classifyOutliers sa = U.foldl' ((. outlier) . addOutliers) outliersEmpty ssa-    where outlier e = Outliers-                { samplesSeen = 1-                , lowSevere = if e <= loS && e < hiM then 1 else 0-                , lowMild = if e > loS && e <= loM then 1 else 0-                , highMild = if e >= hiM && e < hiS then 1 else 0-                , highSevere = if e >= hiS && e > loM then 1 else 0-                }-          !loS = q1 - (iqr * 3)-          !loM = q1 - (iqr * 1.5)-          !hiM = q3 + (iqr * 1.5)-          !hiS = q3 + (iqr * 3)-          q1   = weightedAvg 1 4 ssa-          q3   = weightedAvg 3 4 ssa-          ssa  = sort sa-          iqr  = q3 - q1---- | Compute the extent to which outliers in the sample data affect--- the sample mean and standard deviation.-outlierVariance-  :: Double -- ^ mean-  -> Double -- ^ standard deviation.-  -> Double -- ^ Number of original iterations.-  -> OutlierVariance-outlierVariance µ σ a = OutlierVariance effect desc varOutMin-    where-    µa    = µ / a-    µgMin = µa / 2-    σg2   = σg * σg where σg = min (µgMin / 4) (σ / sqrt a)-    σ2    = σ * σ-    varOut c  = (ac / a) * (σ2 - ac * σg2) where ac = a - c-    cMax x    = fromIntegral (floor (-2 * k0 / (k1 + sqrt det)) :: Int)-        where-        ad = a * d-            where-            d = k * k-            k = µa - x-        k0    = -a * ad-        k1    = σ2 - a * σg2 + ad-        det   = k1 * k1 - 4 * σg2 * k0--    minBy f q r = min (f q) (f r)-    varOutMin = if σ2 == 0-                then 0-                else (minBy varOut 1 (minBy cMax 0 µgMin)) / σ2--    (effect, desc) | varOutMin < 0.01 = (Unaffected, "no")-                   | varOutMin < 0.1  = (Slight,     "slight")-                   | varOutMin < 0.5  = (Moderate,   "moderate")-                   | otherwise        = (Severe,     "severe")---- | Count the total number of outliers in a sample.-countOutliers :: Outliers -> Int64-countOutliers (Outliers _ a b c d) = a + b + c + d-{-# INLINE countOutliers #-}------------------------------------------------------------------------------------ Linear regression----------------------------------------------------------------------------------useRegression :: Bool-useRegression = True--useBootstrap :: Bool-useBootstrap = True--resampleCount :: Int-resampleCount = 1000--confidence :: CL Double-confidence = cl95--regress-    :: GenIO-    -> Int  -- index of the iters field, we return the coefficient of only the-            -- iters field-    -> [String] -- responder column names-    -> [([Double], [Double])]-    -> IO [Maybe (Estimate ConfInt Double, Estimate ConfInt Double)]-regress randGen i rcols samples = do-    -- perform ordinary least squares regression for each field-    -- the main predictor is the number of iterations-    let predVectors = map U.fromList $ transpose $ map fst samples-        regressWithIters = mapM (bootstrapRegress randGen resampleCount-                                confidence olsRegress predVectors)--    let avoidMaxFields name vec =-            if isMaxField name-            then Nothing-            else Just vec-    let respVectors = map U.fromList $ transpose $ map snd samples-    res <- mapM regressWithIters (zipWith avoidMaxFields rcols respVectors)-    return $ map (fmap (\(v,r2) -> ((G.toList v) !! i, r2))) res------------------------------------------------------------------------------------ Mean and std deviation by boostrap resampling----------------------------------------------------------------------------------estimateMeanAndStdDev-    :: GenIO-    -> [U.Vector Double]-    -> IO [(Estimate ConfInt Double, Estimate ConfInt Double)]-estimateMeanAndStdDev randGen vectors = do-    let resamp = resample randGen [St.Mean, St.StdDev] resampleCount-    res <- mapM resamp vectors-    return $ fmap (\[mn,dev] -> (mn, dev))-        $ getZipList-        $ bootstrapBCA confidence-            <$> ZipList vectors-            <*> ZipList res------------------------------------------------------------------------------------ Statistical analysis of benchmark iterations------------------------------------------------------------------------------------ By default the fields are considered "scaled" fields that is--- they scale by iterations. However in case of maxrss field it is--- a max value across the experiment and does not scale by--- iterations, in this case we just need to take a mean or max--- without scaling.-isMaxField :: String -> Bool-isMaxField fieldName = map toLower fieldName == "maxrss"--rescaleIteration :: Int -> [String] -> ([Double], [Double]) -> [Double]-rescaleIteration idx rcols (pvals, vals) =-    let iter = pvals !! idx-    in zipWith ($) (map ($ iter) foldFields) vals--    where--    getMeanOrMax fname i val =-        if isMaxField fname-        then val-        else val / i--    foldFields = map getMeanOrMax rcols--data AnalyzedField = AnalyzedField-    { analyzedMean       :: !Double-    , analyzedStdDev     :: !Double--    , analyzedMedian     :: !Double-    , analyzedOutliers   :: !Outliers-    , analyzedOutlierVar :: !OutlierVariance-    , analyzedKDE        :: !(U.Vector Double, U.Vector Double)--    , analyzedRegCoeff   :: Maybe (Estimate ConfInt Double)-    , analyzedRegRSq     :: Maybe (Estimate ConfInt Double)-    } deriving Show---- | The statistical estimator used to arrive at a single value for a--- benchmark when samples from multiple experiments are available.------ @since 0.2.0-data Estimator =-      Median        -- ^ Report the median, outliers and outlier variance using-                    -- box-plot method. This is the most robust indicator-                    -- with respect to outliers when successive runs of-                    -- benchmarks are compared.-    | Mean          -- ^ Report the mean and the standard deviation from the-                    -- mean. This is less robust than median but more precise.-    | Regression    -- ^ Report the coefficient of regression, discarding the-                    -- constant factor, arrived at by linear regression using-                    -- ordinary least square method.  The R-square-                    -- goodness-of-fit estimate is also reported.  It works-                    -- better when larger number of samples are taken.  This-                    -- cannot be used when the number of samples is less than-                    -- 2, in that case a mean value is reported instead.-    deriving (Eq, Show, Read)--getAnalyzedValue :: Estimator -> AnalyzedField -> Double-getAnalyzedValue estimator AnalyzedField{..} =-    case estimator of-        Median -> analyzedMedian-        Mean -> analyzedMean-        Regression ->-            case analyzedRegCoeff of-                Nothing -> analyzedMean-                Just x -> estPoint x---- | Perform an analysis of a measurement.-analyzeBenchmark :: GenIO-                 -> [String]-                 -> [String]-                 -> [([Double], [Double])]-                 -> IO [AnalyzedField]-analyzeBenchmark randGen pcols rcols samples = do-    let sampleCnt = length samples-        i = fromMaybe (error "bug") $ elemIndex "iters" pcols-        vectors = map U.fromList-            $ transpose-            $ map (rescaleIteration i rcols) samples--    (coeffs, r2s) <--        -- olsRegress fails if there are fewer samples than predictors-        if useRegression && length samples >= (length pcols + 1)-        then do-            let f (Just (x, y)) = (Just x, Just y)-                f Nothing = (Nothing, Nothing)-            fmap (unzip . map f) $ regress randGen i rcols samples-        else do-            let n = length rcols-            return (replicate n Nothing, replicate n Nothing)--    (means, devs) <--        if useBootstrap && length samples >= 3-        then do-            (ms, ds) <- fmap unzip $ estimateMeanAndStdDev randGen vectors-            return (map estPoint ms, map estPoint ds)-        else do-            -- Even for max fields (e.g. maxrss) we take the mean-            let ms = map mean vectors-                ds = map stdDev vectors-            return (ms, ds)--    let len = U.length $ head vectors-        median v = (sort v) U.! (len `div` 2)-        medians = map median vectors-        outliers = getZipList $ classifyOutliers <$> ZipList vectors-        outlierVars = getZipList-                $ outlierVariance-                    <$> ZipList means-                    <*> ZipList devs-                    <*> pure (fromIntegral sampleCnt)-        kdes = map (kde 128) vectors--    return $ getZipList $ AnalyzedField-        <$> ZipList means-        <*> ZipList devs--        <*> ZipList medians-        <*> ZipList outliers-        <*> ZipList outlierVars-        <*> ZipList kdes--        <*> ZipList coeffs-        <*> ZipList r2s---- predictor matrix-data BenchmarkIterMatrix = BenchmarkIterMatrix-    { iterPredColNames  :: ![String]  -- predictor column names-    , iterRespColNames  :: ![String]  -- responder column names-    -- (Benchmark, [(predictor columns, responder columns)])-    , iterRowValues :: ![(String, [([Double], [Double])])]-    } deriving Show---- Stored in row major order-data BenchmarkMatrix = BenchmarkMatrix-    { colNames  :: ![String]-    , rowValues :: ![(String, [AnalyzedField])] -- (Benchmark, columns)-    } deriving Show--foldBenchmark :: BenchmarkIterMatrix -> IO BenchmarkMatrix-foldBenchmark BenchmarkIterMatrix{..} = do-    randGen <- createSystemRandom-    rows <- mapM (foldIters randGen) iterRowValues-    return $ BenchmarkMatrix-        { colNames = iterRespColNames-        , rowValues = rows-        }--    where--    foldIters randGen (name, vals) = do-            vals' <- analyzeBenchmark randGen iterPredColNames-                                      iterRespColNames vals-            return (name, vals')---- take top samples--- XXX take equivalent iterations across multiple groups-filterSamples :: BenchmarkIterMatrix -> BenchmarkIterMatrix-filterSamples matrix@BenchmarkIterMatrix{..} =-    matrix-        {--        {-          iterRowValues = map filterIters iterRowValues-        }--    where--    iterIndex = fromMaybe undefined-        $ elemIndex "iters" (map (map toLower) iterPredColNames)-    nivcswIndex = fromMaybe undefined-        $ elemIndex "nivcsw" (map (map toLower) iterPredColNames)-    filterIters (name, vals) =-        let vals'' = take 50 $ reverse $ sortBy (comparing ((!! iterIndex) .  fst)) vals-        let vals' = filter (\(x,_) -> x !! nivcswIndex < 10) vals-            vals'' =-                if null vals'-                then trace "null after filter" vals-                else vals'-        in (name, vals'')-        -}

@@ -1,1372 +0,0 @@--- |--- Module      : BenchShow.Common--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC-----{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}--module BenchShow.Common-    ( Presentation(..)-    , GroupStyle(..)-    , FieldTick (..)-    , SortColumn (..)-    , RelativeUnit (..)-    , Estimator (..)-    , DiffStrategy (..)-    , TitleAnnotation (..)-    , Config(..)-    , defaultConfig--    , getFieldRange-    , getFieldTick--    , GroupMatrix(..)-    , prepareGroupMatrices--    , ReportColumn(..)-    , RawReport(..)-    , ReportType(..)-    , diffString-    , makeTitle-    , prepareToReport-    , reportComparingGroups-    , reportPerGroup-    ) where--import Control.Applicative (ZipList(..))-import Control.Arrow (second)-import Control.Exception (assert)-import Control.Monad (when, unless)-import Data.Char (toLower)-import Data.Foldable (foldl')-import Data.Function ((&), on)-import Data.List-       (transpose, groupBy, (\\), find, sortBy, elemIndex, intersect,-        intersectBy)-import Data.List.Split (linesBy)-import Data.Maybe (fromMaybe, mapMaybe)-import Data.Ord (comparing)-import Debug.Trace (trace)-import Statistics.Types (Estimate(..), ConfInt(..))-import System.Directory (createDirectoryIfMissing)-import System.FilePath ((</>))-import Text.CSV (CSV, parseCSVFromFile)-import Text.Read (readMaybe)--import BenchShow.Analysis------------------------------------------------------------------------------------ Utilities----------------------------------------------------------------------------------filterSanity :: (Eq a, Show a) => String -> [a] -> [a] -> IO ()-filterSanity label old new = do-    let added = new \\ old--    when (null new) $ error $-        label ++ " must select at least one item from the list: "-        ++ show old--    unless (null added) $ error $-        label ++-        " must not add any new items to the original list. The \-        \following items were added: " ++ show added-        ++ "\nOriginal groups: " ++ show old-        ++ "\nNew groups: " ++ show new-----------------------------------------------------------------------------------data ReportType = TextReport | GraphicalChart---- | How to show the results for multiple benchmark groups presented in columns--- or bar chart clusters. In relative comparisons, the first group is--- considered as the baseline and the subsequent groups are compared against--- the baseline.------ /Definition changed in 0.3.0/--- @since 0.2.0-data GroupStyle =-      Absolute    -- ^ Show absolute values of the field for all groups-    | Diff        -- ^ Show baseline group as absolute values and values for-                  -- the subsequent groups as difference from the baseline-    | PercentDiff -- ^ If the value of the group being compared is higher than-                  -- the baseline then display the difference as percentage of-                  -- baseline otherwise display the difference as a percentage-                  -- of the group being compared.-    | Multiples   -- ^ If the value of the group being compared is higher than-                  -- the baseline then display @+(value / baseline value)@-                  -- otherwise display @-(baseline value / value)@. This-                  -- provides a normalized comparison independent of the-                  -- absolute value of a benchmark. Note that 'Multiples' can-                  -- be directly computed using 'PercentDiff' and vice-versa.-    deriving (Eq, Show, Read)---- | How to present the reports or graphs. Each report presents a number of--- benchmarks as rows, it may have, (1) a single column presenting the values--- for a single field, (2) multiple columns presenting values for different--- fields, or (3) multiple columns presenting values of the same field for--- different groups.------ @since 0.2.0-data Presentation =-      Solo              -- ^ Reports are generated for each group and for-                        -- each field selected by the configuration. Each-                        -- report presents benchmarks in a single group with a-                        -- single column presenting a single field.  If there-                        -- are @m@ fields and @n@ groups selected by the-                        -- configuration then a total of @m x n@ reports are-                        -- generated.  Output files are named using-                        -- @-estimator-groupname-fieldname@ as suffix.-    | Groups GroupStyle -- ^ One report is generated for each field selected by-                        -- the configuration. Each report presents a field-                        -- with all the groups selected by the configuration as-                        -- columns or clusters. Output files are named using-                        -- @-estimator-fieldname@ as suffix.-    | Fields            -- ^ One report is generated for each group selected by-                        -- the configuration. Each report presents a group-                        -- with all the fields selected by the configuration as-                        -- columns or clusters. Output files are named using-                        -- @-estimator-groupname@ as suffix.-    deriving (Eq, Show, Read)---- | FieldTick is used only in visual charts to generate the major ticks on--- the y-axis. You can specify either the size of a tick ('TickSize') or the--- total number of ticks ('TickCount').------ @since 0.2.0-data FieldTick =-      TickSize Int  -- ^ Size of a tick, the unit is microseconds for time-                     -- fields, and bytes for space fields.-    | TickCount Int -- ^ Total number of ticks in the range spread.---- | When sorting and filtering the benchmarks using 'selectBenchmarks' we can--- choose a column as a sort criterion.  'selectBenchmarks' is provided with--- the data for the corresponding column which can be used for sorting the--- benchmarks. The column could be a group or a field depending on the--- 'Presentation'.------ @since 0.2.0-data SortColumn =-      ColumnIndex Int -- ^ Specify the index of the sort column. Index 0-        -- corresponds to the first @value@ column. In a textual report, the-        -- very first column consists of benchmark names, therefore index 0-        -- addresses the second column of the report.-    | ColumnName (Either String (String, Int)) -- ^ Specify the column using-        -- the name of the group or the field it represents, and the @runId@.-        -- When just the name is enough to uniquely identify the sort column-        -- the 'Left' constructor can be used, otherwise the 'Right'-        -- constructor is used which can use the @runId@ to disambiguate.  In a-        -- 'Fields' presentation, just the field name is enough.  In a 'Groups'-        -- presentation, when there is a single benchmark run in the input-        -- file, just the group name is enough to identify the group, the-        -- @runId@ defaults to 0.  However, when there are multiple runs, a-        -- group needs to specify a @runId@ as well.---- | Strategy to compute the difference between two groups of benchmarks being--- compared.------ @since 0.2.0-data DiffStrategy =-      SingleEstimator -- ^ Use a single estimator to compute the difference-                      -- between the baseline and the candidate. The estimator-                      -- that is provided in the 'Config' is used.-    | MinEstimator    -- ^ Use 'Mean', 'Median' and 'Regression' estimators for-                      -- both baseline and candidate, and report the estimator-                      -- that shows the minimum difference. This is more robust-                      -- against random variations.-    {--    | WorstBest-    | BestBest-    -}-    deriving (Show, Read)---- | Additional annotations that can be optionally added to the title of the--- report or graph.------ @since 0.2.2-{-# DEPRECATED TitleAnnotation "Please use mkTitle to make a custom title" #-}-data TitleAnnotation = TitleField | TitleEstimator | TitleDiff-    deriving (Eq, Show, Read)---- | Configuration governing generation of chart. See 'defaultConfig' for the--- default values of these fields.------ @since 0.2.0-data Config = Config-    {-    -- | Provide more details in the report, especially the standard deviation,-    -- outlier variance, R-square estimate and an annotation to indicate the-    -- actual method used when using 'MinEstimator' are reported.-      verbose :: Bool--    -- | The directory where the output graph or report file should be placed.-    , outputDir   :: Maybe FilePath--    -- | Function to make a title for the report. The argument to the function-    -- is the benchmark field name for which the report is being made.-    , mkTitle  :: Maybe (String -> String)--    -- | /DEPRECATED: Please use 'mkTitle' instead./-    ---    -- Report title, more information like the plotted field name or-    -- the presentation style may be added to it.-    , title  :: Maybe String--    -- | /DEPRECATED: Please use 'mkTitle' instead./-    ---    -- Additional annotations to be added to the title-    , titleAnnotations :: [TitleAnnotation]--    -- | How to determine the layout of the report or the chart.-    , presentation :: Presentation--    -- | The estimator used for the report.-    , estimator    :: Estimator--    -- | The minimum percentage difference between two runs of a benchmark-    -- beyond which the benchmark is flagged to have regressed or improved.-    , threshold :: Word--    -- | Strategy to compare two runs or groups of benchmarks.-    , diffStrategy  :: DiffStrategy--    -- | Omit the baseline group in normalized relative comparisons i.e.-    -- when the 'GroupStyle' is 'PercentDiff' or 'Multiples'.-    , omitBaseline :: Bool--    ----------------------------------------------------------------------------    -- Fields (Columns)-    -----------------------------------------------------------------------------    -- | Filter and reorder the benchmarking fields. It is invoked with a list-    -- of all available benchmarking fields. Only those fields present in the-    -- output of this function are plotted and in that order.-    , selectFields :: [String] -> [String]--    -- | The values in the tuple are @(fieldName, RangeMin, RangeMax)@.-    -- Specify the min and max range of benchmarking fields. If the field-    -- value is outside the range it is clipped to the range limit.-    -- For time fields, the range values are in microseconds, and for space-    -- fields they are in bytes. The minimum of the range is used to determine-    -- the unit for the field.-    , fieldRanges :: [(String, Double, Double)]--    -- | The values in the tuple are @(fieldName, tick)@.  Specify the-    -- tick size of the fields to be used for the graphical reports.-    , fieldTicks :: [(String, FieldTick)]--    ----------------------------------------------------------------------------    -- Groups (Row Grouping)-    -----------------------------------------------------------------------------    -- | Filter, group and translate benchmark names. This function is invoked-    -- once for all benchmark names found in the results. It produces a tuple-    -- @(groupname, benchname)@, where @groupname@ is the name of the group the-    -- benchmark should be placed in, and @benchname@ is the translated-    -- benchmark name to be used in the report.  If it returns 'Nothing' for a-    -- benchmark, that benchmark is omitted from the results.-    , classifyBenchmark :: String -> Maybe (String, String)--    -- | Filter and reorder the benchmark group names. A benchmark group may be-    -- assigned using 'classifyBenchmark'; when not assigned, all benchmarks-    -- are placed in the @default@ group. The input to this function is a list-    -- of tuples with benchmark group names and the @runId@s.  The output-    -- produced by this function is a filtered and reordered subset of the-    -- input.  Only those benchmark groups present in the output are rendered-    -- and are presented in that order.-    , selectGroups :: [(String, Int)] -> [(String, Int)]--    ----------------------------------------------------------------------------    -- Benchmarks (Rows)-    -----------------------------------------------------------------------------    -- | Filter and reorder benchmarks. 'selectBenchmarks' takes a function-    -- argument, the function is invoked with a sorting column name or index-    -- and a 'GroupStyle'. The output of the function is either a 'Right' value-    -- consisting of tuples of the benchmark names and values corresponding to-    -- the given column and style or a 'Left' value indicating an error.-    -- 'selectBenchmarks' can inspect these benchmarks and there values to-    -- produce a filtered and sorted list of benchmark names that are to be-    -- rendered.-    ---    -- The style argument is ignored when the report presentation is not-    -- 'Groups'. When style is 'Nothing', the presentation setting specified in-    -- the configuration is used.-    ---    -- /Signature changed in 0.3.0/-    , selectBenchmarks-        :: (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])-        -> [String]-    }---- IMPORTANT: If you change the defaults, please change the defaults in the CLI--- help as well.------ | Default configuration. Use this as the base configuration and modify the--- required fields. The defaults are:------ @---  verbose           = False---  mkTitle           = Nothing---  titleAnnotations  = [TitleField]---  outputDir         = Nothing---  presentation      = Groups Absolute---  estimator         = Median---  threshold         = 3---  diffStrategy      = SingleEstimator---  omitBaseline      = False---  selectFields      = filter (flip elem ["time", "mean", "maxrss"] . map toLower)---  fieldRanges       = []---  fieldTicks        = []---  classifyBenchmark = Just . ("default",)---  selectGroups      = id---  selectBenchmarks  = \f -> either error (map fst) $ f (ColumnIndex 0) Nothing--- @------ @since 0.2.0-defaultConfig :: Config-defaultConfig = Config-    { verbose           = False-    , mkTitle           = Nothing-    , title             = Nothing-    , titleAnnotations  = [TitleField]-    , outputDir         = Nothing-    , presentation      = Groups Absolute-    , estimator         = Median-    , threshold         = 3-    , diffStrategy      = SingleEstimator-    , omitBaseline      = False-    , selectFields      = filter (flip elem ["time", "mean", "maxrss"] . map toLower)-    , fieldRanges       = []-    , fieldTicks        = []-    , classifyBenchmark = Just . ("default",)-    , selectGroups      = id-    , selectBenchmarks  = \f -> either error (map fst) $ f (ColumnIndex 0) Nothing-    }------------------------------------------------------------------------------------ Benchmarking field types----------------------------------------------------------------------------------timeFields :: [String]-timeFields = map (map toLower)-    [ "time"-    , "mean"-    , "cpuTime"-    , "utime"-    , "stime"-    , "mutatorWallSeconds"-    , "mutatorCpuSeconds"-    , "gcWallSeconds"-    , "gcCpuSeconds"-    ]--isTimeField :: String -> Bool-isTimeField fieldName = map toLower fieldName `elem` timeFields--allocFields :: [String]-allocFields = map (map toLower) ["allocated", "bytesCopied", "maxrss"]--isAllocationField :: String -> Bool-isAllocationField fieldName = map toLower fieldName `elem` allocFields--predictorFields :: [String]-predictorFields = map (map toLower)-    [ "iters"-    -- , "minflt"-    -- , "majflt"-    -- , "nvcsw"-    -- , "nivcsw"-    ]--isPredictorField :: String -> Bool-isPredictorField fieldName = map toLower fieldName `elem` predictorFields------------------------------------------------------------------------------------ Units------------------------------------------------------------------------------------ | Describe a relative unit i.e. a unit in terms of another unit. A relative--- unit has a label and a ratio which when multiplied with the unit gives us--- the other unit. For example, if the known time unit is seconds, we can--- describe a millisecond as @Unit "ms" (1/1000)@.-data RelativeUnit = RelativeUnit String Double deriving Show--getTimeUnit :: Double -> RelativeUnit-getTimeUnit k-    | k < 0      = getTimeUnit (-k)-    | k >= 1     = RelativeUnit "s" 1-    | k >= 1e-3  = RelativeUnit "ms" 1e-3-    | k >= 1e-6  = RelativeUnit "μs" 1e-6-    | otherwise  = RelativeUnit "ns" 1e-9--getSpaceUnit :: Double -> RelativeUnit-getSpaceUnit k-    | k < 0             = getSpaceUnit (-k)-    | k >= 2^(30 ::Int) = RelativeUnit "GiB" (2^(30 :: Int))-    | k >= 2^(20 ::Int) = RelativeUnit "MiB" (2^(20 :: Int))-    | k >= 2^(10 ::Int) = RelativeUnit "KiB" (2^(10 :: Int))-    | otherwise         = RelativeUnit "Bytes" 1--getUnitByFieldName :: String -> Double -> RelativeUnit-getUnitByFieldName fieldName fieldMin =-    case isTimeField fieldName of-        True -> getTimeUnit fieldMin-        False -> case isAllocationField fieldName of-            True -> getSpaceUnit fieldMin-            False -> RelativeUnit "" 1---- returns (multiplier, units)-fieldUnits :: String -> Double -> GroupStyle -> RelativeUnit-fieldUnits fieldName fieldMin style =-    case style of-        Multiples   -> RelativeUnit "x" 1-        PercentDiff -> RelativeUnit "%" 1-        _ -> getUnitByFieldName fieldName fieldMin------------------------------------------------------------------------------------ Comparison----------------------------------------------------------------------------------absoluteDiff :: Num a => a -> a -> a-absoluteDiff v1 v2 = v2 - v1--percentDiff :: (Fractional a, Num a, Ord a) => a -> a -> a-percentDiff v1 v2 = ((v2 - v1) * 100) / min v1 v2---- We map a fraction x between 0 and 1 to a negative 1/x for plotting on an--- equal and opposite scale.-fraction :: (Fractional a, Num a, Ord a, Show a) => a -> a -> a-fraction v1 v2 =-    let val = v2 / v1-    in case val of-            x | x <= 0 -> error $ "BenchShow.Common.fraction: negative: " ++ show x-            x | x < 1 -> negate (1 / x)-            x | x >= 1 -> x-            x -> error $ "BenchShow.Common.fraction: unhandled: " ++ show x--cmpTransformColumns :: ReportType-                    -> GroupStyle-                    -> Estimator-                    -> DiffStrategy-                    -- XXX we do not really need the benchmark name here-                    -> [[(String, AnalyzedField)]]-                    -> (Maybe [[Estimator]], [[(String, Double)]])-cmpTransformColumns rtype style estimator diffStrategy cols =-    let cmpWith diff =-            let firstCol = head columns-                colTransform col =-                    let mkDiff (n1, v1) (n2,v2) =-                            verify (n1 == n2) (n2, diff v1 v2)-                    in zipWith mkDiff firstCol col-            in map colTransform (tail columns)--        cmpMinWith diff =-            let firstCol = head cols-                colTransform col = zipWith (mkMinDiff diff) firstCol col-            in map colTransform (tail cols)--        diffWith f =-                case diffStrategy of-                    MinEstimator ->-                        let (ests, vals) = unzip $ map unzip (cmpMinWith f)-                        in ( Just $ map (const estimator) (head cols) : ests-                           , head columns : vals-                           )-                    SingleEstimator ->-                        (Nothing, head columns : cmpWith f)--        relativeDiffWith baseVal f =-            -- In a comparative graphical chart we cannot show the absolute-            -- values in the baseline column as the units won't match for-            -- the baseline and the diff clusters.-            let baseCol =-                    case rtype of-                        TextReport -> head columns-                        GraphicalChart | length columns == 1 ->-                            head columns-                        GraphicalChart ->-                            map (\(n,_) -> (n,baseVal)) (head columns)-            in case diffStrategy of-                MinEstimator ->-                    let (ests, vals) = unzip $ map unzip (cmpMinWith f)-                    in ( Just $ map (const estimator) (head cols) : ests-                       , baseCol : vals-                       )-                SingleEstimator ->-                   (Nothing, baseCol : cmpWith f)-    in case style of-            Absolute    -> diffWith (\_ x -> x)-            Diff        -> diffWith absoluteDiff-            PercentDiff -> relativeDiffWith 100 percentDiff-            Multiples   -> relativeDiffWith 1 fraction-    where-        verify a b = if a then b else error "bug: benchmark names mismatch"-        transformVals = map (map (second (getAnalyzedValue estimator)))-        columns = transformVals cols--        -- Find which estimator gives us the minimum diff-        mkMinDiff diff (n1, v1) (n2,v2) = verify (n1 == n2) $-            let meanDiff = diff (getAnalyzedValue Mean v1)-                                (getAnalyzedValue Mean v2)-                medDiff = diff (getAnalyzedValue Median v1)-                               (getAnalyzedValue Median v2)-                regDiff = diff (getAnalyzedValue Regression v1)-                               (getAnalyzedValue Regression v2)-            in if abs medDiff <= abs meanDiff-               then if abs medDiff <= abs regDiff-                    then (Median, (n2, medDiff))-                    else (Regression, (n2, regDiff))-                else if abs meanDiff <= abs regDiff-                     then (Mean, (n2, meanDiff))-                     else (Regression, (n2, regDiff))--columnNameByStyle :: GroupStyle -> [ReportColumn] -> [ReportColumn]-columnNameByStyle _ [] = []-columnNameByStyle style columns@(h:t) =-    let withDiff name = colSuffix baseName h : map (colSuffix name) t-    in case style of-            Diff        | length columns > 1 -> withDiff diffName-            Multiples   | length columns > 1 -> withDiff fracName-            PercentDiff | length columns > 1 -> withDiff diffName-            _ -> columns--    where-    colSuffix xl col = col { colName = xl (colName col) }-    baseName        = id -- (++ "(base)")-    diffName        = (++ " - " ++ colName h) -- "(-base)")-    fracName        = (++ "/" ++ colName h) -- "/base")--columnNameByUnit :: [RelativeUnit] -> [ReportColumn] -> [ReportColumn]-columnNameByUnit units columns =-    let applyUnit col (RelativeUnit label _) =-            col { colName = colName col ++ inParens label }-    in zipWith applyUnit columns units---- Represents the data for a single benchmark run-data GroupMatrix = GroupMatrix-    { groupIndex :: Int-    , groupName   :: String-    , groupBenches :: [(String, String)] -- (newname, origname)-    , groupMatrix :: BenchmarkMatrix-    } deriving Show---- Each run may be split into multiple groups of benchmarks.  Benchmarks can be--- renamed by the classifier. Sanity checks:--- Two original benchmarks cannot map to the same target benchmark------ When using a comparative style report, after filtering and sorting:--- Same original benchmark cannot belong to multiple groups--- All groups must have exactly the same benchmark names-splitGroup :: (String -> Maybe (String, String))-           -> (Int, BenchmarkMatrix)-           -> [GroupMatrix]-splitGroup classify (serial, matrix@BenchmarkMatrix{..}) =-    let classified = mapMaybe (\x -> fmap (,x) $ classify x) (map fst rowValues)-    in if null classified-       then error "No benchmarks were selected by \"classifyBenchmark\""-       else-          sortBy (comparing (fst . fst)) classified-        & groupBy ((==) `on` (fst . fst))-        & map (foldr foldGroup ("",[]))-        & map sanityCheckGroup-        & map (\(name, benches) ->-            GroupMatrix-            { groupIndex  = serial-            , groupName    = name-            , groupBenches = benches-            , groupMatrix  = matrix-            })--    where--    foldGroup ((grp, bench), srcBench) (_, tuples) =-        (grp, (bench, srcBench) : tuples)--    sanityCheckGroup orig@(grp, tuples) =-        let duplicated =-                  sortBy (comparing fst) tuples-                & groupBy ((==) `on` fst)-                & filter ((>1) . length)-        in if not $ null duplicated-           then-            let msg = unlines (map show duplicated)-            in error $ "Two benchmarks must not map to the same target \-               \benchmark. Please check your 'classifyBenchmark' operation. \-               \In group " ++ show grp ++ ", the following target benchmarks \-               \are mapped to more than one source benchmarks:\n" ++ msg-            else orig------------------------------------------------------------------------------------ sort the benchmark groups----------------------------------------------------------------------------------findGroup :: [GroupMatrix] -> (String, Int) -> Maybe GroupMatrix-findGroup matrices (name, i) =-    find (\x -> groupName x == name && groupIndex x == i) matrices--sortGroups :: Config -> [GroupMatrix] -> IO [GroupMatrix]-sortGroups Config{..} matrices = do-    let origGroups = map (\x -> (groupName x, groupIndex x)) matrices-        newGroups = selectGroups origGroups--    filterSanity "selectGroups" origGroups newGroups-    return $ mapMaybe (findGroup matrices) newGroups------------------------------------------------------------------------------------ sort the benchmarks----------------------------------------------------------------------------------extractColumn :: String -> GroupMatrix -> [(String, AnalyzedField)]-extractColumn field GroupMatrix{..} =-    let idx = elemIndex field (colNames groupMatrix)-        vals = case idx of-            Just i -> map (!! i) (map snd (rowValues groupMatrix))-            Nothing -> error $ "Field [" ++ field-                ++ "] does not exist in group ["-                ++ groupName ++ "] and run id [" ++ show groupIndex ++ "]"-    in zip (map fst groupBenches) vals--extractColumnValue :: String -> GroupMatrix -> Estimator -> [(String, Double)]-extractColumnValue field matrix estimator =-    map (second (getAnalyzedValue estimator)) $ extractColumn field matrix--benchmarkCompareSanity :: [String] -> GroupMatrix -> [String]-benchmarkCompareSanity benchmarks GroupMatrix{..} = do-    let benches = map fst groupBenches-    let absent = benchmarks \\ benches-    let msg =-            "selectBenchmarks: Group [" ++ groupName ++ "] run id ["-            ++ show groupIndex-            ++ "] does not contain the following selected benchmarks; \-            \ignoring them: " ++ show absent-            ++ "\nAvailable benchmarks in this group are: "-            ++ show benches--    if (null absent)-    then benchmarks-    else trace msg (benchmarks \\ absent)--selectBenchmarksByField :: Config-                        -> [GroupMatrix]-                        -> [[(String, Double)]]-                        -> (GroupStyle -> [[(String, Double)]])-                        -> [String]-selectBenchmarksByField Config{..} matrices columns colsByStyle =-    let bmnames = selectBenchmarks extractGroup-    in if (null bmnames)-       then error $ "selectBenchmarks must select at least one benchmark"-       else-           -- XXX instead of matrices we can just use columns here-           let xs = foldl benchmarkCompareSanity bmnames matrices-           in if (null xs)-              then error $ "selectBenchmarks: none of the selected benchmarks "-                    ++ show bmnames-                    ++ " is common to all the benchmark groups "-                    ++ show grpNames-              else xs--    where--    grpNames =-        let getName x = (groupName x, groupIndex x)-        in map getName matrices--    -- columns are benchmark groups in this case-    extractGroup colSelector style =-            let cols = case style of-                    Nothing -> columns-                    Just s -> colsByStyle s-            in case colSelector of-                ColumnName (Left name) ->-                    let len = length cols-                    in if len <= 1-                       then extractGroup (ColumnName (Right (name, 0))) style-                       else Left $ "selectBenchmarks: there are " ++ show len-                            ++ " runs in the input data, please specify the run \-                            \index [0-" ++ show (len - 1)-                            ++ "] along with the group name."-                ColumnName (Right (name, runId)) ->-                    extractColumnByGroupName name runId style-                ColumnIndex n -> extractColumnByGroupIndex n cols--    -- The benchmark field is constant.  Extract all benchmark values for the-    -- given field and for the given group.-    findColumnIndex mxs (name, runId) =-        let foldFunc res@(idx, found) grp =-                case found of-                    False ->-                        if groupName grp == name && groupIndex grp == runId-                        then (idx, True)-                        else (idx + 1, found)-                    True -> res-        in foldl foldFunc (0, False) mxs--    extractColumnByGroupName name runId style =-            case findColumnIndex matrices (name, runId) of-                (_, False) -> Left $ "Benchmark group name [" ++ name-                            ++ "] and index [" ++ show runId-                            ++ "] not found. Available groups are: "-                            ++ show grpNames-                (i, True) -> extractGroup (ColumnIndex i) style--    extractColumnByGroupIndex idx cols =-        let len = length cols-        in if idx >= len-           then Left $ "Column index must be in the range [0-"-                ++ show (len - 1) ++ "]"-           else Right $ cols !! idx--selectBenchmarksByGroup :: Config -> GroupMatrix -> [String]-selectBenchmarksByGroup Config{..} grp@GroupMatrix{..} =-    -- XXX this is common to ByField and ByGroup-    let bmnames = selectBenchmarks extractField-    in if (null bmnames)-       then error $ "selectBenchmarks must select at least one benchmark"-       else bmnames--    where--    -- columns are benchmark fields in this case-    extractField (ColumnName (Left name)) _ = extractColumnByFieldName name-    extractField (ColumnName (Right (name, _))) _ =-        -- XXX runId does not make sense for fields-        extractColumnByFieldName name-    extractField (ColumnIndex n) _ = extractColumnByFieldIndex n--    -- The benchmark field is constant.  Extract all benchmark values for the-    -- given field and for the given group.-    extractColumnByFieldName name =-        let fields = colNames groupMatrix-        in case elem name fields of-            False -> Left $ "Benchmark field name [" ++ name-                        ++ "] not found in group ["-                        ++ groupName ++ "]. Available fields are: "-                        ++ show fields-            True -> Right $ extractColumnValue name grp estimator--    extractColumnByFieldIndex idx =-        let fields = colNames groupMatrix-            len = length fields-        in if idx >= len-           then Left $ "Column index must be in the range [0-"-                ++ show (len - 1) ++ "]"-           else Right $ extractColumnValue (fields !! idx) grp estimator--type NumberedLines = [(Int, [String])]--sanityCheckCSV :: CSV -> NumberedLines-sanityCheckCSV csvlines | null csvlines = error $ "The input file is empty"-sanityCheckCSV csvlines =-    let headRow = head csvlines-        rowLen = length headRow-    in  if not $ "name" `elem` map (map toLower) headRow-        then error "No 'Name' column found in the CSV header line"-        else-          -- Add line numbers for error reporting-          zip [1..] csvlines-          -- cleanup blank rows-        & filter (\(_,xs) -> xs /= [""])--          -- make sure all lines are of the same size, So that we can transpose-          -- back and forth without losing information.-        & map (\x@(i,xs) ->-               if length xs == rowLen-               then x-               else error $ "Line number " ++ show i-                        ++ " in the input file is not of the same length as\-                            \ the header line"-              )---- An iteration field indicates that consecutive rows with the same benchmark--- name have results from different iterations of the same benchmark and the--- measurement fields have to be scaled per iteration based on the number of--- iterations in the iteration count field.------ Make sure that "iters" and "name" are the first and second columns-ensureIterField :: ([String], [NumberedLines])  -> ([String], [NumberedLines])-ensureIterField (header, groups) =-    ( "iters" : "name" : filter isNotNameIter header-    , map reorderNameIter groups-    )--    where--    isNotNameIter x =-           map toLower x /= "name"-        && map toLower x /= "iters"--    notNameIters [] = True-    notNameIters (x:_) = isNotNameIter x--    nameNotFound = error "Name field is required in the csv file"--    reorderNameIter csvlines =-          unzip csvlines-        & second (header :)-        & second transpose-        & second reorder-        & second transpose-        & uncurry zip--        where--        reorder xs =-            let findField x = find (\(y:_) -> map toLower y == x)-                iterCol = replicate (length (head xs) - 1) "1"-            in   fromMaybe iterCol (fmap tail $ findField "iters" xs)-               : fromMaybe nameNotFound (fmap tail $ findField "name" xs)-               : map tail (filter notNameIters xs)---- Only keep those fields that are passed to this function--- Also, preserve any predictor fields for regression analysis-filterFields :: [String] -> BenchmarkIterMatrix -> BenchmarkIterMatrix-filterFields fieldNames BenchmarkIterMatrix{..} =-    BenchmarkIterMatrix-        { iterPredColNames = ["iters"] ++ filter isPredictorField iterRespColNames-        , iterRespColNames = filter isRequestedField iterRespColNames-        , iterRowValues = transform iterRowValues-        }--    where--    transform :: [(String, [([Double], [Double])])] -> [(String, [([Double], [Double])])]-    transform = map (\(name, tuples) ->-        let (ys, zs) = unzip tuples-            pcols = transpose (map Left iterPredColNames : map (map Right) ys)-            rcols = transpose (map Left iterRespColNames : map (map Right) zs)-            pcols' = pcols ++ filter isPredictor rcols-            rcols' = filter requested rcols-            pcols'' = map (map fromRt) $ tail $ transpose pcols'-            rcols'' = map (map fromRt) $ tail $ transpose rcols'-        in (name, zip pcols'' rcols''))--    fromRt (Right x) = x-    fromRt _ = error "bug"--    isRequestedField = (`elem` fieldNames)--    requested [] = True-    requested (Left x:_) = isRequestedField x-    requested _ = error "bug"--    isPredictor [] = True-    isPredictor (Left x:_) = isPredictorField x-    isPredictor _ = error "bug"---- Split the file into different runs--- return the header fields and list of runs without the header-splitRuns :: NumberedLines -> ([String], [NumberedLines])-splitRuns csvlines =-    let header = snd $ head csvlines-        ls = linesBy (\x -> snd x == header) (tail csvlines)-    in (header, ls)--readWithError :: Read a => Int -> String -> (String, String) -> a-readWithError lno typ (fname, fval) =-    case readMaybe fval of-        Nothing -> error $ "Cannot read " ++ show fname-            ++ " field [" ++ show fval ++ "] as "-            ++ typ ++ " type at line number "-            ++ show lno-        Just n -> n---- An iteration field indicates that consecutive rows with the same benchmark--- name have results from different iterations of the same benchmark and the--- measurement fields have to be scaled per iteration based on the number of--- iterations in the iteration count field.------ If the first column is iteration then fold all iterations and remove the--- iteration column.-readIterations :: [String] -> NumberedLines -> BenchmarkIterMatrix-readIterations header csvlines =-    let tuples =-            map (parseNumericFields header) csvlines-            -- we now have a list of triples [(iter, name, (fieldName, [Double])]-          & groupBy successiveIters-          & map (foldl' addIters ("",[]))-    in BenchmarkIterMatrix-        { iterPredColNames = ["iters"]-        , iterRespColNames = drop 2 header-        , iterRowValues = tuples-        }--    where--    -- The first column is iters and the second is the name-    -- We zip the header for error reporting-    parseNumericFields hdr (lno, vals) = parseNumericTuples lno $ zip hdr vals--    parseNumericTuples lno (iter:(_,name):xs) =-          (readWithError lno "Int" iter :: Int-          , name-          , map (\x@(n,_) -> (n, readWithError lno "Double" x)) xs-                :: [(String, Double)]-          )-    parseNumericTuples _ _ = error "iters and name fields are needed"--    successiveIters (i1,name1,_) (i2,name2,_) = name2 == name1 && i2 > i1--    addIters (_,siters) (iter,name,vals) =-        (name, ([fromIntegral iter], map snd vals) : siters)--getFieldRange :: String -> Config -> Maybe (Double, Double)-getFieldRange fieldName Config{..} =-    let res = find (\(x, _, _) -> x == fieldName) fieldRanges-    in case res of-        Nothing -> Nothing-        Just (_, x, y) -> Just (x, y)--getFieldTick :: String -> Config -> Maybe FieldTick-getFieldTick fieldName Config{..} =-    fmap snd $ find (\x -> fst x == fieldName) fieldTicks--getReportExtension :: ReportType -> String-getReportExtension rtype =-    case rtype of-        TextReport -> ".txt"-        GraphicalChart -> ".svg"--prepareOutputFile :: FilePath -> ReportType -> FilePath -> Estimator -> String -> IO FilePath-prepareOutputFile dir rtype file est field = do-    let estStr = case est of-            Mean -> "mean"-            Median -> "median"-            Regression -> "coeff"-    let path = dir </> (file ++ "-" ++ estStr ++ "-" ++ field-                             ++ getReportExtension rtype)-    return path--prepareToReport :: FilePath -> Config -> IO (CSV, [String])-prepareToReport inputFile Config{..} = do-    case outputDir of-        Nothing -> return ()-        Just dir -> createDirectoryIfMissing True dir-    -- We assume the dataset is not big and therefore take liberties to process-    -- in a non-streaming fashion.-    csvData <- parseCSVFromFile inputFile-    case csvData of-        Left e -> error $ show e-        Right csvlines -> do-            when (null csvlines) $ error $ "The input file ["-                ++ show inputFile ++ "] is empty"-            let allFields = head csvlines-                fields = selectFields allFields-            filterSanity "selectFields" allFields fields-            let filt x = notElem (map toLower x) ["name", "iters"]-            return (csvlines, filter filt fields)---- Keep only those benchmarks that belong to the group.-filterGroupBenchmarks :: [GroupMatrix] -> IO [GroupMatrix]-filterGroupBenchmarks matrices = return $ map filterMatrix matrices-    where-    filterMatrix matrix =-        -- XXX make sure there are no duplicates-        let m = groupMatrix matrix-            vals = map (\(new,old) ->-                (new, fromMaybe (error "bug") $ lookup old (rowValues m)))-                (groupBenches matrix)-        in matrix {groupMatrix = m {rowValues = vals}}--_filterCommonSubsets :: [BenchmarkIterMatrix] -> [BenchmarkIterMatrix]-_filterCommonSubsets matrices =-    let commonPreds =-            let initPreds = matrixPreds $ head matrices-            in foldl' intersectPreds initPreds (tail matrices)-    in map (isectCommonPreds commonPreds) matrices--    where--    pcols = iterPredColNames $ head matrices--    cmpPred name v1 v2 =-            case map toLower name of-                "iters" -> v1 == v2-                "nivcsw" -> v1 == v2-                _ -> v1 == v2--    isectBench (name1, preds1) (name2, preds2) =-        let isect row1 row2 = all id $ zipWith3 cmpPred pcols row1 row2-        in assert (name1 == name2) $ (name1, intersectBy isect preds1 preds2)--    matrixPreds = map (second (map fst)) . iterRowValues--    intersectPreds preds matrix = zipWith isectBench preds (matrixPreds matrix)--    isectRows (name1, preds1) (name2, xs) =-        let isect row1 = find (\(x,_) -> all id-                                $ zipWith3 cmpPred pcols row1 x) xs-        in assert (name1 == name2) $ (name1, mapMaybe isect preds1)--    isectCommonPreds preds matrix@BenchmarkIterMatrix{..} =-        matrix-            { iterRowValues = zipWith isectRows preds iterRowValues-            }---- when comparing make sure all groups have same benchmarks and sort the other--- ones based on the first column so that they are all in the same order.-selectCommon :: [GroupMatrix] -> IO [GroupMatrix]-selectCommon matrices =-    let commonBenches =-            let initBenches = map fst $ groupBenches $ head matrices-            in foldl' intersectBenches initBenches (tail matrices)-    in mapM (isectCommonBenches commonBenches) matrices--    where--    intersectBenches benches matrix =-        intersect benches (map fst $ groupBenches matrix)--    isectCommonBenches benches matrix@GroupMatrix{..} = do-        let absent = map fst groupBenches \\ benches-            msg =-                "Removing benchmarks " ++ show absent-                ++ " from column [" ++ groupName-                ++ "] run id [" ++ show groupIndex ++ "]"-            lookupBench x = lookup x groupBenches-            findBench x = (x, fromMaybe undefined (lookupBench x))-            newBenches = map findBench benches--        unless (null absent) $ putStrLn msg-        return matrix { groupBenches = newBenches }--prepareGroupMatrices :: Config-                     -> FilePath-                     -> CSV-                     -> [String]-                     -> IO (Int, [GroupMatrix])-prepareGroupMatrices cfg@Config{..} inputFile csvlines fields = do-    let res@(_, ls) =-              sanityCheckCSV csvlines-            & splitRuns--    when (null ls) $-        error $ "No benchmark results found in CSV file: " ++ show inputFile--    let checkForData (runId, xs) =-            when (null xs) $-                putStrLn $ "No benchmark results found in the CSV file ["-                        ++ show inputFile-                        ++ "], for runId: "-                        ++ show runId--    mapM_ checkForData (zip [(0 :: Int)..] ls)--    let (hdr, runs) = ensureIterField res--    xs <- sequence $ map (readIterations hdr) runs-            & map (filterFields fields)-            -- & _filterCommonSubsets-            -- & map filterSamples-            & map foldBenchmark--    zip [0..] xs-        & map (splitGroup classifyBenchmark)-        & concat-        & sortGroups cfg-        >>= selectCommon-        >>= filterGroupBenchmarks-        >>= return . (length runs,)---- XXX display GHC version as well--- XXX display the OS/arch--- XXX display compiler/RTS options as well e.g. -threaded and -N--- This data should be in the measurement data--data ReportColumn = ReportColumn-    { colName   :: String-    , colUnit   :: RelativeUnit-    , colValues :: [Double]-    } deriving Show---- XXX put reportAnalyzed in reportColumns-data RawReport = RawReport-    { reportOutputFile :: Maybe FilePath-    , reportIdentifier :: String-    , reportRowIds     :: [String]-    , reportColumns    :: [ReportColumn]-    , reportAnalyzed   :: [[AnalyzedField]]-    , reportEstimators :: Maybe [[Estimator]]-    } deriving Show--getFieldMin :: Config -> Double -> String -> Double-getFieldMin cfg minval fieldName =-    case getFieldRange fieldName cfg of-        Nothing -> minval-        Just (minr, _) -> minr--scaleAnalyzedField :: RelativeUnit -> AnalyzedField -> AnalyzedField-scaleAnalyzedField (RelativeUnit _ mult) AnalyzedField{..} =-    AnalyzedField-    { analyzedMean = analyzedMean / mult-    , analyzedStdDev = analyzedStdDev / mult--    , analyzedMedian = analyzedMedian / mult-    , analyzedOutliers = analyzedOutliers-    , analyzedOutlierVar = analyzedOutlierVar-    , analyzedKDE = analyzedKDE-    , analyzedRegCoeff = case-        analyzedRegCoeff of-            Nothing -> Nothing-            Just Estimate{..} ->-                let ConfInt{..} = estError-                in Just $ Estimate-                    { estPoint = estPoint / mult-                    , estError = ConfInt-                        { confIntLDX = confIntLDX / mult-                        , confIntUDX = confIntUDX / mult-                        , confIntCL = confIntCL-                        }-                    }-    , analyzedRegRSq = analyzedRegRSq-    }--prepareGroupsReport :: Config-                    -> GroupStyle-                    -> Maybe FilePath-                    -> ReportType-                    -> Int-                    -> String-                    -> [GroupMatrix]-                    -> RawReport-prepareGroupsReport cfg@Config{..} style outfile rtype runs field matrices =-    -- XXX Determine the unit based the whole range of values across all columns-    let sortValues :: [String] -> [(String, a)] -> [a]-        sortValues bmarks vals =-            map (\name -> fromMaybe (error "bug") (lookup name vals)) bmarks--        unsortedCols = map (extractColumn field) matrices--        (estimators, transformedCols) =-            cmpTransformColumns rtype style estimator diffStrategy unsortedCols-        transformedColsByStyle s = snd $-            cmpTransformColumns rtype s estimator diffStrategy unsortedCols--        benchmarks = selectBenchmarksByField cfg matrices-                            transformedCols transformedColsByStyle-        sortedCols = map (sortValues benchmarks) transformedCols-        origSortedCols = map (sortValues benchmarks) unsortedCols--        mkColUnits :: [RelativeUnit]-        mkColUnits =-            let cols =-                    if style /= Absolute-                    -- if we consider diff values as well here then the-                    -- units will change to potentially very small.-                    then [head sortedCols]-                    else sortedCols-                minVal = getFieldMin cfg (minimum $ concat cols) field-                mkPercentColUnitText =-                    let unit = fieldUnits field minVal Absolute-                        punit = fieldUnits field 1 style -- % unit-                    in unit : replicate (length matrices - 1) punit-                mkPercentColUnitGraph = [fieldUnits field minVal Absolute]-                mkAbsoluteUnit =-                     let unit = fieldUnits field minVal style-                     in replicate (length matrices) unit-            in case (rtype, style) of-                -- In case of percentDiff in TextReport we use absolute-                -- values in the baseline column, so the unit is different.-                (_, Absolute)   -> mkAbsoluteUnit-                (_, Diff)       -> mkAbsoluteUnit-                (TextReport, _) -> mkPercentColUnitText-                (GraphicalChart, _) | length matrices == 1 ->-                    mkPercentColUnitGraph-                (GraphicalChart, _) -> mkAbsoluteUnit--        mkColValues :: [[Double]]-        mkColValues =-            let applyUnit col (RelativeUnit _ multiplier) =-                    map (/multiplier) col-            in zipWith applyUnit sortedCols mkColUnits--        mkColNames :: [String]-        mkColNames =-                let withSuffix x =-                        groupName x ++-                            if runs > 1-                            then "(" ++ show (groupIndex x) ++ ")"-                            else ""-                in map withSuffix matrices--        columns = getZipList $ ReportColumn-                    <$> ZipList mkColNames-                    <*> ZipList mkColUnits-                    <*> ZipList mkColValues--        removeBaseline xs =-            let rel = case style of-                        Absolute -> False-                        Diff -> False-                        PercentDiff -> True-                        Multiples -> True-            in if omitBaseline && rel && length matrices > 1-               then tail xs-               else xs--    in RawReport-            { reportOutputFile = outfile-            , reportIdentifier = field-            , reportRowIds     = benchmarks-            , reportColumns    = removeBaseline-                $ columnNameByUnit mkColUnits-                $ columnNameByStyle style columns-            , reportAnalyzed   = removeBaseline $-                zipWith (\x y -> map (scaleAnalyzedField x) y)-                        mkColUnits origSortedCols-            , reportEstimators = fmap removeBaseline estimators-            }--showStatusMessage :: Show a => Config -> String -> Maybe a -> IO ()-showStatusMessage cfg field outfile =-    let atitle = case mkTitle cfg of-                    Just f -> " [" ++ f field ++ "]"-                    Nothing ->-                        " [" ++ makeTitle field (diffString (presentation cfg)-                                 (diffStrategy cfg)) cfg ++ "]"-    in case outfile of-        Just path ->-            putStrLn $ "Creating chart"-                ++ atitle-                ++ " at "-                ++ show path-        Nothing -> return ()--reportComparingGroups-    :: GroupStyle-    -> FilePath-    -> Maybe FilePath-    -> ReportType-    -> Int-    -> Config-    -> (RawReport -> Config -> IO ())-    -> [GroupMatrix]-    -> String-    -> IO ()-reportComparingGroups style dir outputFile rtype runs cfg@Config{..} mkReport matrices field = do-    outfile <- case outputFile of-        Just file -> fmap Just $ prepareOutputFile dir rtype file-                                        estimator field-        Nothing -> return Nothing--    let rawReport = prepareGroupsReport cfg style outfile rtype runs field matrices-    showStatusMessage cfg field outfile-    mkReport rawReport cfg---- Prepare report for a given group, the report would consist of multiple--- field columns.-prepareFieldsReport :: Config-                 -> Maybe FilePath-                 -> GroupMatrix-                 -> RawReport-prepareFieldsReport cfg@Config{..} outfile group =-    let mkColNames :: [String]-        mkColNames = colNames $ groupMatrix group--        benchmarks = selectBenchmarksByGroup cfg group--        getBenchValues name =-              fromMaybe (error "bug") $-                lookup name (rowValues $ groupMatrix group)--        sortedCols = transpose $ map getBenchValues benchmarks-        minColValues = map (minimum . map (getAnalyzedValue estimator))-                           sortedCols--        mkColUnits :: [RelativeUnit]-        mkColUnits = map (\(x, v) -> getUnitByFieldName x (getFieldMin cfg v x))-                         (zip mkColNames minColValues)--        mkColValues :: [[Double]]-        mkColValues =-            let scaleCol (RelativeUnit _ multiplier) = map (/ multiplier)-            in  zipWith scaleCol mkColUnits-                    (map (map (getAnalyzedValue estimator)) sortedCols)--        addUnitLabel name (RelativeUnit label _) =-            if label /= []-            then name ++ inParens label-            else name-        withUnits xs = zipWith addUnitLabel xs mkColUnits--        columns = getZipList $ ReportColumn-                <$> ZipList (withUnits mkColNames)-                <*> ZipList mkColUnits-                <*> ZipList mkColValues--    in RawReport-            { reportOutputFile = outfile-            , reportIdentifier = groupName group-            , reportRowIds     = benchmarks-            , reportColumns    = columns-            , reportAnalyzed   = sortedCols-            , reportEstimators = Nothing-            }--reportPerGroup-    :: FilePath-    -> Maybe FilePath-    -> ReportType-    -> Config-    -> (RawReport -> Config -> IO ())-    -> GroupMatrix-    -> IO ()-reportPerGroup dir outputFile rtype cfg@Config{..} mkReport group = do-    outfile <- case outputFile of-        Just file -> fmap Just $ prepareOutputFile dir rtype file-                                        estimator (groupName group)-        Nothing -> return Nothing--    let rawReport = prepareFieldsReport cfg outfile group-    showStatusMessage cfg (groupName group) outfile-    mkReport rawReport cfg------------------------------------------------------------------------------------ Utility functions----------------------------------------------------------------------------------showDiffStrategy :: DiffStrategy -> String-showDiffStrategy s =-    case s of-        SingleEstimator -> ""-        MinEstimator -> "using min estimator"--diffString :: Presentation -> DiffStrategy -> Maybe String-diffString style s =-    case style of-        Groups Diff -> Just $ "Diff from Baseline " ++ showDiffStrategy s-        Groups PercentDiff -> Just $ "Diff % of Lower " ++ showDiffStrategy s-        Groups Multiples -> Just $ "Multiples of Baseline " ++ showDiffStrategy s-        Groups Absolute -> Nothing-        Solo -> Nothing-        Fields -> Nothing--inParens :: String -> String-inParens str = "(" ++ str ++ ")"--showEstimator :: Estimator -> String-showEstimator est =-    case est of-        Mean       -> "Mean"-        Median     -> "Median"-        Regression -> "Regression Coeff."--addAnnotation :: String -> Maybe String -> Config -> TitleAnnotation -> String-addAnnotation field diff Config{..} annot =-      inParens-    $ case annot of-        TitleField -> field-        TitleEstimator -> showEstimator estimator-        TitleDiff -> maybe "" inParens diff--makeTitle :: String -> Maybe String -> Config -> String-makeTitle field diff cfg@Config{..} =-       fromMaybe "" title-       ++ concatMap (addAnnotation field diff cfg) titleAnnotations

@@ -1,199 +0,0 @@--- |--- Module      : BenchShow.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.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------------------------------------------------------------------------------------ Benchmarking field specific handling------------------------------------------------------------------------------------ XXX need the ability to specify Units in the scale-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-    -- workaround for a bug that renders the plot badly when using-    -- a single cluster in the bar chart.-    then columns ++ [ReportColumn-            { colName = ""-            , colUnit = RelativeUnit "" 1-            , colValues = []-            }]-     else 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-        { colName = colName-        , colUnit = colUnit-        , colValues = map (\val ->-            case val of-                x | x >= 1 -> x - 1-                x | x < (-1) -> x + 1-                x -> error $ "BenchShow.Graph.transformFractionValue: unhandled: " ++ show x-                ) colValues-        }--transformFractionLabels :: LinearAxisParams Double-transformFractionLabels =-    ((def :: (LinearAxisParams Double)) { _la_labelf = \xs ->-        let shiftVals v = if v >= 0 then v + 1 else v - 1-            replaceMinus ('-' : ys) = "1/" ++ ys-            replaceMinus ys = ys-        in fmap replaceMinus (_la_labelf def (map shiftVals xs))-    })--genGroupGraph :: RawReport -> Config -> IO ()-genGroupGraph RawReport{..} cfg@Config{..} = do-    let outputFile  = fromMaybe undefined reportOutputFile-        fieldRange  = getFieldRange reportIdentifier cfg-        granularity = getFieldTick reportIdentifier cfg-        -- XXX assert that the unit for all columns is the same-        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 = case mkTitle of-            Just f -> f reportIdentifier-            Nothing -> 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-        -- delete the -1x to 1x band of values which are not possible in case-        -- of fraction style-        cols' <--                case presentation of-                    Groups Multiples -> do-                        layout_y_axis . laxis_generate .= autoScaledAxis-                                        transformFractionLabels-                        return $ map transformFractionValue columns-                    _ -> return columns--        layout <- get-        case _layout_legend layout of-            Nothing -> return ()-            Just style@LegendStyle{..} -> do-                let s = style { _legend_plot_size = 22-                              -- , _legend_margin = 40-                              -- This is not available in versions <= 1.8.2-                              -- , _legend_position = LegendBelow-                              , _legend_label_style = _legend_label_style-                                    { _font_size = 14 }-                              }-                put $ layout { _layout_legend = Just s }--        -- layout_y_axis . laxis_override .= axisGridAtTicks-        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 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 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 (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

@@ -0,0 +1,397 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : BenchShow.Internal.Analysis+-- Copyright   : (c) 2009-2014 Bryan O'Sullivan+--               (c) 2018 Composewell Technologies+--+-- License     : BSD-style+-- Maintainer  : harendra.kumar@gmail.com+-- Stability   : experimental+-- Portability : GHC++module BenchShow.Internal.Analysis+    ( OutlierEffect(..)+    , OutlierVariance(..)+    , countOutliers+    , Estimator(..)+    , AnalyzedField(..)+    , getAnalyzedValue+    , BenchmarkMatrix(..)+    , BenchmarkIterMatrix(..)+    , foldBenchmark+    , filterSamples+    , isMaxField+    ) where++import Control.Applicative+import Data.Char (toLower)+import Data.Data (Data, Typeable)+import Data.Int (Int64)+import Data.List (elemIndex, transpose)+import Data.Maybe (fromMaybe)+import Data.Traversable+import GHC.Generics (Generic)+import Statistics.Function (sort)+import Statistics.Quantile (weightedAvg)+import Statistics.Regression (bootstrapRegress, olsRegress)+import Statistics.Resampling (resample)+import Statistics.Resampling.Bootstrap (bootstrapBCA)+import Statistics.Sample (mean, stdDev)+import Statistics.Sample.KernelDensity (kde)+import Statistics.Types (Sample, Estimate(..), ConfInt(..), cl95, CL)+import System.Random.MWC (GenIO, createSystemRandom)+import Prelude hiding (sequence, mapM)++import qualified Statistics.Resampling as St+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U++-------------------------------------------------------------------------------+-- Outliers+-------------------------------------------------------------------------------++-- | Outliers from sample data, calculated using the boxplot+-- technique.+data Outliers = Outliers {+      samplesSeen :: !Int64+    , lowSevere   :: !Int64+    -- ^ More than 3 times the interquartile range (IQR) below the+    -- first quartile.+    , lowMild     :: !Int64+    -- ^ Between 1.5 and 3 times the IQR below the first quartile.+    , highMild    :: !Int64+    -- ^ Between 1.5 and 3 times the IQR above the third quartile.+    , highSevere  :: !Int64+    -- ^ More than 3 times the IQR above the third quartile.+    } deriving (Eq, Show, Typeable, Data, Generic)++-- | A description of the extent to which outliers in the sample data+-- affect the sample mean and standard deviation.+data OutlierEffect = Unaffected -- ^ Less than 1% effect.+                   | Slight     -- ^ Between 1% and 10%.+                   | Moderate   -- ^ Between 10% and 50%.+                   | Severe     -- ^ Above 50% (i.e. measurements+                                -- are useless).+                     deriving (Eq, Ord, Show, Typeable, Data, Generic)++outliersEmpty :: Outliers+outliersEmpty = Outliers 0 0 0 0 0++addOutliers :: Outliers -> Outliers -> Outliers+addOutliers (Outliers s a b c d) (Outliers t w x y z) =+    Outliers (s+t) (a+w) (b+x) (c+y) (d+z)+{-# INLINE addOutliers #-}++-- | Analysis of the extent to which outliers in a sample affect its+-- standard deviation (and to some extent, its mean).+data OutlierVariance = OutlierVariance {+      ovEffect   :: !OutlierEffect+    -- ^ Qualitative description of effect.+    , ovDesc     :: !String+    -- ^ Brief textual description of effect.+    , ovFraction :: !Double+    -- ^ Quantitative description of effect (a fraction between 0 and 1).+    } deriving (Eq, Show, Typeable, Data, Generic)++-- | Classify outliers in a data set, using the boxplot technique.+classifyOutliers :: Sample -> Outliers+classifyOutliers sa = U.foldl' ((. outlier) . addOutliers) outliersEmpty ssa+    where outlier e = Outliers+                { samplesSeen = 1+                , lowSevere = if e <= loS && e < hiM then 1 else 0+                , lowMild = if e > loS && e <= loM then 1 else 0+                , highMild = if e >= hiM && e < hiS then 1 else 0+                , highSevere = if e >= hiS && e > loM then 1 else 0+                }+          !loS = q1 - (iqr * 3)+          !loM = q1 - (iqr * 1.5)+          !hiM = q3 + (iqr * 1.5)+          !hiS = q3 + (iqr * 3)+          q1   = weightedAvg 1 4 ssa+          q3   = weightedAvg 3 4 ssa+          ssa  = sort sa+          iqr  = q3 - q1++-- | Compute the extent to which outliers in the sample data affect+-- the sample mean and standard deviation.+outlierVariance+  :: Double -- ^ mean+  -> Double -- ^ standard deviation.+  -> Double -- ^ Number of original iterations.+  -> OutlierVariance+outlierVariance µ σ a = OutlierVariance effect desc varOutMin+    where+    µa    = µ / a+    µgMin = µa / 2+    σg2   = σg * σg where σg = min (µgMin / 4) (σ / sqrt a)+    σ2    = σ * σ+    varOut c  = (ac / a) * (σ2 - ac * σg2) where ac = a - c+    cMax x    = fromIntegral (floor (-2 * k0 / (k1 + sqrt det)) :: Int)+        where+        ad = a * d+            where+            d = k * k+            k = µa - x+        k0    = -a * ad+        k1    = σ2 - a * σg2 + ad+        det   = k1 * k1 - 4 * σg2 * k0++    minBy f q r = min (f q) (f r)+    varOutMin = if σ2 == 0+                then 0+                else (minBy varOut 1 (minBy cMax 0 µgMin)) / σ2++    (effect, desc) | varOutMin < 0.01 = (Unaffected, "no")+                   | varOutMin < 0.1  = (Slight,     "slight")+                   | varOutMin < 0.5  = (Moderate,   "moderate")+                   | otherwise        = (Severe,     "severe")++-- | Count the total number of outliers in a sample.+countOutliers :: Outliers -> Int64+countOutliers (Outliers _ a b c d) = a + b + c + d+{-# INLINE countOutliers #-}++-------------------------------------------------------------------------------+-- Linear regression+-------------------------------------------------------------------------------++useRegression :: Bool+useRegression = True++useBootstrap :: Bool+useBootstrap = True++resampleCount :: Int+resampleCount = 1000++confidence :: CL Double+confidence = cl95++regress+    :: GenIO+    -> Int  -- index of the iters field, we return the coefficient of only the+            -- iters field+    -> [String] -- responder column names+    -> [([Double], [Double])]+    -> IO [Maybe (Estimate ConfInt Double, Estimate ConfInt Double)]+regress randGen i rcols samples = do+    -- perform ordinary least squares regression for each field+    -- the main predictor is the number of iterations+    let predVectors = map U.fromList $ transpose $ map fst samples+        regressWithIters = mapM (bootstrapRegress randGen resampleCount+                                confidence olsRegress predVectors)++    let avoidMaxFields name vec =+            if isMaxField name+            then Nothing+            else Just vec+    let respVectors = map U.fromList $ transpose $ map snd samples+    res <- mapM regressWithIters (zipWith avoidMaxFields rcols respVectors)+    return $ map (fmap (\(v,r2) -> ((G.toList v) !! i, r2))) res++-------------------------------------------------------------------------------+-- Mean and std deviation by boostrap resampling+-------------------------------------------------------------------------------++estimateMeanAndStdDev+    :: GenIO+    -> [U.Vector Double]+    -> IO [(Estimate ConfInt Double, Estimate ConfInt Double)]+estimateMeanAndStdDev randGen vectors = do+    let resamp = resample randGen [St.Mean, St.StdDev] resampleCount+    res <- mapM resamp vectors+    return $ fmap (\[mn,dev] -> (mn, dev))+        $ getZipList+        $ bootstrapBCA confidence+            <$> ZipList vectors+            <*> ZipList res++-------------------------------------------------------------------------------+-- Statistical analysis of benchmark iterations+-------------------------------------------------------------------------------++-- By default the fields are considered "scaled" fields that is+-- they scale by iterations. However in case of maxrss field it is+-- a max value across the experiment and does not scale by+-- iterations, in this case we just need to take a mean or max+-- without scaling.+isMaxField :: String -> Bool+isMaxField fieldName = map toLower fieldName == "maxrss"++rescaleIteration :: Int -> [String] -> ([Double], [Double]) -> [Double]+rescaleIteration idx rcols (pvals, vals) =+    let iter = pvals !! idx+    in zipWith ($) (map ($ iter) foldFields) vals++    where++    getMeanOrMax fname i val =+        if isMaxField fname+        then val+        else val / i++    foldFields = map getMeanOrMax rcols++data AnalyzedField = AnalyzedField+    { analyzedMean       :: !Double+    , analyzedStdDev     :: !Double++    , analyzedMedian     :: !Double+    , analyzedOutliers   :: !Outliers+    , analyzedOutlierVar :: !OutlierVariance+    , analyzedKDE        :: !(U.Vector Double, U.Vector Double)++    , analyzedRegCoeff   :: Maybe (Estimate ConfInt Double)+    , analyzedRegRSq     :: Maybe (Estimate ConfInt Double)+    } deriving Show++-- | The statistical estimator used to arrive at a single value for a+-- benchmark when samples from multiple experiments are available.+--+-- @since 0.2.0+data Estimator =+      Median        -- ^ Report the median, outliers and outlier variance using+                    -- box-plot method. This is the most robust indicator+                    -- with respect to outliers when successive runs of+                    -- benchmarks are compared.+    | Mean          -- ^ Report the mean and the standard deviation from the+                    -- mean. This is less robust than median but more precise.+    | Regression    -- ^ Report the coefficient of regression, discarding the+                    -- constant factor, arrived at by linear regression using+                    -- ordinary least square method.  The R-square+                    -- goodness-of-fit estimate is also reported.  It works+                    -- better when larger number of samples are taken.  This+                    -- cannot be used when the number of samples is less than+                    -- 2, in that case a mean value is reported instead.+    deriving (Eq, Show, Read)++getAnalyzedValue :: Estimator -> AnalyzedField -> Double+getAnalyzedValue estimator AnalyzedField{..} =+    case estimator of+        Median -> analyzedMedian+        Mean -> analyzedMean+        Regression ->+            case analyzedRegCoeff of+                Nothing -> analyzedMean+                Just x -> estPoint x++-- | Perform an analysis of a measurement.+analyzeBenchmark :: GenIO+                 -> [String]+                 -> [String]+                 -> [([Double], [Double])]+                 -> IO [AnalyzedField]+analyzeBenchmark randGen pcols rcols samples = do+    let sampleCnt = length samples+        i = fromMaybe (error "bug") $ elemIndex "iters" pcols+        vectors = map U.fromList+            $ transpose+            $ map (rescaleIteration i rcols) samples++    (coeffs, r2s) <-+        -- olsRegress fails if there are fewer samples than predictors+        if useRegression && length samples >= (length pcols + 1)+        then do+            let f (Just (x, y)) = (Just x, Just y)+                f Nothing = (Nothing, Nothing)+            fmap (unzip . map f) $ regress randGen i rcols samples+        else do+            let n = length rcols+            return (replicate n Nothing, replicate n Nothing)++    (means, devs) <-+        if useBootstrap && length samples >= 3+        then do+            (ms, ds) <- fmap unzip $ estimateMeanAndStdDev randGen vectors+            return (map estPoint ms, map estPoint ds)+        else do+            -- Even for max fields (e.g. maxrss) we take the mean+            let ms = map mean vectors+                ds = map stdDev vectors+            return (ms, ds)++    let len = U.length $ head vectors+        median v = (sort v) U.! (len `div` 2)+        medians = map median vectors+        outliers = getZipList $ classifyOutliers <$> ZipList vectors+        outlierVars = getZipList+                $ outlierVariance+                    <$> ZipList means+                    <*> ZipList devs+                    <*> pure (fromIntegral sampleCnt)+        kdes = map (kde 128) vectors++    return $ getZipList $ AnalyzedField+        <$> ZipList means+        <*> ZipList devs++        <*> ZipList medians+        <*> ZipList outliers+        <*> ZipList outlierVars+        <*> ZipList kdes++        <*> ZipList coeffs+        <*> ZipList r2s++-- predictor matrix+data BenchmarkIterMatrix = BenchmarkIterMatrix+    { iterPredColNames  :: ![String]  -- predictor column names+    , iterRespColNames  :: ![String]  -- responder column names+    -- (Benchmark, [(predictor columns, responder columns)])+    , iterRowValues :: ![(String, [([Double], [Double])])]+    } deriving Show++-- Stored in row major order+data BenchmarkMatrix = BenchmarkMatrix+    { colNames  :: ![String]+    , rowValues :: ![(String, [AnalyzedField])] -- (Benchmark, columns)+    } deriving Show++foldBenchmark :: BenchmarkIterMatrix -> IO BenchmarkMatrix+foldBenchmark BenchmarkIterMatrix{..} = do+    randGen <- createSystemRandom+    rows <- mapM (foldIters randGen) iterRowValues+    return $ BenchmarkMatrix+        { colNames = iterRespColNames+        , rowValues = rows+        }++    where++    foldIters randGen (name, vals) = do+            vals' <- analyzeBenchmark randGen iterPredColNames+                                      iterRespColNames vals+            return (name, vals')++-- take top samples+-- XXX take equivalent iterations across multiple groups+filterSamples :: BenchmarkIterMatrix -> BenchmarkIterMatrix+filterSamples matrix =+    matrix+        {-+        {+          iterRowValues = map filterIters iterRowValues+        }++    where++    iterIndex = fromMaybe undefined+        $ elemIndex "iters" (map (map toLower) iterPredColNames)+    nivcswIndex = fromMaybe undefined+        $ elemIndex "nivcsw" (map (map toLower) iterPredColNames)+    filterIters (name, vals) =+        let vals'' = take 50 $ reverse $ sortBy (comparing ((!! iterIndex) .  fst)) vals+        let vals' = filter (\(x,_) -> x !! nivcswIndex < 10) vals+            vals'' =+                if null vals'+                then trace "null after filter" vals+                else vals'+        in (name, vals'')+        -}

@@ -0,0 +1,1370 @@+-- |+-- Module      : BenchShow.Internal.Common+-- 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.Common+    ( Presentation(..)+    , GroupStyle(..)+    , FieldTick (..)+    , SortColumn (..)+    , RelativeUnit (..)+    , Estimator (..)+    , DiffStrategy (..)+    , TitleAnnotation (..)+    , Config(..)+    , defaultConfig++    , getFieldRange+    , getFieldTick++    , GroupMatrix(..)+    , prepareGroupMatrices++    , ReportColumn(..)+    , RawReport(..)+    , ReportType(..)+    , diffString+    , makeTitle+    , prepareToReport+    , reportComparingGroups+    , reportPerGroup+    ) where++import Control.Applicative (ZipList(..))+import Control.Arrow (second)+import Control.Exception (assert)+import Control.Monad (when, unless)+import Data.Char (toLower)+import Data.Foldable (foldl')+import Data.Function ((&), on)+import Data.List+       (transpose, groupBy, (\\), find, sortBy, elemIndex, intersect,+        intersectBy)+import Data.List.Split (linesBy)+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Ord (comparing)+import Debug.Trace (trace)+import Statistics.Types (Estimate(..), ConfInt(..))+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import Text.CSV (CSV, parseCSVFromFile)+import Text.Read (readMaybe)++import BenchShow.Internal.Analysis++-------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------++filterSanity :: (Eq a, Show a) => String -> [a] -> [a] -> IO ()+filterSanity label old new = do+    let added = new \\ old++    when (null new) $ error $+        label ++ " must select at least one item from the list: "+        ++ show old++    unless (null added) $ error $+        label +++        " must not add any new items to the original list. The \+        \following items were added: " ++ show added+        ++ "\nOriginal groups: " ++ show old+        ++ "\nNew groups: " ++ show new++-------------------------------------------------------------------------------++data ReportType = TextReport | GraphicalChart++-- | How to show the results for multiple benchmark groups presented in columns+-- or bar chart clusters. In relative comparisons, the first group is+-- considered as the baseline and the subsequent groups are compared against+-- the baseline.+--+-- /Definition changed in 0.3.0/+-- @since 0.2.0+data GroupStyle =+      Absolute    -- ^ Show absolute values of the field for all groups+    | Diff        -- ^ Show baseline group as absolute values and values for+                  -- the subsequent groups as difference from the baseline+    | PercentDiff -- ^ If the value of the group being compared is higher than+                  -- the baseline then display the difference as percentage of+                  -- baseline otherwise display the difference as a percentage+                  -- of the group being compared.+    | Multiples   -- ^ If the value of the group being compared is higher than+                  -- the baseline then display @+(value / baseline value)@+                  -- otherwise display @-(baseline value / value)@. This+                  -- provides a normalized comparison independent of the+                  -- absolute value of a benchmark. Note that 'Multiples' can+                  -- be directly computed using 'PercentDiff' and vice-versa.+    deriving (Eq, Show, Read)++-- | How to present the reports or graphs. Each report presents a number of+-- benchmarks as rows, it may have, (1) a single column presenting the values+-- for a single field, (2) multiple columns presenting values for different+-- fields, or (3) multiple columns presenting values of the same field for+-- different groups.+--+-- @since 0.2.0+data Presentation =+      Solo              -- ^ Reports are generated for each group and for+                        -- each field selected by the configuration. Each+                        -- report presents benchmarks in a single group with a+                        -- single column presenting a single field.  If there+                        -- are @m@ fields and @n@ groups selected by the+                        -- configuration then a total of @m x n@ reports are+                        -- generated.  Output files are named using+                        -- @-estimator-groupname-fieldname@ as suffix.+    | Groups GroupStyle -- ^ One report is generated for each field selected by+                        -- the configuration. Each report presents a field+                        -- with all the groups selected by the configuration as+                        -- columns or clusters. Output files are named using+                        -- @-estimator-fieldname@ as suffix.+    | Fields            -- ^ One report is generated for each group selected by+                        -- the configuration. Each report presents a group+                        -- with all the fields selected by the configuration as+                        -- columns or clusters. Output files are named using+                        -- @-estimator-groupname@ as suffix.+    deriving (Eq, Show, Read)++-- | FieldTick is used only in visual charts to generate the major ticks on+-- the y-axis. You can specify either the size of a tick ('TickSize') or the+-- total number of ticks ('TickCount').+--+-- @since 0.2.0+data FieldTick =+      TickSize Int  -- ^ Size of a tick, the unit is microseconds for time+                     -- fields, and bytes for space fields.+    | TickCount Int -- ^ Total number of ticks in the range spread.++-- | When sorting and filtering the benchmarks using 'selectBenchmarks' we can+-- choose a column as a sort criterion.  'selectBenchmarks' is provided with+-- the data for the corresponding column which can be used for sorting the+-- benchmarks. The column could be a group or a field depending on the+-- 'Presentation'.+--+-- @since 0.2.0+data SortColumn =+      ColumnIndex Int -- ^ Specify the index of the sort column. Index 0+        -- corresponds to the first @value@ column. In a textual report, the+        -- very first column consists of benchmark names, therefore index 0+        -- addresses the second column of the report.+    | ColumnName (Either String (String, Int)) -- ^ Specify the column using+        -- the name of the group or the field it represents, and the @runId@.+        -- When just the name is enough to uniquely identify the sort column+        -- the 'Left' constructor can be used, otherwise the 'Right'+        -- constructor is used which can use the @runId@ to disambiguate.  In a+        -- 'Fields' presentation, just the field name is enough.  In a 'Groups'+        -- presentation, when there is a single benchmark run in the input+        -- file, just the group name is enough to identify the group, the+        -- @runId@ defaults to 0.  However, when there are multiple runs, a+        -- group needs to specify a @runId@ as well.++-- | Strategy to compute the difference between two groups of benchmarks being+-- compared.+--+-- @since 0.2.0+data DiffStrategy =+      SingleEstimator -- ^ Use a single estimator to compute the difference+                      -- between the baseline and the candidate. The estimator+                      -- that is provided in the 'Config' is used.+    | MinEstimator    -- ^ Use 'Mean', 'Median' and 'Regression' estimators for+                      -- both baseline and candidate, and report the estimator+                      -- that shows the minimum difference. This is more robust+                      -- against random variations.+    {-+    | WorstBest+    | BestBest+    -}+    deriving (Show, Read)++-- | Additional annotations that can be optionally added to the title of the+-- report or graph.+--+-- @since 0.2.2+{-# DEPRECATED TitleAnnotation "Please use mkTitle to make a custom title" #-}+data TitleAnnotation = TitleField | TitleEstimator | TitleDiff+    deriving (Eq, Show, Read)++-- | Configuration governing generation of chart. See 'defaultConfig' for the+-- default values of these fields.+--+-- @since 0.2.0+data Config = Config+    {+    -- | Provide more details in the report, especially the standard deviation,+    -- outlier variance, R-square estimate and an annotation to indicate the+    -- actual method used when using 'MinEstimator' are reported.+      verbose :: Bool++    -- | The directory where the output graph or report file should be placed.+    , outputDir   :: Maybe FilePath++    -- | Function to make a title for the report. The argument to the function+    -- is the benchmark field name for which the report is being made.+    , mkTitle  :: Maybe (String -> String)++    -- | /DEPRECATED: Please use 'mkTitle' instead./+    --+    -- Report title, more information like the plotted field name or+    -- the presentation style may be added to it.+    , title  :: Maybe String++    -- | /DEPRECATED: Please use 'mkTitle' instead./+    --+    -- Additional annotations to be added to the title+    , titleAnnotations :: [TitleAnnotation]++    -- | How to determine the layout of the report or the chart.+    , presentation :: Presentation++    -- | The estimator used for the report.+    , estimator    :: Estimator++    -- | The minimum percentage difference between two runs of a benchmark+    -- beyond which the benchmark is flagged to have regressed or improved.+    , threshold :: Word++    -- | Strategy to compare two runs or groups of benchmarks.+    , diffStrategy  :: DiffStrategy++    -- | Omit the baseline group in normalized relative comparisons i.e.+    -- when the 'GroupStyle' is 'PercentDiff' or 'Multiples'.+    , omitBaseline :: Bool++    ---------------------------------------------------------------------------+    -- Fields (Columns)+    ---------------------------------------------------------------------------++    -- | Filter and reorder the benchmarking fields. It is invoked with a list+    -- of all available benchmarking fields. Only those fields present in the+    -- output of this function are plotted and in that order.+    , selectFields :: [String] -> [String]++    -- | The values in the tuple are @(fieldName, RangeMin, RangeMax)@.+    -- Specify the min and max range of benchmarking fields. If the field+    -- value is outside the range it is clipped to the range limit.+    -- For time fields, the range values are in microseconds, and for space+    -- fields they are in bytes. The minimum of the range is used to determine+    -- the unit for the field.+    , fieldRanges :: [(String, Double, Double)]++    -- | The values in the tuple are @(fieldName, tick)@.  Specify the+    -- tick size of the fields to be used for the graphical reports.+    , fieldTicks :: [(String, FieldTick)]++    ---------------------------------------------------------------------------+    -- Groups (Row Grouping)+    ---------------------------------------------------------------------------++    -- | Filter, group and translate benchmark names. This function is invoked+    -- once for all benchmark names found in the results. It produces a tuple+    -- @(groupname, benchname)@, where @groupname@ is the name of the group the+    -- benchmark should be placed in, and @benchname@ is the translated+    -- benchmark name to be used in the report.  If it returns 'Nothing' for a+    -- benchmark, that benchmark is omitted from the results.+    , classifyBenchmark :: String -> Maybe (String, String)++    -- | Filter and reorder the benchmark group names. A benchmark group may be+    -- assigned using 'classifyBenchmark'; when not assigned, all benchmarks+    -- are placed in the @default@ group. The input to this function is a list+    -- of tuples with benchmark group names and the @runId@s.  The output+    -- produced by this function is a filtered and reordered subset of the+    -- input.  Only those benchmark groups present in the output are rendered+    -- and are presented in that order.+    , selectGroups :: [(String, Int)] -> [(String, Int)]++    ---------------------------------------------------------------------------+    -- Benchmarks (Rows)+    ---------------------------------------------------------------------------++    -- | Filter and reorder benchmarks. 'selectBenchmarks' takes a function+    -- argument, the function is invoked with a sorting column name or index+    -- and a 'GroupStyle'. The output of the function is either a 'Right' value+    -- consisting of tuples of the benchmark names and values corresponding to+    -- the given column and style or a 'Left' value indicating an error.+    -- 'selectBenchmarks' can inspect these benchmarks and their values to+    -- produce a filtered and sorted list of benchmark names that are to be+    -- rendered.+    --+    -- The style argument is ignored when the report presentation is not+    -- 'Groups'. When style is 'Nothing', the presentation setting specified in+    -- the configuration is used.+    --+    -- /Signature changed in 0.3.0/+    , selectBenchmarks+        :: (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])+        -> [String]+    }++-- IMPORTANT: If you change the defaults, please change the defaults in the CLI+-- help as well.+--+-- | Default configuration. Use this as the base configuration and modify the+-- required fields. The defaults are:+--+-- @+--  verbose           = False+--  mkTitle           = Nothing+--  titleAnnotations  = [TitleField]+--  outputDir         = Nothing+--  presentation      = Groups Absolute+--  estimator         = Median+--  threshold         = 3+--  diffStrategy      = SingleEstimator+--  omitBaseline      = False+--  selectFields      = filter (flip elem ["time", "mean", "maxrss"] . map toLower)+--  fieldRanges       = []+--  fieldTicks        = []+--  classifyBenchmark = Just . ("default",)+--  selectGroups      = id+--  selectBenchmarks  = \f -> either error (map fst) $ f (ColumnIndex 0) Nothing+-- @+--+-- @since 0.2.0+defaultConfig :: Config+defaultConfig = Config+    { verbose           = False+    , mkTitle           = Nothing+    , title             = Nothing+    , titleAnnotations  = [TitleField]+    , outputDir         = Nothing+    , presentation      = Groups Absolute+    , estimator         = Median+    , threshold         = 3+    , diffStrategy      = SingleEstimator+    , omitBaseline      = False+    , selectFields      = filter (flip elem ["time", "mean", "maxrss"] . map toLower)+    , fieldRanges       = []+    , fieldTicks        = []+    , classifyBenchmark = Just . ("default",)+    , selectGroups      = id+    , selectBenchmarks  = \f -> either error (map fst) $ f (ColumnIndex 0) Nothing+    }++-------------------------------------------------------------------------------+-- Benchmarking field types+-------------------------------------------------------------------------------++timeFields :: [String]+timeFields = map (map toLower)+    [ "time"+    , "mean"+    , "cpuTime"+    , "utime"+    , "stime"+    , "mutatorWallSeconds"+    , "mutatorCpuSeconds"+    , "gcWallSeconds"+    , "gcCpuSeconds"+    ]++isTimeField :: String -> Bool+isTimeField fieldName = map toLower fieldName `elem` timeFields++allocFields :: [String]+allocFields = map (map toLower) ["allocated", "bytesCopied", "maxrss"]++isAllocationField :: String -> Bool+isAllocationField fieldName = map toLower fieldName `elem` allocFields++predictorFields :: [String]+predictorFields = map (map toLower)+    [ "iters"+    -- , "minflt"+    -- , "majflt"+    -- , "nvcsw"+    -- , "nivcsw"+    ]++isPredictorField :: String -> Bool+isPredictorField fieldName = map toLower fieldName `elem` predictorFields++-------------------------------------------------------------------------------+-- Units+-------------------------------------------------------------------------------++-- | Describe a relative unit i.e. a unit in terms of another unit. A relative+-- unit has a label and a ratio which when multiplied with the unit gives us+-- the other unit. For example, if the known time unit is seconds, we can+-- describe a millisecond as @Unit "ms" (1/1000)@.+data RelativeUnit = RelativeUnit String Double deriving Show++getTimeUnit :: Double -> RelativeUnit+getTimeUnit k+    | k < 0      = getTimeUnit (-k)+    | k >= 1     = RelativeUnit "s" 1+    | k >= 1e-3  = RelativeUnit "ms" 1e-3+    | k >= 1e-6  = RelativeUnit "μs" 1e-6+    | otherwise  = RelativeUnit "ns" 1e-9++getSpaceUnit :: Double -> RelativeUnit+getSpaceUnit k+    | k < 0             = getSpaceUnit (-k)+    | k >= 2^(30 ::Int) = RelativeUnit "GiB" (2^(30 :: Int))+    | k >= 2^(20 ::Int) = RelativeUnit "MiB" (2^(20 :: Int))+    | k >= 2^(10 ::Int) = RelativeUnit "KiB" (2^(10 :: Int))+    | otherwise         = RelativeUnit "Bytes" 1++getUnitByFieldName :: String -> Double -> RelativeUnit+getUnitByFieldName fieldName fieldMin =+    case isTimeField fieldName of+        True -> getTimeUnit fieldMin+        False -> case isAllocationField fieldName of+            True -> getSpaceUnit fieldMin+            False -> RelativeUnit "" 1++-- returns (multiplier, units)+fieldUnits :: String -> Double -> GroupStyle -> RelativeUnit+fieldUnits fieldName fieldMin style =+    case style of+        Multiples   -> RelativeUnit "x" 1+        PercentDiff -> RelativeUnit "%" 1+        _ -> getUnitByFieldName fieldName fieldMin++-------------------------------------------------------------------------------+-- Comparison+-------------------------------------------------------------------------------++absoluteDiff :: Num a => a -> a -> a+absoluteDiff v1 v2 = v2 - v1++percentDiff :: (Fractional a, Num a, Ord a) => a -> a -> a+percentDiff v1 v2 = ((v2 - v1) * 100) / min v1 v2++-- We map a fraction x between 0 and 1 to a negative 1/x for plotting on an+-- equal and opposite scale.+fraction :: (Fractional a, Num a, Ord a, Show a) => a -> a -> a+fraction v1 v2 =+    let val = v2 / v1+    in case val of+            x | x <= 0 -> error $ "BenchShow.Internal.Common.fraction: negative: " ++ show x+            x | x < 1 -> negate (1 / x)+            x | x >= 1 -> x+            x -> error $ "BenchShow.Internal.Common.fraction: unhandled: " ++ show x++cmpTransformColumns :: ReportType+                    -> GroupStyle+                    -> Estimator+                    -> DiffStrategy+                    -- XXX we do not really need the benchmark name here+                    -> [[(String, AnalyzedField)]]+                    -> (Maybe [[Estimator]], [[(String, Double)]])+cmpTransformColumns rtype style estimator diffStrategy cols =+    let cmpWith diff =+            let firstCol = head columns+                colTransform col =+                    let mkDiff (n1, v1) (n2,v2) =+                            verify (n1 == n2) (n2, diff v1 v2)+                    in zipWith mkDiff firstCol col+            in map colTransform (tail columns)++        cmpMinWith diff =+            let firstCol = head cols+                colTransform col = zipWith (mkMinDiff diff) firstCol col+            in map colTransform (tail cols)++        diffWith f =+                case diffStrategy of+                    MinEstimator ->+                        let (ests, vals) = unzip $ map unzip (cmpMinWith f)+                        in ( Just $ map (const estimator) (head cols) : ests+                           , head columns : vals+                           )+                    SingleEstimator ->+                        (Nothing, head columns : cmpWith f)++        relativeDiffWith baseVal f =+            -- In a comparative graphical chart we cannot show the absolute+            -- values in the baseline column as the units won't match for+            -- the baseline and the diff clusters.+            let baseCol =+                    case rtype of+                        TextReport -> head columns+                        GraphicalChart | length columns == 1 ->+                            head columns+                        GraphicalChart ->+                            map (\(n,_) -> (n,baseVal)) (head columns)+            in case diffStrategy of+                MinEstimator ->+                    let (ests, vals) = unzip $ map unzip (cmpMinWith f)+                    in ( Just $ map (const estimator) (head cols) : ests+                       , baseCol : vals+                       )+                SingleEstimator ->+                   (Nothing, baseCol : cmpWith f)+    in case style of+            Absolute    -> diffWith (\_ x -> x)+            Diff        -> diffWith absoluteDiff+            PercentDiff -> relativeDiffWith 100 percentDiff+            Multiples   -> relativeDiffWith 1 fraction+    where+        verify a b = if a then b else error "bug: benchmark names mismatch"+        transformVals = map (map (second (getAnalyzedValue estimator)))+        columns = transformVals cols++        -- Find which estimator gives us the minimum diff+        mkMinDiff diff (n1, v1) (n2,v2) = verify (n1 == n2) $+            let meanDiff = diff (getAnalyzedValue Mean v1)+                                (getAnalyzedValue Mean v2)+                medDiff = diff (getAnalyzedValue Median v1)+                               (getAnalyzedValue Median v2)+                regDiff = diff (getAnalyzedValue Regression v1)+                               (getAnalyzedValue Regression v2)+            in if abs medDiff <= abs meanDiff+               then if abs medDiff <= abs regDiff+                    then (Median, (n2, medDiff))+                    else (Regression, (n2, regDiff))+                else if abs meanDiff <= abs regDiff+                     then (Mean, (n2, meanDiff))+                     else (Regression, (n2, regDiff))++columnNameByStyle :: GroupStyle -> [ReportColumn] -> [ReportColumn]+columnNameByStyle _ [] = []+columnNameByStyle style columns@(h:t) =+    let withDiff name = colSuffix baseName h : map (colSuffix name) t+    in case style of+            Diff        | length columns > 1 -> withDiff diffName+            Multiples   | length columns > 1 -> withDiff fracName+            PercentDiff | length columns > 1 -> withDiff diffName+            _ -> columns++    where+    colSuffix xl col = col { colName = xl (colName col) }+    baseName        = id -- (++ "(base)")+    diffName        = (++ " - " ++ colName h) -- "(-base)")+    fracName        = (++ "/" ++ colName h) -- "/base")++columnNameByUnit :: [RelativeUnit] -> [ReportColumn] -> [ReportColumn]+columnNameByUnit units columns =+    let applyUnit col (RelativeUnit label _) =+            col { colName = colName col ++ inParens label }+    in zipWith applyUnit columns units++-- Represents the data for a single benchmark run+data GroupMatrix = GroupMatrix+    { groupIndex :: Int+    , groupName   :: String+    , groupBenches :: [(String, String)] -- (newname, origname)+    , groupMatrix :: BenchmarkMatrix+    } deriving Show++-- Each run may be split into multiple groups of benchmarks.  Benchmarks can be+-- renamed by the classifier. Sanity checks:+-- Two original benchmarks cannot map to the same target benchmark+--+-- When using a comparative style report, after filtering and sorting:+-- Same original benchmark cannot belong to multiple groups+-- All groups must have exactly the same benchmark names+splitGroup :: (String -> Maybe (String, String))+           -> (Int, BenchmarkMatrix)+           -> [GroupMatrix]+splitGroup classify (serial, matrix@BenchmarkMatrix{..}) =+    let classified = mapMaybe (\x -> fmap (,x) $ classify x) (map fst rowValues)+    in if null classified+       then error "No benchmarks were selected by \"classifyBenchmark\""+       else+          sortBy (comparing (fst . fst)) classified+        & groupBy ((==) `on` (fst . fst))+        & map (foldr foldGroup ("",[]))+        & map sanityCheckGroup+        & map (\(name, benches) ->+            GroupMatrix+            { groupIndex  = serial+            , groupName    = name+            , groupBenches = benches+            , groupMatrix  = matrix+            })++    where++    foldGroup ((grp, bench), srcBench) (_, tuples) =+        (grp, (bench, srcBench) : tuples)++    sanityCheckGroup orig@(grp, tuples) =+        let duplicated =+                  sortBy (comparing fst) tuples+                & groupBy ((==) `on` fst)+                & filter ((>1) . length)+        in if not $ null duplicated+           then+            let msg = unlines (map show duplicated)+            in error $ "Two benchmarks must not map to the same target \+               \benchmark. Please check your 'classifyBenchmark' operation. \+               \In group " ++ show grp ++ ", the following target benchmarks \+               \are mapped to more than one source benchmarks:\n" ++ msg+            else orig++-------------------------------------------------------------------------------+-- sort the benchmark groups+-------------------------------------------------------------------------------++findGroup :: [GroupMatrix] -> (String, Int) -> Maybe GroupMatrix+findGroup matrices (name, i) =+    find (\x -> groupName x == name && groupIndex x == i) matrices++sortGroups :: Config -> [GroupMatrix] -> IO [GroupMatrix]+sortGroups Config{..} matrices = do+    let origGroups = map (\x -> (groupName x, groupIndex x)) matrices+        newGroups = selectGroups origGroups++    filterSanity "selectGroups" origGroups newGroups+    return $ mapMaybe (findGroup matrices) newGroups++-------------------------------------------------------------------------------+-- sort the benchmarks+-------------------------------------------------------------------------------++extractColumn :: String -> GroupMatrix -> [(String, AnalyzedField)]+extractColumn field GroupMatrix{..} =+    let idx = elemIndex field (colNames groupMatrix)+        vals = case idx of+            Just i -> map (!! i) (map snd (rowValues groupMatrix))+            Nothing -> error $ "Field [" ++ field+                ++ "] does not exist in group ["+                ++ groupName ++ "] and run id [" ++ show groupIndex ++ "]"+    in zip (map fst groupBenches) vals++extractColumnValue :: String -> GroupMatrix -> Estimator -> [(String, Double)]+extractColumnValue field matrix estimator =+    map (second (getAnalyzedValue estimator)) $ extractColumn field matrix++benchmarkCompareSanity :: [String] -> GroupMatrix -> [String]+benchmarkCompareSanity benchmarks GroupMatrix{..} = do+    let benches = map fst groupBenches+    let absent = benchmarks \\ benches+    let msg =+            "selectBenchmarks: Group [" ++ groupName ++ "] run id ["+            ++ show groupIndex+            ++ "] does not contain the following selected benchmarks; \+            \ignoring them: " ++ show absent+            ++ "\nAvailable benchmarks in this group are: "+            ++ show benches++    if (null absent)+    then benchmarks+    else trace msg (benchmarks \\ absent)++selectBenchmarksByField :: Config+                        -> [GroupMatrix]+                        -> [[(String, Double)]]+                        -> (GroupStyle -> [[(String, Double)]])+                        -> [String]+selectBenchmarksByField Config{..} matrices columns colsByStyle =+    let bmnames = selectBenchmarks extractGroup+     in foldl benchmarkCompareSanity bmnames matrices++    where++    grpNames =+        let getName x = (groupName x, groupIndex x)+        in map getName matrices++    -- columns are benchmark groups in this case+    extractGroup colSelector style =+            let cols = case style of+                    Nothing -> columns+                    Just s -> colsByStyle s+            in case colSelector of+                ColumnName (Left name) ->+                    let len = length cols+                    in if len <= 1+                       then extractGroup (ColumnName (Right (name, 0))) style+                       else Left $ "selectBenchmarks: there are " ++ show len+                            ++ " runs in the input data, please specify the run \+                            \index [0-" ++ show (len - 1)+                            ++ "] along with the group name."+                ColumnName (Right (name, runId)) ->+                    extractColumnByGroupName name runId style+                ColumnIndex n -> extractColumnByGroupIndex n cols++    -- The benchmark field is constant.  Extract all benchmark values for the+    -- given field and for the given group.+    findColumnIndex mxs (name, runId) =+        let foldFunc res@(idx, found) grp =+                case found of+                    False ->+                        if groupName grp == name && groupIndex grp == runId+                        then (idx, True)+                        else (idx + 1, found)+                    True -> res+        in foldl foldFunc (0, False) mxs++    extractColumnByGroupName name runId style =+            case findColumnIndex matrices (name, runId) of+                (_, False) -> Left $ "Benchmark group name [" ++ name+                            ++ "] and index [" ++ show runId+                            ++ "] not found. Available groups are: "+                            ++ show grpNames+                (i, True) -> extractGroup (ColumnIndex i) style++    extractColumnByGroupIndex idx cols =+        let len = length cols+        in if idx >= len+           then Left $ "Column index must be in the range [0-"+                ++ show (len - 1) ++ "]"+           else Right $ cols !! idx++selectBenchmarksByGroup :: Config -> GroupMatrix -> [String]+selectBenchmarksByGroup Config{..} grp@GroupMatrix{..} =+    -- XXX this is common to ByField and ByGroup+    let bmnames = selectBenchmarks extractField+     in bmnames++    where++    -- columns are benchmark fields in this case+    extractField (ColumnName (Left name)) _ = extractColumnByFieldName name+    extractField (ColumnName (Right (name, _))) _ =+        -- XXX runId does not make sense for fields+        extractColumnByFieldName name+    extractField (ColumnIndex n) _ = extractColumnByFieldIndex n++    -- The benchmark field is constant.  Extract all benchmark values for the+    -- given field and for the given group.+    extractColumnByFieldName name =+        let fields = colNames groupMatrix+        in case elem name fields of+            False -> Left $ "Benchmark field name [" ++ name+                        ++ "] not found in group ["+                        ++ groupName ++ "]. Available fields are: "+                        ++ show fields+            True -> Right $ extractColumnValue name grp estimator++    extractColumnByFieldIndex idx =+        let fields = colNames groupMatrix+            len = length fields+        in if idx >= len+           then Left $ "Column index must be in the range [0-"+                ++ show (len - 1) ++ "]"+           else Right $ extractColumnValue (fields !! idx) grp estimator++type NumberedLines = [(Int, [String])]++sanityCheckCSV :: CSV -> NumberedLines+sanityCheckCSV csvlines | null csvlines = error $ "The input file is empty"+sanityCheckCSV csvlines =+    let headRow = head csvlines+        rowLen = length headRow+    in  if not $ "name" `elem` map (map toLower) headRow+        then error "No 'Name' column found in the CSV header line"+        else+          -- Add line numbers for error reporting+          zip [1..] csvlines+          -- cleanup blank rows+        & filter (\(_,xs) -> xs /= [""])++          -- make sure all lines are of the same size, So that we can transpose+          -- back and forth without losing information.+        & map (\x@(i,xs) ->+               if length xs == rowLen+               then x+               else error $ "Line number " ++ show i+                        ++ " in the input file is not of the same length as\+                            \ the header line"+              )++-- An iteration field indicates that consecutive rows with the same benchmark+-- name have results from different iterations of the same benchmark and the+-- measurement fields have to be scaled per iteration based on the number of+-- iterations in the iteration count field.+--+-- Make sure that "iters" and "name" are the first and second columns+ensureIterField :: ([String], [NumberedLines])  -> ([String], [NumberedLines])+ensureIterField (header, groups) =+    ( "iters" : "name" : filter isNotNameIter header+    , map reorderNameIter groups+    )++    where++    isNotNameIter x =+           map toLower x /= "name"+        && map toLower x /= "iters"++    notNameIters [] = True+    notNameIters (x:_) = isNotNameIter x++    nameNotFound = error "Name field is required in the csv file"++    reorderNameIter csvlines =+          unzip csvlines+        & second (header :)+        & second transpose+        & second reorder+        & second transpose+        & uncurry zip++        where++        reorder xs =+            let findField x = find (\(y:_) -> map toLower y == x)+                iterCol = replicate (length (head xs) - 1) "1"+            in   fromMaybe iterCol (fmap tail $ findField "iters" xs)+               : fromMaybe nameNotFound (fmap tail $ findField "name" xs)+               : map tail (filter notNameIters xs)++-- Only keep those fields that are passed to this function+-- Also, preserve any predictor fields for regression analysis+filterFields :: [String] -> BenchmarkIterMatrix -> BenchmarkIterMatrix+filterFields fieldNames BenchmarkIterMatrix{..} =+    BenchmarkIterMatrix+        { iterPredColNames = ["iters"] ++ filter isPredictorField iterRespColNames+        , iterRespColNames = filter isRequestedField iterRespColNames+        , iterRowValues = transform iterRowValues+        }++    where++    transform :: [(String, [([Double], [Double])])] -> [(String, [([Double], [Double])])]+    transform = map (\(name, tuples) ->+        let (ys, zs) = unzip tuples+            pcols = transpose (map Left iterPredColNames : map (map Right) ys)+            rcols = transpose (map Left iterRespColNames : map (map Right) zs)+            pcols' = pcols ++ filter isPredictor rcols+            rcols' = filter requested rcols+            pcols'' = map (map fromRt) $ tail $ transpose pcols'+            rcols'' = map (map fromRt) $ tail $ transpose rcols'+        in (name, zip pcols'' rcols''))++    fromRt (Right x) = x+    fromRt _ = error "bug"++    isRequestedField = (`elem` fieldNames)++    requested [] = True+    requested (Left x:_) = isRequestedField x+    requested _ = error "bug"++    isPredictor [] = True+    isPredictor (Left x:_) = isPredictorField x+    isPredictor _ = error "bug"++-- Split the file into different runs+-- return the header fields and list of runs without the header+splitRuns :: NumberedLines -> ([String], [NumberedLines])+splitRuns csvlines =+    let header = snd $ head csvlines+        ls = linesBy (\x -> snd x == header) (tail csvlines)+    in (header, ls)++readWithError :: Read a => Int -> String -> (String, String) -> a+readWithError lno typ (fname, fval) =+    case readMaybe fval of+        Nothing -> error $ "Cannot read " ++ show fname+            ++ " field [" ++ show fval ++ "] as "+            ++ typ ++ " type at line number "+            ++ show lno+        Just n -> n++-- An iteration field indicates that consecutive rows with the same benchmark+-- name have results from different iterations of the same benchmark and the+-- measurement fields have to be scaled per iteration based on the number of+-- iterations in the iteration count field.+--+-- If the first column is iteration then fold all iterations and remove the+-- iteration column.+readIterations :: [String] -> NumberedLines -> BenchmarkIterMatrix+readIterations header csvlines =+    let tuples =+            map (parseNumericFields header) csvlines+            -- we now have a list of triples [(iter, name, (fieldName, [Double])]+          & groupBy successiveIters+          & map (foldl' addIters ("",[]))+    in BenchmarkIterMatrix+        { iterPredColNames = ["iters"]+        , iterRespColNames = drop 2 header+        , iterRowValues = tuples+        }++    where++    -- The first column is iters and the second is the name+    -- We zip the header for error reporting+    parseNumericFields hdr (lno, vals) = parseNumericTuples lno $ zip hdr vals++    parseNumericTuples lno (iter:(_,name):xs) =+          (readWithError lno "Int" iter :: Int+          , name+          , map (\x@(n,_) -> (n, readWithError lno "Double" x)) xs+                :: [(String, Double)]+          )+    parseNumericTuples _ _ = error "iters and name fields are needed"++    successiveIters (i1,name1,_) (i2,name2,_) = name2 == name1 && i2 > i1++    addIters (_,siters) (iter,name,vals) =+        (name, ([fromIntegral iter], map snd vals) : siters)++getFieldRange :: String -> Config -> Maybe (Double, Double)+getFieldRange fieldName Config{..} =+    let res = find (\(x, _, _) -> x == fieldName) fieldRanges+    in case res of+        Nothing -> Nothing+        Just (_, x, y) -> Just (x, y)++getFieldTick :: String -> Config -> Maybe FieldTick+getFieldTick fieldName Config{..} =+    fmap snd $ find (\x -> fst x == fieldName) fieldTicks++getReportExtension :: ReportType -> String+getReportExtension rtype =+    case rtype of+        TextReport -> ".txt"+        GraphicalChart -> ".svg"++prepareOutputFile :: FilePath -> ReportType -> FilePath -> Estimator -> String -> FilePath+prepareOutputFile dir rtype file est field =+    let estStr = case est of+            Mean -> "mean"+            Median -> "median"+            Regression -> "coeff"+        path = dir </> (file ++ "-" ++ estStr ++ "-" ++ field+                             ++ getReportExtension rtype)+    in path++prepareToReport :: FilePath -> Config -> IO (CSV, [String])+prepareToReport inputFile Config{..} = do+    case outputDir of+        Nothing -> return ()+        Just dir -> createDirectoryIfMissing True dir+    -- We assume the dataset is not big and therefore take liberties to process+    -- in a non-streaming fashion.+    csvData <- parseCSVFromFile inputFile+    case csvData of+        Left e -> error $ show e+        Right csvlines -> do+            when (null csvlines) $ error $ "The input file ["+                ++ show inputFile ++ "] is empty"+            let allFields = head csvlines+                fields = selectFields allFields+            filterSanity "selectFields" allFields fields+            let filt x = notElem (map toLower x) ["name", "iters"]+            return (csvlines, filter filt fields)++-- Keep only those benchmarks that belong to the group.+filterGroupBenchmarks :: [GroupMatrix] -> IO [GroupMatrix]+filterGroupBenchmarks matrices = return $ map filterMatrix matrices+    where+    filterMatrix matrix =+        -- XXX make sure there are no duplicates+        let m = groupMatrix matrix+            vals = map (\(new,old) ->+                (new, fromMaybe (error "bug") $ lookup old (rowValues m)))+                (groupBenches matrix)+        in matrix {groupMatrix = m {rowValues = vals}}++_filterCommonSubsets :: [BenchmarkIterMatrix] -> [BenchmarkIterMatrix]+_filterCommonSubsets matrices =+    let commonPreds =+            let initPreds = matrixPreds $ head matrices+            in foldl' intersectPreds initPreds (tail matrices)+    in map (isectCommonPreds commonPreds) matrices++    where++    pcols = iterPredColNames $ head matrices++    cmpPred name v1 v2 =+            case map toLower name of+                "iters" -> v1 == v2+                "nivcsw" -> v1 == v2+                _ -> v1 == v2++    isectBench (name1, preds1) (name2, preds2) =+        let isect row1 row2 = all id $ zipWith3 cmpPred pcols row1 row2+        in assert (name1 == name2) $ (name1, intersectBy isect preds1 preds2)++    matrixPreds = map (second (map fst)) . iterRowValues++    intersectPreds preds matrix = zipWith isectBench preds (matrixPreds matrix)++    isectRows (name1, preds1) (name2, xs) =+        let isect row1 = find (\(x,_) -> all id+                                $ zipWith3 cmpPred pcols row1 x) xs+        in assert (name1 == name2) $ (name1, mapMaybe isect preds1)++    isectCommonPreds preds matrix@BenchmarkIterMatrix{..} =+        matrix+            { iterRowValues = zipWith isectRows preds iterRowValues+            }++-- when comparing make sure all groups have same benchmarks and sort the other+-- ones based on the first column so that they are all in the same order.+selectCommon :: [GroupMatrix] -> IO [GroupMatrix]+selectCommon matrices =+    let commonBenches =+            let initBenches = map fst $ groupBenches $ head matrices+            in foldl' intersectBenches initBenches (tail matrices)+    in mapM (isectCommonBenches commonBenches) matrices++    where++    intersectBenches benches matrix =+        intersect benches (map fst $ groupBenches matrix)++    isectCommonBenches benches matrix@GroupMatrix{..} = do+        let absent = map fst groupBenches \\ benches+            msg =+                "Removing benchmarks " ++ show absent+                ++ " from column [" ++ groupName+                ++ "] run id [" ++ show groupIndex ++ "]"+            lookupBench x = lookup x groupBenches+            findBench x = (x, fromMaybe undefined (lookupBench x))+            newBenches = map findBench benches++        unless (null absent) $ putStrLn msg+        return matrix { groupBenches = newBenches }++prepareGroupMatrices :: Config+                     -> FilePath+                     -> CSV+                     -> [String]+                     -> IO (Int, [GroupMatrix])+prepareGroupMatrices cfg@Config{..} inputFile csvlines fields = do+    let res@(_, ls) =+              sanityCheckCSV csvlines+            & splitRuns++    when (null ls) $+        error $ "No benchmark results found in CSV file: " ++ show inputFile++    let checkForData (runId, xs) =+            when (null xs) $+                putStrLn $ "No benchmark results found in the CSV file ["+                        ++ show inputFile+                        ++ "], for runId: "+                        ++ show runId++    mapM_ checkForData (zip [(0 :: Int)..] ls)++    let (hdr, runs) = ensureIterField res++    xs <- sequence $ map (readIterations hdr) runs+            & map (filterFields fields)+            -- & _filterCommonSubsets+            -- & map filterSamples+            & map foldBenchmark++    zip [0..] xs+        & map (splitGroup classifyBenchmark)+        & concat+        & sortGroups cfg+        >>= selectCommon+        >>= filterGroupBenchmarks+        >>= return . (length runs,)++-- XXX display GHC version as well+-- XXX display the OS/arch+-- XXX display compiler/RTS options as well e.g. -threaded and -N+-- This data should be in the measurement data++data ReportColumn = ReportColumn+    { colName   :: String+    , colUnit   :: RelativeUnit+    , colValues :: [Double]+    , colAnalyzed :: [AnalyzedField]+    } deriving Show++data RawReport = RawReport+    { reportOutputFile :: Maybe FilePath+    , reportIdentifier :: String+    , reportRowIds     :: [String]+    , reportColumns    :: [ReportColumn]+    , reportEstimators :: Maybe [[Estimator]]+    } deriving Show++getFieldMin :: Config -> Double -> String -> Double+getFieldMin cfg minval fieldName =+    case getFieldRange fieldName cfg of+        Nothing -> minval+        Just (minr, _) -> minr++scaleAnalyzedField :: RelativeUnit -> AnalyzedField -> AnalyzedField+scaleAnalyzedField (RelativeUnit _ mult) AnalyzedField{..} =+    AnalyzedField+    { analyzedMean = analyzedMean / mult+    , analyzedStdDev = analyzedStdDev / mult++    , analyzedMedian = analyzedMedian / mult+    , analyzedOutliers = analyzedOutliers+    , analyzedOutlierVar = analyzedOutlierVar+    , analyzedKDE = analyzedKDE+    , analyzedRegCoeff = case+        analyzedRegCoeff of+            Nothing -> Nothing+            Just Estimate{..} ->+                let ConfInt{..} = estError+                in Just $ Estimate+                    { estPoint = estPoint / mult+                    , estError = ConfInt+                        { confIntLDX = confIntLDX / mult+                        , confIntUDX = confIntUDX / mult+                        , confIntCL = confIntCL+                        }+                    }+    , analyzedRegRSq = analyzedRegRSq+    }++prepareGroupsReport :: Config+                    -> GroupStyle+                    -> Maybe FilePath+                    -> ReportType+                    -> Int+                    -> String+                    -> [GroupMatrix]+                    -> Maybe RawReport+prepareGroupsReport cfg@Config{..} style outfile rtype runs field matrices =+    -- XXX Determine the unit based the whole range of values across all columns+    let sortValues :: [String] -> [(String, a)] -> [a]+        sortValues bmarks vals =+            map (\name -> fromMaybe (error "bug") (lookup name vals)) bmarks++        unsortedCols = map (extractColumn field) matrices++        (estimators, transformedCols) =+            cmpTransformColumns rtype style estimator diffStrategy unsortedCols+        transformedColsByStyle s = snd $+            cmpTransformColumns rtype s estimator diffStrategy unsortedCols++        benchmarks = selectBenchmarksByField cfg matrices+                            transformedCols transformedColsByStyle+        sortedCols = map (sortValues benchmarks) transformedCols+        origSortedCols = map (sortValues benchmarks) unsortedCols++        mkColUnits :: [RelativeUnit]+        mkColUnits =+            let cols =+                    if style /= Absolute+                    -- if we consider diff values as well here then the+                    -- units will change to potentially very small.+                    then [head sortedCols]+                    else sortedCols+                minVal = getFieldMin cfg (minimum $ concat cols) field+                mkPercentColUnitText =+                    let unit = fieldUnits field minVal Absolute+                        punit = fieldUnits field 1 style -- % unit+                    in unit : replicate (length matrices - 1) punit+                mkPercentColUnitGraph = [fieldUnits field minVal Absolute]+                mkAbsoluteUnit =+                     let unit = fieldUnits field minVal style+                     in replicate (length matrices) unit+            in case (rtype, style) of+                -- In case of percentDiff in TextReport we use absolute+                -- values in the baseline column, so the unit is different.+                (_, Absolute)   -> mkAbsoluteUnit+                (_, Diff)       -> mkAbsoluteUnit+                (TextReport, _) -> mkPercentColUnitText+                (GraphicalChart, _) | length matrices == 1 ->+                    mkPercentColUnitGraph+                (GraphicalChart, _) -> mkAbsoluteUnit++        mkColValues :: [[Double]]+        mkColValues =+            let applyUnit col (RelativeUnit _ multiplier) =+                    map (/multiplier) col+            in zipWith applyUnit sortedCols mkColUnits++        mkColNames :: [String]+        mkColNames =+                let withSuffix x =+                        groupName x +++                            if runs > 1+                            then "(" ++ show (groupIndex x) ++ ")"+                            else ""+                in map withSuffix matrices++        columns =+            getZipList+                $ (\n u v a ->+                       ReportColumn n u v (map (scaleAnalyzedField u) a))+                    <$> ZipList mkColNames+                    <*> ZipList mkColUnits+                    <*> ZipList mkColValues+                    <*> ZipList origSortedCols++        removeBaseline xs =+            let rel = case style of+                        Absolute -> False+                        Diff -> False+                        PercentDiff -> True+                        Multiples -> True+            in if omitBaseline && rel && length matrices > 1+               then tail xs+               else xs++    in if length benchmarks > 0+       then Just $ RawReport+                { reportOutputFile = outfile+                , reportIdentifier = field+                , reportRowIds     = benchmarks+                , reportColumns    = removeBaseline+                    $ columnNameByUnit mkColUnits+                    $ columnNameByStyle style columns+                , reportEstimators = fmap removeBaseline estimators+                }+       else Nothing++showStatusMessage :: Show a => Config -> String -> Maybe a -> IO ()+showStatusMessage cfg field outfile =+    let atitle = case mkTitle cfg of+                    Just f -> " [" ++ f field ++ "]"+                    Nothing ->+                        " [" ++ makeTitle field (diffString (presentation cfg)+                                 (diffStrategy cfg)) cfg ++ "]"+    in case outfile of+        Just path ->+            putStrLn $ "Creating chart"+                ++ atitle+                ++ " at "+                ++ show path+        Nothing -> return ()++reportComparingGroups+    :: GroupStyle+    -> FilePath+    -> Maybe FilePath+    -> ReportType+    -> Int+    -> Config+    -> (RawReport -> Config -> IO ())+    -> [GroupMatrix]+    -> String+    -> IO ()+reportComparingGroups style dir outputFile rtype runs cfg@Config{..} mkReport matrices field = do+    let outfile = case outputFile of+            Just file -> Just $ prepareOutputFile dir rtype file+                                            estimator field+            Nothing -> Nothing+        mRawReport = prepareGroupsReport cfg style outfile rtype runs field matrices+    -- Don't make report if it is empty+    case mRawReport of+        Just rawReport -> do+            showStatusMessage cfg field outfile+            mkReport rawReport cfg+        Nothing -> return ()++-- Prepare report for a given group, the report would consist of multiple+-- field columns.+prepareFieldsReport :: Config+                 -> Maybe FilePath+                 -> GroupMatrix+                 -> Maybe RawReport+prepareFieldsReport cfg@Config{..} outfile group =+    let mkColNames :: [String]+        mkColNames = colNames $ groupMatrix group++        benchmarks = selectBenchmarksByGroup cfg group++        getBenchValues name =+              fromMaybe (error "bug") $+                lookup name (rowValues $ groupMatrix group)++        sortedCols = transpose $ map getBenchValues benchmarks+        minColValues = map (minimum . map (getAnalyzedValue estimator))+                           sortedCols++        mkColUnits :: [RelativeUnit]+        mkColUnits = map (\(x, v) -> getUnitByFieldName x (getFieldMin cfg v x))+                         (zip mkColNames minColValues)++        mkColValues :: [[Double]]+        mkColValues =+            let scaleCol (RelativeUnit _ multiplier) = map (/ multiplier)+            in  zipWith scaleCol mkColUnits+                    (map (map (getAnalyzedValue estimator)) sortedCols)++        addUnitLabel name (RelativeUnit label _) =+            if label /= []+            then name ++ inParens label+            else name+        withUnits xs = zipWith addUnitLabel xs mkColUnits++        columns = getZipList $ ReportColumn+                <$> ZipList (withUnits mkColNames)+                <*> ZipList mkColUnits+                <*> ZipList mkColValues+                <*> ZipList sortedCols++    in if length benchmarks > 0+       then Just $ RawReport+                { reportOutputFile = outfile+                , reportIdentifier = groupName group+                , reportRowIds     = benchmarks+                , reportColumns    = columns+                , reportEstimators = Nothing+                }+       else Nothing++reportPerGroup+    :: FilePath+    -> Maybe FilePath+    -> ReportType+    -> Config+    -> (RawReport -> Config -> IO ())+    -> GroupMatrix+    -> IO ()+reportPerGroup dir outputFile rtype cfg@Config{..} mkReport group = do+    let outfile = case outputFile of+            Just file -> Just $ prepareOutputFile dir rtype file+                                            estimator (groupName group)+            Nothing -> Nothing+        mRawReport = prepareFieldsReport cfg outfile group+    -- Don't make report if it is empty+    case mRawReport of+        Just rawReport -> do+            showStatusMessage cfg (groupName group) outfile+            mkReport rawReport cfg+        Nothing -> return ()++-------------------------------------------------------------------------------+-- Utility functions+-------------------------------------------------------------------------------++showDiffStrategy :: DiffStrategy -> String+showDiffStrategy s =+    case s of+        SingleEstimator -> ""+        MinEstimator -> "using min estimator"++diffString :: Presentation -> DiffStrategy -> Maybe String+diffString style s =+    case style of+        Groups Diff -> Just $ "Diff from Baseline " ++ showDiffStrategy s+        Groups PercentDiff -> Just $ "Diff % of Lower " ++ showDiffStrategy s+        Groups Multiples -> Just $ "Multiples of Baseline " ++ showDiffStrategy s+        Groups Absolute -> Nothing+        Solo -> Nothing+        Fields -> Nothing++inParens :: String -> String+inParens str = "(" ++ str ++ ")"++showEstimator :: Estimator -> String+showEstimator est =+    case est of+        Mean       -> "Mean"+        Median     -> "Median"+        Regression -> "Regression Coeff."++addAnnotation :: String -> Maybe String -> Config -> TitleAnnotation -> String+addAnnotation field diff Config{..} annot =+      inParens+    $ case annot of+        TitleField -> field+        TitleEstimator -> showEstimator estimator+        TitleDiff -> maybe "" inParens diff++makeTitle :: String -> Maybe String -> Config -> String+makeTitle field diff cfg@Config{..} =+       fromMaybe "" title+       ++ concatMap (addAnnotation field diff cfg) titleAnnotations

@@ -0,0 +1,201 @@+-- |+-- 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 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+    -- workaround for a bug that renders the plot badly when using+    -- a single cluster in the bar chart.+    then columns ++ [ReportColumn+            { colName = ""+            , colUnit = RelativeUnit "" 1+            , colValues = []+            , colAnalyzed = []+            }]+     else 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+        { colName = colName+        , colUnit = colUnit+        , colValues = map (\val ->+            case val of+                x | x >= 1 -> x - 1+                x | x < (-1) -> x + 1+                x -> error $ "BenchShow.Internal.Graph.transformFractionValue: unhandled: " ++ show x+                ) colValues+        , colAnalyzed = colAnalyzed+        }++transformFractionLabels :: LinearAxisParams Double+transformFractionLabels =+    ((def :: (LinearAxisParams Double)) { _la_labelf = \xs ->+        let shiftVals v = if v >= 0 then v + 1 else v - 1+            replaceMinus ('-' : ys) = "1/" ++ ys+            replaceMinus ys = ys+        in fmap replaceMinus (_la_labelf def (map shiftVals xs))+    })++genGroupGraph :: RawReport -> Config -> IO ()+genGroupGraph RawReport{..} cfg@Config{..} = do+    let outputFile  = fromMaybe undefined reportOutputFile+        fieldRange  = getFieldRange reportIdentifier cfg+        granularity = getFieldTick reportIdentifier cfg+        -- XXX assert that the unit for all columns is the same+        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 = case mkTitle of+            Just f -> f reportIdentifier+            Nothing -> 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+        -- delete the -1x to 1x band of values which are not possible in case+        -- of fraction style+        cols' <-+                case presentation of+                    Groups Multiples -> do+                        layout_y_axis . laxis_generate .= autoScaledAxis+                                        transformFractionLabels+                        return $ map transformFractionValue columns+                    _ -> return columns++        layout <- get+        case _layout_legend layout of+            Nothing -> return ()+            Just style@LegendStyle{..} -> do+                let s = style { _legend_plot_size = 22+                              -- , _legend_margin = 40+                              -- This is not available in versions <= 1.8.2+                              -- , _legend_position = LegendBelow+                              , _legend_label_style = _legend_label_style+                                    { _font_size = 14 }+                              }+                put $ layout { _layout_legend = Just s }++        -- layout_y_axis . laxis_override .= axisGridAtTicks+        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 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 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 (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

@@ -0,0 +1,58 @@+{-# LANGUAGE CPP #-}++-- |+-- Module      : BenchShow.Internal.Pretty+-- Copyright   : (c) 2022 Composewell Technologies+--+-- License     : BSD-style+-- Maintainer  : harendra.kumar@gmail.com+-- Stability   : experimental+-- Portability : GHC++module BenchShow.Internal.Pretty+    ( Doc+    , dullred+    , dullgreen+    , (<+>)+    , vcat+    , fill+    , indent+    , text+    , putDoc+    ) where++#ifndef NO_COLORS++import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))++#else++type Doc = String++dullred :: Doc -> Doc+dullred = id++dullgreen :: Doc -> Doc+dullgreen = id++(<+>) :: Doc -> Doc -> Doc+(<+>) x y = x ++ " " ++ y++vcat :: [Doc] -> Doc+vcat = unlines++putDoc :: Doc -> IO ()+putDoc = putStrLn++fill :: Int -> Doc  -> Doc+fill i x =+    let len = length x+     in x ++ replicate (i - len) ' '++indent :: Int -> Doc -> Doc+indent i = unlines . map (replicate i ' ' ++) . lines++text :: String -> Doc+text = id++#endif

@@ -0,0 +1,220 @@+-- |+-- Module      : BenchShow.Internal.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.Internal.Report+    (+      report+    ) where++import Control.Applicative (ZipList(..))+import Control.Monad (forM_)+import Data.Maybe (fromMaybe)+import Statistics.Types (Estimate(..))+import Text.Printf (printf)++import BenchShow.Internal.Common+import BenchShow.Internal.Analysis+import BenchShow.Internal.Pretty++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 f -> putStrLn $ f reportIdentifier+        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 =+                    let regular = renderGroupCol $ showCol col Nothing+                        colored = zipWith ($) (id : id : colorCol col)+                                    $ renderGroupCol+                                    $ showCol col estimators+                    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+                Nothing ->  getZipList $+                            renderTailCols+                        <$> pure Nothing+                        <*> ZipList tailCols+        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 colAnalyzed+        in colName : withEstVal++    showCol ReportColumn{..} estimators = 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 colAnalyzed+                    <*> ZipList ests++            Nothing ->+                let withEstVal val estvals est =+                           showVal val+                        ++ if verbose then showEstVal estvals est else ""+                in getZipList $+                        withEstVal+                    <$> ZipList colValues+                    <*> ZipList colAnalyzed+                    <*> 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

@@ -1,222 +0,0 @@--- |--- 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

@@ -237,8 +237,8 @@ -- compared is arrived at. By default we use the 'MinEstimators' strategy which -- computes the difference using all the available estimators and takes the -- minimum of all. We can use a 'SingleEstimator' strategy instead if we so--- desire, it uses the estimatorr configured for the report using the--- @estimator@ field of the configuration..+-- desire, it uses the estimator configured for the report using the+-- @estimator@ field of the configuration. -- -- @ --    'report' "results.csv" Nothing

@@ -1,17 +0,0 @@-resolver: lts-11.10-packages:-- '.'-extra-deps:-  - Chart-diagrams-1.8.3-  - SVGFonts-1.6.0.3-  - diagrams-core-1.4.0.1-  - diagrams-lib-1.4.2-  - diagrams-postscript-1.4-  - diagrams-svg-1.4.1.1-  - diagrams-solve-0.1.1-  - dual-tree-0.2.1-  - lens-4.15.4-  - free-4.12.4-  - statistics-0.15.0.0-  - math-functions-0.3.0.2-  - dense-linear-algebra-0.1.0.0

@@ -1,12 +1,3 @@-resolver: lts-13.25+resolver: lts-16.11 packages: - '.'-extra-deps:-  - Chart-1.9.1-  - Chart-diagrams-1.9.2--    #- SVGFonts-1.6.0.3-    #- statistics-0.15.0.0-    #- math-functions-0.3.0.2-    #- dense-linear-algebra-0.1.0.0-    #- optparse-applicative-0.14.2.0