{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE BangPatterns, DeriveDataTypeable, RecordWildCards #-}

-- |
-- Module      : Criterion.Analysis
-- Copyright   : (c) 2009-2014 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Analysis code for benchmarks.

module Criterion.Analysis
    (
      Outliers(..)
    , OutlierEffect(..)
    , OutlierVariance(..)
    , SampleAnalysis(..)
    , analyseSample
    , scale
    , analyseMean
    , countOutliers
    , classifyOutliers
    , noteOutliers
    , outlierVariance
    , resolveAccessors
    , validateAccessors
    , regress
    ) where

import Control.Arrow (second)
import Control.Monad (unless, when)
import Control.Monad.Reader (ask)
import Control.Monad.Trans
import Control.Monad.Trans.Except
import Criterion.IO.Printf (note, prolix)
import Criterion.Measurement (secs, threshold)
import Criterion.Monad (Criterion, getGen)
import Criterion.Types
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Prelude ()
import Prelude.Compat
import Statistics.Function (sort)
import Statistics.Quantile (weightedAvg)
import Statistics.Regression (bootstrapRegress, olsRegress)
import Statistics.Resampling (Estimator(..),resample)
import Statistics.Sample (mean)
import Statistics.Sample.KernelDensity (kde)
import Statistics.Types (Sample)
import System.Random.MWC (GenIO)
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Vector as V
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed as U
import qualified Statistics.Resampling.Bootstrap as B
import qualified Statistics.Types                as B

-- | Classify outliers in a data set, using the boxplot technique.
classifyOutliers :: Sample -> Outliers
classifyOutliers :: Sample -> Outliers
classifyOutliers Sample
sa = (Outliers -> Double -> Outliers) -> Outliers -> Sample -> Outliers
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
U.foldl' (((Outliers -> Outliers)
-> (Double -> Outliers) -> Double -> Outliers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Outliers
outlier) ((Outliers -> Outliers) -> Double -> Outliers)
-> (Outliers -> Outliers -> Outliers)
-> Outliers
-> Double
-> Outliers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Outliers -> Outliers -> Outliers
forall a. Monoid a => a -> a -> a
mappend) Outliers
forall a. Monoid a => a
mempty Sample
ssa
    where outlier :: Double -> Outliers
outlier Double
e = Outliers :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Outliers
Outliers {
                        samplesSeen :: Int64
samplesSeen = Int64
1
                      , lowSevere :: Int64
lowSevere = if Double
e Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
loS Bool -> Bool -> Bool
&& Double
e Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
hiM then Int64
1 else Int64
0
                      , lowMild :: Int64
lowMild = if Double
e Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
loS Bool -> Bool -> Bool
&& Double
e Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
loM then Int64
1 else Int64
0
                      , highMild :: Int64
highMild = if Double
e Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
hiM Bool -> Bool -> Bool
&& Double
e Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
hiS then Int64
1 else Int64
0
                      , highSevere :: Int64
highSevere = if Double
e Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
hiS Bool -> Bool -> Bool
&& Double
e Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
loM then Int64
1 else Int64
0
                      }
          !loS :: Double
loS = Double
q1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
iqr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
3)
          !loM :: Double
loM = Double
q1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
iqr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.5)
          !hiM :: Double
hiM = Double
q3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
iqr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.5)
          !hiS :: Double
hiS = Double
q3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
iqr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
3)
          q1 :: Double
q1   = Int -> Int -> Sample -> Double
forall (v :: * -> *).
Vector v Double =>
Int -> Int -> v Double -> Double
weightedAvg Int
1 Int
4 Sample
ssa
          q3 :: Double
q3   = Int -> Int -> Sample -> Double
forall (v :: * -> *).
Vector v Double =>
Int -> Int -> v Double -> Double
weightedAvg Int
3 Int
4 Sample
ssa
          ssa :: Sample
ssa  = Sample -> Sample
sort Sample
sa
          iqr :: Double
