Skip to content

Commit

Permalink
add test
Browse files Browse the repository at this point in the history
  • Loading branch information
strengejacke committed Dec 29, 2024
1 parent b0304cf commit be50727
Show file tree
Hide file tree
Showing 5 changed files with 33 additions and 5 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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",
Expand Down
2 changes: 1 addition & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -25,8 +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.double,performance_roc)
S3method(as.numeric,check_outliers)
S3method(as.numeric,performance_roc)
S3method(check_autocorrelation,default)
S3method(check_collinearity,BFBayesFactor)
S3method(check_collinearity,MixMod)
Expand Down
5 changes: 5 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions R/performance_roc.R
Original file line number Diff line number Diff line change
Expand Up @@ -124,15 +124,15 @@ print.performance_roc <- function(x, ...) {


#' @export
as.numeric.performance_roc <- function(x, ...) {
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 <- c()
auc <- numeric(length(dat))
for (i in seq_along(dat)) {
auc <- c(auc, bayestestR::area_under_curve(dat[[i]]$Specificity, dat[[i]]$Sensitivity))
auc[i] <- bayestestR::area_under_curve(dat[[i]]$Specificity, dat[[i]]$Sensitivity)
}
}
auc
Expand Down
23 changes: 23 additions & 0 deletions tests/testthat/test-performance_roc.R
Original file line number Diff line number Diff line change
@@ -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)
Expand All @@ -14,6 +16,7 @@ test_that("performance_roc", {
)
})


test_that("performance_roc", {
set.seed(123)
d <- iris[sample(1:nrow(iris), size = 50), ]
Expand All @@ -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
)
})

0 comments on commit be50727

Please sign in to comment.