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)