iqr  = Double
q3 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
q1

-- | Compute the extent to which outliers in the sample data affect
-- the sample mean and standard deviation.
outlierVariance
  :: B.Estimate B.ConfInt Double -- ^ Bootstrap estimate of sample mean.
  -> B.Estimate B.ConfInt Double -- ^ Bootstrap estimate of sample
                                 --   standard deviation.
  -> Double                      -- ^ Number of original iterations.
  -> OutlierVariance
outlierVariance :: Estimate ConfInt Double
-> Estimate ConfInt Double -> Double -> OutlierVariance
outlierVariance Estimate ConfInt Double
µ Estimate ConfInt Double
σ Double
a = OutlierEffect -> String -> Double -> OutlierVariance
OutlierVariance OutlierEffect
effect String
desc Double
varOutMin
  where
    ( OutlierEffect
effect, String
desc ) | Double
varOutMin Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.01 = (OutlierEffect
Unaffected, String
"no")
                     | Double
varOutMin Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.1  = (OutlierEffect
Slight,     String
"a slight")
                     | Double
varOutMin Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.5  = (OutlierEffect
Moderate,   String
"a moderate")
                     | Bool
otherwise        = (OutlierEffect
Severe,     String
"a severe")
    varOutMin :: Double
varOutMin = ((Double -> Double) -> Double -> Double -> Double
forall a t. Ord a => (t -> a) -> t -> t -> a
minBy Double -> Double
varOut Double
1 ((Double -> Double) -> Double -> Double -> Double
forall a t. Ord a => (t -> a) -> t -> t -> a
minBy Double -> Double
forall b. Num b => Double -> b
cMax Double
0 Double
µgMin)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
σb2
    varOut :: Double -> Double
varOut Double
c  = (Double
ac Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
a) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
σb2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
σg2) where ac :: Double
ac = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c
    σb :: Double
σb        = Estimate ConfInt Double -> Double
forall (e :: * -> *) a. Estimate e a -> a
B.estPoint Estimate ConfInt Double
σ
    µa :: Double
µa        = Estimate ConfInt Double -> Double
forall (e :: * -> *) a. Estimate e a -> a
B.estPoint Estimate ConfInt Double
µ Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
a
    µgMin :: Double
µgMin     = Double
µa Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    σg :: Double
σg        = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Double
µgMin Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
4) (Double
σb Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
sqrt Double
a)
    σg2 :: Double
σg2       = Double
σg Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
σg
    σb2 :: Double
σb2       = Double
σb Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
σb
    minBy :: (t -> a) -> t -> t -> a
minBy t -> a
f t
q t
r = a -> a -> a
forall a. Ord a => a -> a -> a
min (t -> a
f t
q) (t -> a
f t
r)
    cMax :: Double -> b
cMax Double
x    = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (-Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
k0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
k1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
sqrt Double
det)) :: Int)
      where
        k1 :: Double
k1    = Double
σb2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
σg2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ad
        k0 :: Double
k0    = -Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ad
        ad :: Double
ad    = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d
        d :: Double
d     = Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
k where k :: Double
k = Double
µa Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x
        det :: Double
det   = Double
k1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
k1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
σg2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
k0

