[docs] Details to performance_roc() (#777)

Co-authored-by: Daniel <[email protected]>

Author: DominiqueMakowski

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: performance
 Title: Assessment of Regression Models Performance
-Version: 0.12.4.15
+Version: 0.12.4.16
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

NAMESPACE

@@ -25,7 +25,8 @@ S3method(as.data.frame,performance_score)
 S3method(as.data.frame,r2_bayes)
 S3method(as.data.frame,r2_loo)
 S3method(as.data.frame,r2_nakagawa)
-S3method(as.numeric,check_outliers)
+S3method(as.double,check_outliers)
+S3method(as.double,performance_roc)
 S3method(check_autocorrelation,default)
 S3method(check_collinearity,BFBayesFactor)
 S3method(check_collinearity,MixMod)

NEWS.md

@@ -19,6 +19,11 @@
 * `r2()` and `r2_mcfadden()` now support beta-binomial (non-mixed) models from
   package *glmmTMB*.
 
+* An `as.numeric()` resp. `as.double()` method for objects of class
+  `performance_roc` was added.
+
+* Improved documentation for `performance_roc()`.
+
 ## Bug fixes
 
 * `check_outliers()` did not warn that no numeric variables were found when only

R/check_outliers.R

@@ -599,7 +599,7 @@ as.data.frame.check_outliers <- function(x, ...) {
 }
 
 #' @export
-as.numeric.check_outliers <- function(x, ...) {
+as.double.check_outliers <- function(x, ...) {
   attributes(x)$data$Outlier
 }
 

R/performance_roc.R

@@ -46,6 +46,7 @@
 #'
 #' model <- glm(y ~ Sepal.Length + Sepal.Width, data = train_data, family = "binomial")
 #' as.data.frame(performance_roc(model, new_data = test_data))
+#' as.numeric(performance_roc(model))
 #'
 #' roc <- performance_roc(model, new_data = test_data)
 #' area_under_curve(roc$Specificity, roc$Sensitivity)
@@ -122,6 +123,21 @@ print.performance_roc <- function(x, ...) {
 }
 
 
+#' @export
+as.double.performance_roc <- function(x, ...) {
+  if (length(unique(x$Model)) == 1) {
+    auc <- bayestestR::area_under_curve(x$Specificity, x$Sensitivity)
+  } else {
+    dat <- split(x, f = x$Model)
+
+    auc <- numeric(length(dat))
+    for (i in seq_along(dat)) {
+      auc[i] <- bayestestR::area_under_curve(dat[[i]]$Specificity, dat[[i]]$Sensitivity)
+    }
+  }
+  auc
+}
+
 
 # utilities ---------------------------
 
@@ -181,5 +197,5 @@ print.performance_roc <- function(x, ...) {
   if (inherits(x, "model_fit")) {
     x <- x$fit
   }
-  inherits(x, c("glm", "glmerMod", "logitor", "logitmfx", "probitmfx"))
+  inherits(x, c("glm", "glmerMod", "logitor", "logitmfx", "probitmfx", "glmmTMB"))
 }

man/performance_roc.Rd

@@ -406,3 +406,10 @@ test_that("check_outliers with DHARMa", {
     )
   )
 })
+
+
+test_that("check_outliers with DHARMa", {
+  data(mtcars)
+  out <- check_outliers(mtcars$mpg, method = "zscore", threshold = 2)
+  expect_equal(which(as.numeric(out) == 1), c(18, 20))
+})

tests/testthat/test-check_outliers.R

@@ -1,3 +1,5 @@
+skip_if_not_installed("bayestestR")
+
 test_that("performance_roc", {
   skip_if_not_installed("lme4")
   m <- lme4::glmer(vs ~ mpg + (1 | gear), family = "binomial", data = mtcars)
@@ -14,6 +16,7 @@ test_that("performance_roc", {
   )
 })
 
+
 test_that("performance_roc", {
   set.seed(123)
   d <- iris[sample(1:nrow(iris), size = 50), ]
@@ -40,3 +43,23 @@ test_that("performance_roc", {
     tolerance = 1e-3
   )
 })
+
+
+test_that("performance_roc, as.numeric", {
+  data(iris)
+  set.seed(123)
+  iris$y <- rbinom(nrow(iris), size = 1, .3)
+  folds <- sample(nrow(iris), size = nrow(iris) / 8, replace = FALSE)
+  test_data <- iris[folds, ]
+  train_data <- iris[-folds, ]
+
+  model <- glm(y ~ Sepal.Length + Sepal.Width, data = train_data, family = "binomial")
+  roc <- performance_roc(model)
+  out <- as.numeric(roc)
+  expect_equal(
+    out,
+    bayestestR::area_under_curve(roc$Specificity, roc$Sensitivity),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
+})