R Under development (unstable) (2024-10-14 r87233 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(qwraps2)
> ################################################################################
> df <-
+   data.frame(
+       truth = c(1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0)
+     , pred  = c(1, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0, 0)
+   )
> 
> TP <- with(df, sum(truth == 1 & pred == 1))
> TN <- with(df, sum(truth == 0 & pred == 0))
> FP <- with(df, sum(truth == 0 & pred == 1))
> FN <- with(df, sum(truth == 1 & pred == 0))
> 
> cmat <- confusion_matrix(df$truth, df$pred, thresholds = 1)$cm_stats
> stopifnot(nrow(cmat) == 3L)
> stopifnot(cmat[is.finite(cmat$threshold), "TP"] == TP)
> stopifnot(cmat[is.finite(cmat$threshold), "TN"] == TN)
> stopifnot(cmat[is.finite(cmat$threshold), "FP"] == FP)
> stopifnot(cmat[is.finite(cmat$threshold), "FN"] == FN)
> 
> ################################################################################
> set.seed(42)
> test  <- c(rep(1, 53), rep(0, 47))
> truth <- c(rep(1, 20), rep(0, 33), rep(1, 10), rep(0, 37))
> 
> # S3 versions give same results, save for the call element
> cm1 <- confusion_matrix(truth, test)
> cm2 <- confusion_matrix(truth ~ test)
> stopifnot(all.equal(cm1, cm2, check.attributes = FALSE))
> 
> con_mat <- confusion_matrix(truth = truth, predicted = test, thresholds = NULL)
> 
> # check names, if this fails and is due to a change in the code, make sure the
> # documentation for the return of confusion_matrix has been updated.
> stopifnot(
+   names(con_mat) == c("cm_stats", "auroc", "auroc_ci", "auprc", "auprc_ci", "confint_method", "alpha", "prevalence")
+ )
> 
> # check names of cm_stats
> stopifnot(
+   names(con_mat$cm_stats) == c("threshold", "TP", "TN", "FP", "FN"
+                                , "sensitivity", "sensitivity_lcl", "sensitivity_ucl"
+                                , "specificity", "specificity_lcl", "specificity_ucl"
+                                , "ppv", "ppv_lcl", "ppv_ucl"
+                                , "npv", "npv_lcl", "npv_ucl"
+                                , "accuracy", "accuracy_lcl", "accuracy_ucl"
+                                , "youden"
+                                , "mcc"
+                                , "f1")
+ )
> 
> # Counts are as expected
> stopifnot(con_mat[["cm_stats"]][["TP"]] == c(30, 30, 20, 0),
+           con_mat[["cm_stats"]][["TN"]] == c(0, 0, 37, 70),
+           con_mat[["cm_stats"]][["FP"]] == c(70, 70, 33, 0),
+           con_mat[["cm_stats"]][["FN"]] == c(0, 0, 10, 30))
> 
> con_mat <- confusion_matrix(truth = truth, predicted = test, thresholds = 1)
> stopifnot(con_mat[["cm_stats"]][is.finite(con_mat$cm_stats$threshold), ][["TP"]] == 20,
+           con_mat[["cm_stats"]][is.finite(con_mat$cm_stats$threshold), ][["TN"]] == 37,
+           con_mat[["cm_stats"]][is.finite(con_mat$cm_stats$threshold), ][["FP"]] == 33,
+           con_mat[["cm_stats"]][is.finite(con_mat$cm_stats$threshold), ][["FN"]] == 10)
> 
> # Check Statistics
> stopifnot(con_mat[["cm_stats"]][is.finite(con_mat$cm_stats$threshold), ][["sensitivity"]] == 20 / 30)
> stopifnot(con_mat[["cm_stats"]][is.finite(con_mat$cm_stats$threshold), ][["specificity"]] == 37 / 70)
> stopifnot(con_mat[["cm_stats"]][is.finite(con_mat$cm_stats$threshold), ][["ppv"]] == 20 / 53)
> stopifnot(con_mat[["cm_stats"]][is.finite(con_mat$cm_stats$threshold), ][["npv"]] == 37 / 47)
> 
> # errors if non-binomial fit is passed
> fit <- glm(mpg > 20 ~ wt, data = mtcars)
> test <- tryCatch(confusion_matrix(fit), error = function(e) e)
> stopifnot(!is.null(test))
> stopifnot(inherits(test, "error"))
> 
> proc.time()
   user  system elapsed 
   0.23    0.04    0.26