-- | Count the total number of outliers in a sample.
countOutliers :: Outliers -> Int64
countOutliers :: Outliers -> Int64
countOutliers (Outliers Int64
_ Int64
a Int64
b Int64
c Int64
d) = Int64
a Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
c Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
d
{-# INLINE countOutliers #-}

-- | Display the mean of a 'Sample', and characterise the outliers
-- present in the sample.
analyseMean :: Sample
            -> Int              -- ^ Number of iterations used to
                                -- compute the sample.
            -> Criterion Double
analyseMean :: Sample -> Int -> Criterion Double
analyseMean Sample
a Int
iters = do
  let µ :: Double
µ = Sample -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
mean Sample
a
  Any
_ <- String -> String -> Int -> Criterion Any
forall r. CritHPrintfType r => String -> r
note String
"mean is %s (%d iterations)\n" (Double -> String
secs Double
µ) Int
iters
  Outliers -> Criterion ()
noteOutliers (Outliers -> Criterion ())
-> (Sample -> Outliers) -> Sample -> Criterion ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample -> Outliers
classifyOutliers (Sample -> Criterion ()) -> Sample -> Criterion ()
forall a b. (a -> b) -> a -> b
$ Sample
a
  Double -> Criterion Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
µ

-- | Multiply the 'Estimate's in an analysis by the given value, using
-- 'B.scale'.
scale :: Double                 -- ^ Value to multiply by.
      -> SampleAnalysis -> SampleAnalysis
scale :: Double -> SampleAnalysis -> SampleAnalysis
scale Double
f s :: SampleAnalysis
s@SampleAnalysis{[Regression]
Estimate ConfInt Double
OutlierVariance
anOutlierVar :: SampleAnalysis -> OutlierVariance
anStdDev :: SampleAnalysis -> Estimate ConfInt Double
anMean :: SampleAnalysis -> Estimate ConfInt Double
anRegress :: SampleAnalysis -> [Regression]
anOutlierVar :: OutlierVariance
anStdDev :: Estimate ConfInt Double
anMean :: Estimate ConfInt Double
anRegress :: [Regression]
..} = SampleAnalysis
s {
                                 anMean :: Estimate ConfInt Double
anMean = Double -> Estimate ConfInt Double -> Estimate ConfInt Double
forall (e :: * -> *) a. (Scale e, Ord a, Num a) => a -> e a -> e a
B.scale Double
f Estimate ConfInt Double
anMean
                               , anStdDev :: Estimate ConfInt Double
anStdDev = Double -> Estimate ConfInt Double -> Estimate ConfInt Double
forall (e :: * -> *) a. (Scale e, Ord a, Num a) => a -> e a -> e a
B.scale Double
f Estimate ConfInt Double
anStdDev
                               }

-- | Perform an analysis of a measurement.
analyseSample :: Int            -- ^ Experiment number.
              -> String         -- ^ Experiment name.
              -> V.Vector Measured -- ^ Sample data.
              -> ExceptT String Criterion Report
analyseSample :: Int -> String -> Vector Measured -> ExceptT String Criterion Report
analyseSample Int
i String
name Vector Measured
meas = do
  Config{Double
Int
String
[([String], String)]
Maybe String
CL Double
Verbosity
template :: Config -> String
verbosity :: Config -> Verbosity
junitFile :: Config -> Maybe String
jsonFile :: Config -> Maybe String
csvFile :: Config -> Maybe String
reportFile :: Config -> Maybe String
rawDataFile :: Config -> Maybe String
regressions :: Config -> [([String], String)]
resamples :: Config -> Int
timeLimit :: Config -> Double
confInterval :: Config -> CL Double
template :: String
verbosity :: Verbosity
junitFile :: Maybe String
jsonFile :: Maybe String
csvFile :: Maybe String
reportFile :: Maybe String
rawDataFile :: Maybe String
regressions :: [([String], String)]
resamples :: Int
timeLimit :: Double
confInterval :: CL Double
..} <- ExceptT String Criterion Config
forall r (m :: * -> *). MonadReader r m => m r
ask
  let ests :: [Estimator]
ests      = [Estimator
Mean,Estimator
StdDev]
      -- The use of filter here throws away very-low-quality
      -- measurements when bootstrapping the mean and standard
      -- deviations.  Without this, the numbers look nonsensical when
      -- very brief actions are measured.
      stime :: Sample
stime     = (Measured -> Double) -> Vector Measured -> Sample
forall a. Unbox a => (Measured -> a) -> Vector Measured -> Vector a
measure (Measured -> Double
measTime (Measured -> Double)
-> (Measured -> Measured) -> Measured -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measured -> Measured
rescale) (Vector Measured -> Sample)
-> (Vector Measured -> Vector Measured)
-> Vector Measured
-> Sample
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (Measured -> Bool) -> Vector Measured -> Vector Measured
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
G.filter ((Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
threshold) (Double -> Bool) -> (Measured -> Double) -> Measured -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measured -> Double
measTime) (Vector Measured -> Sample) -> Vector Measured -> Sample
forall a b. (a -> b) -> a -> b
$ Vector Measured
meas
      n :: Int
n         = Vector Measured -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector Measured
meas
      s :: Int
s         = Sample -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Sample
stime
  Any
_ <- Criterion Any -> ExceptT String Criterion Any
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Criterion Any -> ExceptT String Criterion Any)
-> Criterion Any -> ExceptT String Criterion Any
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> Int -> Criterion Any
forall r. CritHPrintfType r => String -> r
prolix String
"bootstrapping with %d of %d samples (%d%%)\n"
              Int
