abichat/evabic

Evaluation of Binary Classifiers

evabic

evabic aims to evaluate binary classifiers by specifying what is detected as true and what is actually true. It has no dependencies.

Installation

You can install the development version from GitHub with:

# install.packages("remotes")
remotes::install_github("abichat/evabic")

Measures

evabic provides handy functions to compute 18 different measures. Each function begins with ebc_*.

Available measures include True Positive Rate (Sensitivity or Recall), True Negative Rate (Specificity), Positive Predictive Value (Precision), False Discovery Rate, Accuracy, F1…

evabic::ebc_allmeasures
#>  [1] "TP"   "FP"   "FN"   "TN"   "TPR"  "TNR"  "PPV"  "NPV"  "FNR"  "FPR"  "FDR" 
#> [12] "FOR"  "ACC"  "BACC" "F1"   "PLR"  "NLR"  "DOR"

All measures are computed from the confusion matrix:

Example

Let’s use evabic on a toy example.

library(evabic)

Consider three variables X1, X2 and X3, Y a variable predicted by this three variables, and 4 more conditionally independent variables X4 to X7.

set.seed(42)
X1 <- rnorm(50)
X2 <- rnorm(50)
X3 <- rnorm(50)
predictors <- paste0("X", 1:3)

df_lm <- data.frame(X1 = X1, X2 = X2, X3 = X3, 
                    X4 = X1 + X2 + X3 + rnorm(50, sd = 0.5),
                    X5 = X1 + 3 * X3 + rnorm(50, sd = 0.5),
                    X6 = X2 - 2 * X3 + rnorm(50, sd = 0.5),
                    X7 = X1 - 0.2 * X2 + rnorm(50, sd = 2),
                    Y  = X1 - 0.2 * X2 + 3 * X3 + rnorm(50))

We use a linear regression to detect the actual predictors (do not select significant variables like this at home, it’s a bad way to do so).

model <- lm(Y ~ ., data = df_lm)
summary(model)
#> 
#> Call:
#> lm(formula = Y ~ ., data = df_lm)
#> 
#> Residuals:
#>      Min       1Q   Median       3Q      Max 
#> -1.66504 -0.65784 -0.05977  0.51720  2.14833 
#> 
#> Coefficients:
#>             Estimate Std. Error t value Pr(>|t|)   
#> (Intercept)  0.13537    0.14528   0.932  0.35678   
#> X1           1.35385    0.44929   3.013  0.00437 **
#> X2           0.09974    0.46105   0.216  0.82977   
#> X3           3.67893    1.18759   3.098  0.00347 **
#> X4          -0.22998    0.33164  -0.693  0.49183   
#> X5          -0.17073    0.30744  -0.555  0.58161   
#> X6          -0.04023    0.28381  -0.142  0.88795   
#> X7           0.07055    0.09245   0.763  0.44966   
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 1.005 on 42 degrees of freedom
#> Multiple R-squared:  0.921,  Adjusted R-squared:  0.9079 
#> F-statistic: 69.99 on 7 and 42 DF,  p-value: < 2.2e-16
pvalues <- summary(model)$coefficients[-1, 4]
pvalues
#>          X1          X2          X3          X4          X5          X6 
#> 0.004366456 0.829771754 0.003469737 0.491828466 0.581608670 0.887948400 
#>          X7 
#> 0.449664443
detected_var <- names(pvalues[pvalues < 0.05])
detected_var
#> [1] "X1" "X3"

Here, we selected two predictors among the three true predictors.

Single measures are available with ebc_*() functions.

ebc_TPR(detected = detected_var, true = predictors)
#> [1] 0.6666667
ebc_ACC(detected = detected_var, true = predictors, m = 7) # the total size of the set is 7
#> [1] 0.8571429

You can also ask for several measures in a single row summary format with ebc_tidy().

ebc_tidy(detected = detected_var, true = predictors, m = 7, 
         # you can use `measures = ebc_allmeasures` to compute all measures
         measures = c("TPR", "TNR", "FDR", "ACC", "BACC", "F1")) 
#>         TPR TNR FDR       ACC      BACC  F1
#> 1 0.6666667   1   0 0.8571429 0.8333333 0.8

Note that evabic also supports named logicals for detected and true arguments, but they must be named (see the add_names() function if needed).

pvalues < 0.05
#>    X1    X2    X3    X4    X5    X6    X7 
#>  TRUE FALSE  TRUE FALSE FALSE FALSE FALSE
ebc_tidy(detected = pvalues < 0.05, true = predictors, m = 7, 
         measures = c("TPR", "TNR", "FDR", "ACC", "BACC", "F1"))
#>         TPR TNR FDR       ACC      BACC  F1
#> 1 0.6666667   1   0 0.8571429 0.8333333 0.8

With ebc_tidy_by_threshold(), you can ask for the evolution of measures according to a moving threshold if you provide the vector of p-values (or any score).

df_measures <- ebc_tidy_by_threshold(detection_values = pvalues, true = predictors, m = 7, 
                                     measures = c("TPR", "FPR", "FDR", "ACC", "BACC", "F1"))
