From ac1e372ae0c7ef1d5ba5cf1463052de716c422f4 Mon Sep 17 00:00:00 2001
From: Dominique Makowski <dom.mak19@gmail.com>
Date: Thu, 14 Nov 2024 13:58:43 +0000
Subject: [PATCH] add as.numeric method

---
 NAMESPACE              |  1 +
 R/performance_roc.R    | 16 ++++++++++++++++
 man/performance_roc.Rd | 12 ++++++++++++
 3 files changed, 29 insertions(+)

diff --git a/NAMESPACE b/NAMESPACE
index d35d82547..f3c9e008a 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -26,6 +26,7 @@ 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.numeric,performance_roc)
 S3method(check_autocorrelation,default)
 S3method(check_collinearity,BFBayesFactor)
 S3method(check_collinearity,MixMod)
diff --git a/R/performance_roc.R b/R/performance_roc.R
index 78be71a6b..8a22bfb6c 100644
--- a/R/performance_roc.R
+++ b/R/performance_roc.R
@@ -42,6 +42,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)
@@ -118,6 +119,21 @@ print.performance_roc <- function(x, ...) {
 }
 
 
+#' @export
+as.numeric.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 <- c()
+    for (i in seq_along(dat)) {
+      auc <- c(auc, bayestestR::area_under_curve(dat[[i]]$Specificity, dat[[i]]$Sensitivity))
+    }
+  }
+  auc
+}
+
 
 # utilities ---------------------------
 
diff --git a/man/performance_roc.Rd b/man/performance_roc.Rd
index e14ef04c9..ac6501015 100644
--- a/man/performance_roc.Rd
+++ b/man/performance_roc.Rd
@@ -28,6 +28,17 @@ model name.
 \description{
 This function calculates a simple ROC curves of x/y coordinates
 based on response and predictions of a binomial model.
+
+It returns the area under the curve (AUC) as a percentage, which corresponds
+to the probability that a randomly chosen observation of "condition 1" is correctly
+classified by the model as having a higher probability of being "condition 1" than
+a randomly chosen "condition 2" observation.
+
+Applying \code{as.data.frame()} to the ouput returns a data frame containing the following:
+\itemize{
+\item \code{Sensitivity} (that actually corresponds to \code{1 - Specificity}): It is the False Positive Rate.
+\item \code{Sensitivity}: It is the True Positive Rate, which is the proportion of correctly classified "condition 1" observations.
+}
 }
 \note{
 There is also a \href{https://easystats.github.io/see/articles/performance.html}{\code{plot()}-method}
@@ -45,6 +56,7 @@ train_data <- iris[-folds, ]
 
 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)