s Int
n ((Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
n)
  Gen RealWorld
gen <- Criterion (Gen RealWorld)
-> ExceptT String Criterion (Gen RealWorld)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Criterion (Gen RealWorld)
Criterion GenIO
getGen
  [Regression]
rs <- (([String], String) -> ExceptT String Criterion Regression)
-> [([String], String)] -> ExceptT String Criterion [Regression]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\([String]
ps,String
r) -> GenIO
-> [String]
-> String
-> Vector Measured
-> ExceptT String Criterion Regression
regress Gen RealWorld
GenIO
gen [String]
ps String
r Vector Measured
meas) ([([String], String)] -> ExceptT String Criterion [Regression])
-> [([String], String)] -> ExceptT String Criterion [Regression]
forall a b. (a -> b) -> a -> b
$
        (([String
"iters"],String
"time")([String], String) -> [([String], String)] -> [([String], String)]
forall a. a -> [a] -> [a]
:[([String], String)]
regressions)
  [(Estimator, Bootstrap Vector Double)]
resamps <- IO [(Estimator, Bootstrap Vector Double)]
-> ExceptT String Criterion [(Estimator, Bootstrap Vector Double)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Estimator, Bootstrap Vector Double)]
 -> ExceptT String Criterion [(Estimator, Bootstrap Vector Double)])