df_measures
#>     threshold       TPR  FPR       FDR       ACC      BACC        F1
#> 1 0.003469737 0.0000000 0.00       NaN 0.5714286 0.5000000 0.0000000
#> 2 0.004366456 0.3333333 0.00 0.0000000 0.7142857 0.6666667 0.5000000
#> 3 0.449664443 0.6666667 0.00 0.0000000 0.8571429 0.8333333 0.8000000
#> 4 0.491828466 0.6666667 0.25 0.3333333 0.7142857 0.7083333 0.6666667
#> 5 0.581608670 0.6666667 0.50 0.5000000 0.5714286 0.5833333 0.5714286
#> 6 0.829771754 0.6666667 0.75 0.6000000 0.4285714 0.4583333 0.5000000
#> 7 0.887948400 1.0000000 0.75 0.5000000 0.5714286 0.6250000 0.6666667
#> 8         Inf 1.0000000 1.00 0.5714286 0.4285714 0.5000000 0.6000000

This makes it easy to plot various-threshold curves like ROC curve.

plot(df_measures$FPR, df_measures$TPR, type = "b", xlab = "FPR", ylab = "TPR")

And finally, you can ask for the AUC, the area under the ROC curve.

ebc_AUC(detection_values = pvalues, true = predictors, m = 7)
#> [1] 0.75
ebc_AUC_from_measures(df_measures)
#> [1] 0.75

evabic's Issues

ebc_tidy() fails when detected and true are unnamed logical vectors

library(evabic)
ebc_tidy(detected = c(T, T, F), true = c(T, F, T), all = letters[1:3])

(plus ebc_tidy() depends on the argument all only through m)

A simple fix would to rewrite n2lc() as

function (x, all) 
{
    if (is.logical(x)) {
        if (!is.null(names(x))) {
        return(names(x)[x])
        } else {
        return(all[x]) ## Assumes all and x elements are in the same order but without name information, that's reasonable
       }
    }
    else {
        return(x)
    }
}

Add documentation for the different metrics

Add somewhere in the documentation the definition of each computed metric (a link to the wikipedia page would be a good start)

Add support for named boolean vectors

Add support for named boolean vectors as detected argument for all ebc_* function. As a nice side effect, it would allow all the functions to compute m automatically

AUC negative when direction = ">"

Hey,

It's not a big issue, but I got a negative AUC while trying to use ebc_AUC with the parameter direction = ">".
A minimal example would be, with your example from the README :
ebc_AUC(detection_values = 1-pvalues, true = predictors, m = 7, direction = ">")

Merci pour le package, qui m'a été utile !
Benoit

`ebc_tidy_by_threshold()` is very slow for large vectors

library(evabic)
library(magrittr)

set.seed(1)
n <- 10000
fake_data <- data.frame(name        = paste("species", 1:n, sep = "_"), 
                        value       = (1:n)/n, 
                        true_status = sample(c(T, F), size = n, replace = T))

## Appel à ebc_tidy_by_threshold pour calculer l'AUC (rapide jusqu'à n = 1000)
tictoc::tic()
run_1 <- ebc_tidy_by_threshold(detection_values = with(fake_data, setNames(value, name)), 
                              true              = with(fake_data, name[true_status]), 
                              all               = with(fake_data, name),
                              measures          = c('TPR', "FPR", "FDR"), 
                              direction         = "<=")
tictoc::toc() ## 49.75 s

## méthode directe sans passer par ebc_tidy
## Prototypée uniquement pour direction = "<" et measures = c('TPR', "FPR", "FDR") mais s'adapte facilement aux autres cas
## Par flemme, j'utilise quelques fonctions de dplyr mais ce n'est pas strictement nécessaire et je ne reprend pas le préprocessing
my_ebc_tidy_by_threshold <- function(detection_values, true, all) {
  N <- length(detection_values)
  N_true <- length(true)
  d <- data.frame(
    ID        = names(detection_values), 
    threshold = detection_values, 
    status    = names(detection_values) %in% true
  ) %>% 
    ## Sort the data to compute TP / FP / FN / TN iteratively
    dplyr::arrange(threshold)  %>% ## desc(threshold) si direction = ">" ou ">!"
    dplyr::mutate(TP  = cumsum(status),          ## Number of TP when using the current threshold, ajouter -1 si direction = "<" au lieu de "<="
                  FP  = 1:N - TP,                ## Number of FP when using the current threshold
                  FN  = N_true - TP,             ## Number of FN when using the current threshold
                  TN  = N - TP - FP - FN,        ## Number of TN when using the current threshold
                  FDR = FP / pmax((FP + TP), 1),
                  TPR = TP / (TP + FN),          ## Recall / sensitivity
                  FPR = FP / (TN + FP)           ## 1 - specificity
    )
  ## Rajouter du code si on demande d'autres mesures
  ## Remove rows corresponding to duplicate scores by keeping only the last one (use rev twice to keep last one instead of first one)
  rows_to_exclude <- d$threshold %>% rev() %>% duplicated() %>% rev()
  d <- d[!rows_to_exclude, ]
  d
}

tictoc::tic()
run_2 <- my_ebc_tidy_by_threshold(detection_values = with(fake_data, setNames(value, name)), 
                                  true              = with(fake_data, name[true_status]), 
                                  all               = with(fake_data, name))
tictoc::toc() # 0.043 s

Probably because there's a lot a useless computation going on when using lapply and computing many related quantities. The prototype my_ebc_tidy_by_threshold() is a proof of concept for a faster implementation that computes basic quantities (TP, TN, FP, FN) efficiently for each threshold by sorting the data and then computes derived metrics from TP, TN, FP, FN. It does not handle border cases yet, i.e. when computing AUC, one should add c(0, 0) and c(1, 1) to c(TPR, FPR), but it's much faster.