-> IO [(Estimator, Bootstrap Vector Double)]
-> ExceptT String Criterion [(Estimator, Bootstrap Vector Double)]
forall a b. (a -> b) -> a -> b
$ GenIO
-> [Estimator]
-> Int
-> Sample
-> IO [(Estimator, Bootstrap Vector Double)]
resample Gen RealWorld
GenIO
gen [Estimator]
ests Int
resamples Sample
stime
  (Estimate ConfInt Double
estMean,Estimate ConfInt Double
estStdDev) <- case CL Double
-> Sample
-> [(Estimator, Bootstrap Vector Double)]
-> [Estimate ConfInt Double]
B.bootstrapBCA CL Double
confInterval Sample
stime [(Estimator, Bootstrap Vector Double)]
resamps of
    [Estimate ConfInt Double
estMean',Estimate ConfInt Double
estStdDev'] -> (Estimate ConfInt Double, Estimate ConfInt Double)
-> ExceptT
     String Criterion (Estimate ConfInt Double, Estimate ConfInt Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Estimate ConfInt Double
estMean',Estimate ConfInt Double
estStdDev')
    [Estimate ConfInt Double]
ests' -> String
-> ExceptT
     String Criterion (Estimate ConfInt Double, Estimate ConfInt Double)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT
      String
      Criterion
      (Estimate ConfInt Double, Estimate ConfInt Double))
-> String
-> ExceptT
     String Criterion (Estimate ConfInt Double, Estimate ConfInt Double)
forall a b. (a -> b) -> a -> b
$ String
"analyseSample: Expected two estimation functions, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Estimate ConfInt Double] -> String
forall a. Show a => a -> String
show [Estimate ConfInt Double]
ests'
  let ov :: OutlierVariance
ov = Estimate ConfInt Double
-> Estimate ConfInt Double -> Double -> OutlierVariance
outlierVariance Estimate ConfInt Double
estMean Estimate ConfInt Double
estStdDev (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      an :: SampleAnalysis
an = SampleAnalysis :: [Regression]
-> Estimate ConfInt Double
-> Estimate ConfInt Double
-> OutlierVariance
-> SampleAnalysis
SampleAnalysis {
               anRegress :: [Regression]
anRegress    = [Regression]
rs
             , anMean :: Estimate ConfInt Double
anMean       = Estimate ConfInt Double
estMean
             , anStdDev :: Estimate ConfInt Double
anStdDev     = Estimate ConfInt Double
estStdDev
             , anOutlierVar :: OutlierVariance
anOutlierVar = OutlierVariance
ov
             }
  Report -> ExceptT String Criterion Report
forall (m :: * -> *) a. Monad m => a -> m a
return Report :: Int
-> String
-> [String]
-> Vector Measured
-> SampleAnalysis
-> Outliers
-> [KDE]
-> Report
Report {
      reportNumber :: Int
reportNumber   = Int
i
    , reportName :: String
reportName     = String
name
    , reportKeys :: [String]
reportKeys     = [String]
measureKeys
    , reportMeasured :: Vector Measured
reportMeasured = Vector Measured
meas
    , reportAnalysis :: SampleAnalysis
reportAnalysis = SampleAnalysis
an
    , reportOutliers :: Outliers
reportOutliers = Sample -> Outliers
classifyOutliers Sample
stime
    , reportKDEs :: [KDE]
reportKDEs     = [(Sample -> Sample -> KDE) -> (Sample, Sample) -> KDE
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> Sample -> Sample -> KDE
KDE String
"time") (Int -> Sample -> (Sample, Sample)
forall (v :: * -> *).
(Vector v CD, Vector v Double, Vector v Int) =>
Int -> v Double -> (v Double, v Double)
kde Int
128 Sample
stime)]
    }

-- | Regress the given predictors against the responder.
--
-- Errors may be returned under various circumstances, such as invalid
-- names or lack of needed data.
--
-- See 'olsRegress' for details of the regression performed.
regress :: GenIO
        -> [String]             -- ^ Predictor names.
        -> String               -- ^ Responder name.
        -> V.Vector Measured
        -> ExceptT String Criterion Regression
regress :: GenIO
-> [String]
-> String
-> Vector Measured
-> ExceptT String Criterion Regression
regress GenIO
gen [String]
predNames String
respName Vector Measured
meas = do
  Bool -> ExceptT String Criterion () -> ExceptT String Criterion ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Vector Measured -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
G.null Vector Measured
meas) (ExceptT String Criterion () -> ExceptT String Criterion ())
-> ExceptT String Criterion () -> ExceptT String Criterion ()
forall a b. (a -> b) -> a -> b
$
    String -> ExceptT String Criterion ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"no measurements"
  [(String, Measured -> Maybe Double)]
accs <- Criterion (Either String [(String, Measured -> Maybe Double)])
-> ExceptT String Criterion [(String, Measured -> Maybe Double)]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Criterion (Either String [(String, Measured -> Maybe Double)])
 -> ExceptT String Criterion [(String, Measured -> Maybe Double)])
-> (Either String [(String, Measured -> Maybe Double)]
    -> Criterion (Either String [(String, Measured -> Maybe Double)]))
-> Either String [(String, Measured -> Maybe Double)]
-> ExceptT String Criterion [(String, Measured -> Maybe Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String [(String, Measured -> Maybe Double)]
-> Criterion (Either String [(String, Measured -> Maybe Double)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [(String, Measured -> Maybe Double)]
 -> ExceptT String Criterion [(String, Measured -> Maybe Double)])
-> Either String [(String, Measured -> Maybe Double)]
-> ExceptT String Criterion [(String, Measured -> Maybe Double)]
forall a b. (a -> b) -> a -> b
$ [String]
-> String -> Either String [(String, Measured -> Maybe Double)]
validateAccessors [String]
predNames String
respName
  let unmeasured :: [String]
unmeasured = [String
n | (String
n, Maybe Double
Nothing) <- ((String, Measured -> Maybe Double) -> (String, Maybe Double))
-> [(String, Measured -> Maybe Double)] -> [(String, Maybe Double)]
forall a b. (a -> b) -> [a] -> [b]
map (((Measured -> Maybe Double) -> Maybe Double)
-> (String, Measured -> Maybe Double) -> (String, Maybe Double)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Measured -> Maybe Double) -> Measured -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Vector Measured -> Measured
forall (v :: * -> *) a. Vector v a => v a -> a
G.head Vector Measured
meas)) [(String, Measured -> Maybe Double)]
accs]
  Bool -> ExceptT String Criterion () -> ExceptT String Criterion ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unmeasured) (ExceptT String Criterion () -> ExceptT String Criterion ())
-> ExceptT String Criterion () -> ExceptT String Criterion ()
forall a b. (a -> b) -> a -> b
$
    String -> ExceptT String Criterion ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String Criterion ())
-> String -> ExceptT String Criterion ()
forall a b. (a -> b) -> a -> b
$ String
"no data available for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
renderNames [String]
unmeasured
  (Sample
r,[Sample]
ps) <- case ((String, Measured -> Maybe Double) -> Sample)
-> [(String, Measured -> Maybe Double)] -> [Sample]
forall a b. (a -> b) -> [a] -> [b]
map (((Measured -> Double) -> Vector Measured -> Sample
forall a. Unbox a => (Measured -> a) -> Vector Measured -> Vector a
`measure` Vector Measured
meas) ((Measured -> Double) -> Sample)
-> ((String, Measured -> Maybe Double) -> Measured -> Double)
-> (String, Measured -> Maybe Double)
-> Sample
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Double -> Double
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Double -> Double)
-> (Measured -> Maybe Double) -> Measured -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Measured -> Maybe Double) -> Measured -> Double)
-> ((String, Measured -> Maybe Double) -> Measured -> Maybe Double)
-> (String, Measured -> Maybe Double)
-> Measured
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Measured -> Maybe Double) -> Measured -> Maybe Double
forall a b. (a, b) -> b
snd) [(String, Measured -> Maybe Double)]
accs of
    (Sample
r':[Sample]
ps') -> (Sample, [Sample]) -> ExceptT String Criterion (Sample, [Sample])
forall (m :: * -> *) a. Monad m => a -> m a
return (Sample
r',[Sample]
ps')
    []       -> String -> ExceptT String Criterion (Sample, [Sample])
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE String
"regress: Expected at least one accessor"
  Config{Double
Int
String
[([String], String)]
Maybe String
CL Double
Verbosity
template :: String
verbosity :: Verbosity
junitFile :: Maybe String
jsonFile :: Maybe String
csvFile :: Maybe String
reportFile :: Maybe String
rawDataFile :: Maybe String
regressions :: [([String], String)]
resamples :: Int
timeLimit :: Double
confInterval :: CL Double
template :: Config -> String
verbosity :: Config -> Verbosity
junitFile :: Config -> Maybe String
jsonFile :: Config -> Maybe String
csvFile :: Config -> Maybe String
reportFile :: Config -> Maybe String
rawDataFile :: Config -> Maybe String
regressions :: Config -> [([String], String)]
resamples :: Config -> Int
timeLimit :: Config -> Double
confInterval :: Config -> CL Double
..} <- ExceptT String Criterion Config
forall r (m :: * -> *). MonadReader r m => m r
ask
  (Vector (Estimate ConfInt Double)
coeffs,Estimate ConfInt Double
r2) <- IO (Vector (Estimate ConfInt Double), Estimate ConfInt Double)
-> ExceptT
     String
     Criterion
     (Vector (Estimate ConfInt Double), Estimate ConfInt Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector (Estimate ConfInt Double), Estimate ConfInt Double)
 -> ExceptT
      String
      Criterion
      (Vector (Estimate ConfInt Double), Estimate ConfInt Double))
-> IO (Vector (Estimate ConfInt Double), Estimate ConfInt Double)
-> ExceptT
     String
     Criterion
     (Vector (Estimate ConfInt Double), Estimate ConfInt Double)
forall a b. (a -> b) -> a -> b
$
                 GenIO
-> Int
-> CL Double
-> ([Sample] -> Sample -> (Sample, Double))
-> [Sample]
-> Sample
-> IO (Vector (Estimate ConfInt Double), Estimate ConfInt Double)
bootstrapRegress GenIO
gen Int
resamples CL Double
confInterval [Sample] -> Sample -> (Sample, Double)
olsRegress [Sample]
ps Sample
r
  Regression -> ExceptT String Criterion Regression
forall (m :: * -> *) a. Monad m => a -> m a
return Regression :: String
-> Map String (Estimate ConfInt Double)
-> Estimate ConfInt Double
-> Regression
Regression {
      regResponder :: String
regResponder = String
respName
    , regCoeffs :: Map String (Estimate ConfInt Double)
regCoeffs    = [(String, Estimate ConfInt Double)]
-> Map String (Estimate ConfInt Double)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([String]
-> [Estimate ConfInt Double] -> [(String, Estimate ConfInt Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([String]
predNames [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"y"]) (Vector (Estimate ConfInt Double) -> [Estimate ConfInt Double]
forall (v :: * -> *) a. Vector v a => v a -> [a]
G.toList Vector (Estimate ConfInt Double)
coeffs))
    , regRSquare :: Estimate ConfInt Double
regRSquare   = Estimate ConfInt Double
r2
    }

singleton :: [a] -> Bool
singleton :: [a] -> Bool
singleton [a
_] = Bool
True
singleton [a]
_   = Bool
False

-- | Given a list of accessor names (see 'measureKeys'), return either
-- a mapping from accessor name to function or an error message if
-- any names are wrong.
resolveAccessors :: [String]
                 -> Either String [(String, Measured -> Maybe Double)]
resolveAccessors :: [String] -> Either String [(String, Measured -> Maybe Double)]
resolveAccessors [String]
names =
  case [String]
unresolved of
    [] -> [(String, Measured -> Maybe Double)]
-> Either String [(String, Measured -> Maybe Double)]
forall a b. b -> Either a b
Right [(String
n, Measured -> Maybe Double
a) | (String
n, Just (Measured -> Maybe Double
a,String
_)) <- [(String, Maybe (Measured -> Maybe Double, String))]
accessors]
    [String]
_  -> String -> Either String [(String, Measured -> Maybe Double)]
forall a b. a -> Either a b
Left (String -> Either String [(String, Measured -> Maybe Double)])
-> String -> Either String [(String, Measured -> Maybe Double)]
forall a b. (a -> b) -> a -> b
$ String
"unknown metric " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
renderNames [String]
unresolved
  where
    unresolved :: [String]
unresolved = [String
n | (String
n, Maybe (Measured -> Maybe Double, String)
Nothing) <- [(String, Maybe (Measured -> Maybe Double, String))]
accessors]
    accessors :: [(String, Maybe (Measured -> Maybe Double, String))]
accessors = ((String -> (String, Maybe (Measured -> Maybe Double, String)))
 -> [String]
 -> [(String, Maybe (Measured -> Maybe Double, String))])
-> [String]
-> (String -> (String, Maybe (Measured -> Maybe Double, String)))
-> [(String, Maybe (Measured -> Maybe Double, String))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> (String, Maybe (Measured -> Maybe Double, String)))
-> [String] -> [(String, Maybe (Measured -> Maybe Double, String))]
forall a b. (a -> b) -> [a] -> [b]
map [String]
names ((String -> (String, Maybe (Measured -> Maybe Double, String)))
 -> [(String, Maybe (Measured -> Maybe Double, String))])
-> (String -> (String, Maybe (Measured -> Maybe Double, String)))
-> [(String, Maybe (Measured -> Maybe Double, String))]
forall a b. (a -> b) -> a -> b
$ \String
n -> (String
n, String
-> Map String (Measured -> Maybe Double, String)
-> Maybe (Measured -> Maybe Double, String)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
n Map String (Measured -> Maybe Double, String)
measureAccessors)

-- | Given predictor and responder names, do some basic validation,
-- then hand back the relevant accessors.
validateAccessors :: [String]   -- ^ Predictor names.
                  -> String     -- ^ Responder name.
                  -> Either String [(String, Measured -> Maybe Double)]
validateAccessors :: [String]
-> String -> Either String [(String, Measured -> Maybe Double)]
validateAccessors [String]
predNames String
respName = do
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
predNames) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left String
"no predictors specified"
  let names :: [String]
names = String
respNameString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
predNames
      dups :: [String]
dups = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
forall a. [a] -> a
head ([[String]] -> [String])
-> ([String] -> [[String]]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall a. [a] -> Bool
singleton) ([[String]] -> [[String]])
-> ([String] -> [[String]]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [String] -> [[String]]
forall a. Eq a => [a] -> [[a]]
List.group ([String] -> [[String]])
-> ([String] -> [String]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
List.sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
names
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dups) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"duplicated metric " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
renderNames [String]
dups
  [String] -> Either String [(String, Measured -> Maybe Double)]
resolveAccessors [String]
names

renderNames :: [String] -> String
renderNames :: [String] -> String
renderNames = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show

-- | Display a report of the 'Outliers' present in a 'Sample'.
noteOutliers :: Outliers -> Criterion ()
noteOutliers :: Outliers -> Criterion ()
noteOutliers Outliers
o = do
  let frac :: a -> Double
frac a
n = (Double
100::Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Outliers -> Int64
samplesSeen Outliers
o)
      check :: Int64 -> Double -> String -> Criterion ()
      check :: Int64 -> Double -> String -> Criterion ()
check Int64
k Double
t String
d = Bool -> Criterion () -> Criterion ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64 -> Double
forall a. Integral a => a -> Double
frac Int64
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
t) (Criterion () -> Criterion ()) -> Criterion () -> Criterion ()
forall a b. (a -> b) -> a -> b
$
                    String -> Int64 -> Double -> String -> Criterion ()
forall r. CritHPrintfType r => String -> r
note String
"  %d (%.1g%%) %s\n" Int64
k (Int64 -> Double
forall a. Integral a => a -> Double
frac Int64
k) String
d
      outCount :: Int64
outCount = Outliers -> Int64
countOutliers Outliers
o
  Bool -> Criterion () -> Criterion ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
outCount Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (Criterion () -> Criterion ()) -> Criterion () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ do
    Any
_ <- String -> Int64 -> Int64 -> Double -> Criterion Any
forall r. CritHPrintfType r => String -> r
note String
"found %d outliers among %d samples (%.1g%%)\n"
         Int64
outCount (Outliers -> Int64
samplesSeen Outliers
o) (Int64 -> Double
forall a. Integral a => a -> Double
frac Int64
outCount)
    Int64 -> Double -> String -> Criterion ()
check (Outliers -> Int64
lowSevere Outliers
o) Double
0 String
"low severe"
    Int64 -> Double -> String -> Criterion ()
check (Outliers -> Int64
lowMild Outliers
o) Double
1 String
"low mild"
    Int64 -> Double -> String -> Criterion ()
check (Outliers -> Int64
highMild Outliers
o) Double
1 String
"high mild"
    Int64 -> Double -> String -> Criterion ()
check (Outliers -> Int64
highSevere Outliers
o) Double
0 String
"high severe"