From d54d85acd338cc6213bec5477435c0494544dbf0 Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 3 Apr 2024 08:24:00 +0200 Subject: [PATCH 01/10] Check_model in version 0.11.0 no longer produces qq plot residuals Fixes #708 --- DESCRIPTION | 2 +- NEWS.md | 5 +++++ R/check_model.R | 12 ++++++++++++ 3 files changed, 18 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5a71a6a24..5f75841d6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: performance Title: Assessment of Regression Models Performance -Version: 0.11.0.3 +Version: 0.11.0.4 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/NEWS.md b/NEWS.md index 71bc0b355..c94980743 100644 --- a/NEWS.md +++ b/NEWS.md @@ -15,6 +15,11 @@ the usual style as for other models and no longer returns plots from `bayesplot::pp_check()`. +## Bug fixes + +* `check_model()` now falls back on normal Q-Q plots when a model is not supported + by the DHARMa package and simulated residuals cannot be calculated. + # performance 0.11.0 ## New supported models diff --git a/R/check_model.R b/R/check_model.R index d9d54682a..fdcb9edac 100644 --- a/R/check_model.R +++ b/R/check_model.R @@ -213,6 +213,12 @@ check_model.default <- function(x, if (is.null(residual_type)) { residual_type <- ifelse(minfo$is_linear && !minfo$is_gam, "normal", "simulated") } + + # catch models/families not supported by DHARMa + if (minfo$family == "quasipoisson") { + residual_type <- "normal" + } + # set default for detrend if (missing(detrend)) { detrend <- residual_type == "normal" @@ -518,6 +524,12 @@ check_model.DHARMa <- check_model.performance_simres simulated = .safe(simulate_residuals(model, ...)), .diag_qq(model, model_info = model_info, verbose = verbose) ) + if (is.null(dat$QQ) && residual_type == "simulated") { + if (verbose) { + insight::format_alert("Cannot simulate residuals for this model. Using normal Q-Q plot instead.") + } + dat$QQ <- .diag_qq(model, model_info = model_info, verbose = verbose) + } } # homogeneity of variance -------------- From fc5d7cd0e6659f66d62a92f895b07c4de8353ffa Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 3 Apr 2024 08:31:02 +0200 Subject: [PATCH 02/10] also fix for linear --- R/check_model.R | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/R/check_model.R b/R/check_model.R index fdcb9edac..97ba155a5 100644 --- a/R/check_model.R +++ b/R/check_model.R @@ -214,8 +214,11 @@ check_model.default <- function(x, residual_type <- ifelse(minfo$is_linear && !minfo$is_gam, "normal", "simulated") } - # catch models/families not supported by DHARMa - if (minfo$family == "quasipoisson") { + # catch models/families not supported by DHARMa - we need to add more + # exceptions here as they appear, but for now, `check_model()` also + # automatically falls back to normal Q-Q plot for all models not supported + # by DHARMa + if (minfo$family %in% c("quasipoisson", "quasibinomial")) { residual_type <- "normal" } @@ -463,6 +466,13 @@ check_model.DHARMa <- check_model.performance_simres simulated = .safe(simulate_residuals(model, ...)), .diag_qq(model, model_info = model_info, verbose = verbose) ) + # sanity check - model supported by DHARMa? + if (is.null(dat$QQ) && residual_type == "simulated") { + if (verbose) { + insight::format_alert("Cannot simulate residuals for this model. Using normal Q-Q plot instead.") + } + dat$QQ <- .diag_qq(model, model_info = model_info, verbose = verbose) + } } # Random Effects Q-Q plot (normality of BLUPs) -------------- @@ -524,6 +534,7 @@ check_model.DHARMa <- check_model.performance_simres simulated = .safe(simulate_residuals(model, ...)), .diag_qq(model, model_info = model_info, verbose = verbose) ) + # sanity check - model supported by DHARMa? if (is.null(dat$QQ) && residual_type == "simulated") { if (verbose) { insight::format_alert("Cannot simulate residuals for this model. Using normal Q-Q plot instead.") From 380cfcdfe53bc21a67352067b5e6f6a19fdeaf9a Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 3 Apr 2024 08:41:59 +0200 Subject: [PATCH 03/10] wordlist --- inst/WORDLIST | 1 + 1 file changed, 1 insertion(+) diff --git a/inst/WORDLIST b/inst/WORDLIST index 617ca698f..d76f66cbb 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -25,6 +25,7 @@ Bollen's Bortz Breunig Breusch +BRM Bryk Bundock Burnham From e4409ef73c99a65c83de0db9931e13efa63afe1c Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 3 Apr 2024 09:09:56 +0200 Subject: [PATCH 04/10] check for DHARMa is already implemented, comes later --- R/check_model.R | 18 ++---------------- R/check_predictions.R | 2 +- R/cronbachs_alpha.R | 4 ++-- tests/testthat/test-check_model.R | 2 +- 4 files changed, 6 insertions(+), 20 deletions(-) diff --git a/R/check_model.R b/R/check_model.R index 97ba155a5..daa1255fc 100644 --- a/R/check_model.R +++ b/R/check_model.R @@ -251,8 +251,8 @@ check_model.default <- function(x, } # did Q-Q plot work with simulated residuals? - if (verbose && is.null(assumptions_data$QQ) && residual_type == "simulated") { - insight::format_warning(paste0( + if (is.null(assumptions_data$QQ) && residual_type == "simulated") { + insight::format_alert(paste0( "Cannot simulate residuals for models of class `", class(x)[1], "`. Please try `check_model(..., residual_type = \"normal\")` instead." @@ -466,13 +466,6 @@ check_model.DHARMa <- check_model.performance_simres simulated = .safe(simulate_residuals(model, ...)), .diag_qq(model, model_info = model_info, verbose = verbose) ) - # sanity check - model supported by DHARMa? - if (is.null(dat$QQ) && residual_type == "simulated") { - if (verbose) { - insight::format_alert("Cannot simulate residuals for this model. Using normal Q-Q plot instead.") - } - dat$QQ <- .diag_qq(model, model_info = model_info, verbose = verbose) - } } # Random Effects Q-Q plot (normality of BLUPs) -------------- @@ -534,13 +527,6 @@ check_model.DHARMa <- check_model.performance_simres simulated = .safe(simulate_residuals(model, ...)), .diag_qq(model, model_info = model_info, verbose = verbose) ) - # sanity check - model supported by DHARMa? - if (is.null(dat$QQ) && residual_type == "simulated") { - if (verbose) { - insight::format_alert("Cannot simulate residuals for this model. Using normal Q-Q plot instead.") - } - dat$QQ <- .diag_qq(model, model_info = model_info, verbose = verbose) - } } # homogeneity of variance -------------- diff --git a/R/check_predictions.R b/R/check_predictions.R index 3fff06ce3..682047b50 100644 --- a/R/check_predictions.R +++ b/R/check_predictions.R @@ -536,7 +536,7 @@ plot.performance_pp_check <- function(x, ...) { # validation check, for mixed models, where re.form = NULL (default) might fail if (is.null(out) && insight::is_mixed_model(object) && !isTRUE(is.na(re_formula))) { if (verbose) { - insight::format_warning( + insight::format_alert( paste0( "Failed to compute posterior predictive checks with `re_formula=", deparse(re_formula), diff --git a/R/cronbachs_alpha.R b/R/cronbachs_alpha.R index 6d4547b40..735641ccc 100644 --- a/R/cronbachs_alpha.R +++ b/R/cronbachs_alpha.R @@ -40,7 +40,7 @@ cronbachs_alpha.data.frame <- function(x, verbose = TRUE, ...) { # we need at least two columns for Cronach's Alpha if (is.null(ncol(.data)) || ncol(.data) < 2) { if (verbose) { - insight::format_warning("Too few columns in `x` to compute Cronbach's Alpha.") + insight::format_alert("Too few columns in `x` to compute Cronbach's Alpha.") } return(NULL) } @@ -68,7 +68,7 @@ cronbachs_alpha.parameters_pca <- function(x, verbose = TRUE, ...) { pca_data <- attr(x, "data") if (is.null(pca_data)) { if (verbose) { - insight::format_warning("Could not find data frame that was used for the PCA.") + insight::format_alert("Could not find data frame that was used for the PCA.") } return(NULL) } diff --git a/tests/testthat/test-check_model.R b/tests/testthat/test-check_model.R index 32a78e253..d3cf7b5c0 100644 --- a/tests/testthat/test-check_model.R +++ b/tests/testthat/test-check_model.R @@ -79,5 +79,5 @@ test_that("`check_model()` warnings for zero-infl", { art ~ fem + mar + kid5 + ment | kid5 + phd, data = bioChemists ) - expect_message(expect_warning(check_model(model, verbose = TRUE), regex = "Cannot simulate"), regex = "Homogeneity") + expect_message(expect_message(check_model(model, verbose = TRUE), regex = "Cannot simulate"), regex = "Homogeneity") }) From 77a500b6742d831be2008178aa4a03fa06537640 Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 3 Apr 2024 09:13:14 +0200 Subject: [PATCH 05/10] add test --- tests/testthat/test-check_model.R | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/tests/testthat/test-check_model.R b/tests/testthat/test-check_model.R index d3cf7b5c0..142e63753 100644 --- a/tests/testthat/test-check_model.R +++ b/tests/testthat/test-check_model.R @@ -81,3 +81,34 @@ test_that("`check_model()` warnings for zero-infl", { ) expect_message(expect_message(check_model(model, verbose = TRUE), regex = "Cannot simulate"), regex = "Homogeneity") }) + + +test_that("`check_model()` no warnings for quasipoisson", { + set.seed(250419) + + # Generate random x values + x <- rnorm( + n = 500, + mean = 5, + sd = 2 + ) + + # Generate y values y = 5x + e + y <- 5 * x + rnorm( + n = 500, + mean = 5, + sd = 2 + ) + + # Generate z as offset + z <- runif(500, min = 0, max = 6719) + + mock_data <- data.frame(x, y, z) |> + # both should be whole numbers since they're counts + datawizard::data_modify(y = round(y), z = round(z)) |> + datawizard::data_filter(!x < 0, !y < 0) + + # Run model + model1 <- glm(y ~ x + offset(log(z)), family = "quasipoisson", data = mock_data) + expect_message(check_model(model1, verbose = TRUE), regex = "Not enough") +}) From 27ab33a7c53a3ab125ef6be6944ff6571195682b Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 3 Apr 2024 09:13:39 +0200 Subject: [PATCH 06/10] test --- tests/testthat/test-check_model.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-check_model.R b/tests/testthat/test-check_model.R index 142e63753..d6c447d9e 100644 --- a/tests/testthat/test-check_model.R +++ b/tests/testthat/test-check_model.R @@ -111,4 +111,5 @@ test_that("`check_model()` no warnings for quasipoisson", { # Run model model1 <- glm(y ~ x + offset(log(z)), family = "quasipoisson", data = mock_data) expect_message(check_model(model1, verbose = TRUE), regex = "Not enough") + expect_silent(check_model(model1)) }) From 44ea2b92107e3db6d7f78b680313680554987700 Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 3 Apr 2024 09:14:08 +0200 Subject: [PATCH 07/10] test --- tests/testthat/test-check_model.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/tests/testthat/test-check_model.R b/tests/testthat/test-check_model.R index d6c447d9e..90db0a9e4 100644 --- a/tests/testthat/test-check_model.R +++ b/tests/testthat/test-check_model.R @@ -84,30 +84,26 @@ test_that("`check_model()` warnings for zero-infl", { test_that("`check_model()` no warnings for quasipoisson", { + skip_if_not_installed("datawizard") set.seed(250419) - # Generate random x values x <- rnorm( n = 500, mean = 5, sd = 2 ) - # Generate y values y = 5x + e y <- 5 * x + rnorm( n = 500, mean = 5, sd = 2 ) - # Generate z as offset z <- runif(500, min = 0, max = 6719) - mock_data <- data.frame(x, y, z) |> # both should be whole numbers since they're counts datawizard::data_modify(y = round(y), z = round(z)) |> datawizard::data_filter(!x < 0, !y < 0) - # Run model model1 <- glm(y ~ x + offset(log(z)), family = "quasipoisson", data = mock_data) expect_message(check_model(model1, verbose = TRUE), regex = "Not enough") From e8bb2f98d5b6dfc376fc841b864b550a27cda1b0 Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 3 Apr 2024 09:22:37 +0200 Subject: [PATCH 08/10] lintr --- R/check_homogeneity.R | 6 +++--- tests/testthat/test-check_model.R | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/check_homogeneity.R b/R/check_homogeneity.R index c3a839ab7..db79fa106 100644 --- a/R/check_homogeneity.R +++ b/R/check_homogeneity.R @@ -117,7 +117,7 @@ print.check_homogeneity <- function(x, ...) { } else if (x < 0.05) { insight::print_color(sprintf("Warning: Variances differ between groups (%s, p = %.3f).\n", method.string, x), "red") } else { - insight::print_color(sprintf("OK: There is not clear evidence for different variances across groups (%s, p = %.3f).\n", method.string, x), "green") + insight::print_color(sprintf("OK: There is not clear evidence for different variances across groups (%s, p = %.3f).\n", method.string, x), "green") # nolint } invisible(x) } @@ -146,13 +146,13 @@ check_homogeneity.afex_aov <- function(x, method = "levene", ...) { insight::format_error("Levene test is only aplicable to ANOVAs with between-subjects factors.") } - data <- x$data$long # Use this to also get id column + long_data <- x$data$long # Use this to also get id column dv <- attr(x, "dv") id <- attr(x, "id") between <- names(attr(x, "between")) is_covar <- vapply(attr(x, "between"), is.null, logical(1)) - ag_data <- stats::aggregate(data[, dv], data[, c(between, id)], mean) + ag_data <- stats::aggregate(long_data[, dv], long_data[, c(between, id)], mean) colnames(ag_data)[length(c(between, id)) + 1] <- dv if (any(is_covar)) { diff --git a/tests/testthat/test-check_model.R b/tests/testthat/test-check_model.R index 90db0a9e4..6543e5065 100644 --- a/tests/testthat/test-check_model.R +++ b/tests/testthat/test-check_model.R @@ -103,7 +103,7 @@ test_that("`check_model()` no warnings for quasipoisson", { mock_data <- data.frame(x, y, z) |> # both should be whole numbers since they're counts datawizard::data_modify(y = round(y), z = round(z)) |> - datawizard::data_filter(!x < 0, !y < 0) + datawizard::data_filter(x >= 0, y >= 0) # Run model model1 <- glm(y ~ x + offset(log(z)), family = "quasipoisson", data = mock_data) expect_message(check_model(model1, verbose = TRUE), regex = "Not enough") From 816ac64f988827b66ea39632c2c45ce09b35ab74 Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 3 Apr 2024 11:21:08 +0200 Subject: [PATCH 09/10] update test --- tests/testthat/test-cronbachs_alpha.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-cronbachs_alpha.R b/tests/testthat/test-cronbachs_alpha.R index d9a584bbb..e000a1365 100644 --- a/tests/testthat/test-cronbachs_alpha.R +++ b/tests/testthat/test-cronbachs_alpha.R @@ -4,7 +4,7 @@ test_that("cronbachs_alpha, data frame", { expect_equal(cronbachs_alpha(x), 0.09463206, tolerance = 1e-3) }) test_that("cronbachs_alpha", { - expect_warning(expect_null(cronbachs_alpha(mtcars[1]))) + expect_message(expect_null(cronbachs_alpha(mtcars[1])), regex = "Too few") }) @@ -12,7 +12,7 @@ test_that("cronbachs_alpha, principal_components", { skip_if_not_installed("parameters", minimum_version = "0.21.3") pca <- parameters::principal_components(mtcars[, c("cyl", "gear", "carb", "hp")], n = 2) expect_equal(cronbachs_alpha(pca, verbose = FALSE), c(PC1 = 0.1101384), tolerance = 1e-3) - expect_warning(cronbachs_alpha(pca)) + expect_message(cronbachs_alpha(pca), regex = "Too few") pca <- parameters::principal_components(mtcars[, c("cyl", "gear", "carb", "hp")], n = 1) expect_equal(cronbachs_alpha(pca, verbose = FALSE), c(PC1 = 0.09463206), tolerance = 1e-3) From 4491b247353f67146f814eeb219e9e331cbdab1d Mon Sep 17 00:00:00 2001 From: Daniel Date: Wed, 3 Apr 2024 11:37:07 +0200 Subject: [PATCH 10/10] style --- tests/testthat/test-cronbachs_alpha.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/testthat/test-cronbachs_alpha.R b/tests/testthat/test-cronbachs_alpha.R index e000a1365..ecf244745 100644 --- a/tests/testthat/test-cronbachs_alpha.R +++ b/tests/testthat/test-cronbachs_alpha.R @@ -3,11 +3,11 @@ test_that("cronbachs_alpha, data frame", { x <- mtcars[, c("cyl", "gear", "carb", "hp")] expect_equal(cronbachs_alpha(x), 0.09463206, tolerance = 1e-3) }) + test_that("cronbachs_alpha", { expect_message(expect_null(cronbachs_alpha(mtcars[1])), regex = "Too few") }) - test_that("cronbachs_alpha, principal_components", { skip_if_not_installed("parameters", minimum_version = "0.21.3") pca <- parameters::principal_components(mtcars[, c("cyl", "gear", "carb", "hp")], n = 2) @@ -25,7 +25,6 @@ test_that("cronbachs_alpha, principal_components", { expect_equal(cronbachs_alpha(pca), c(PC1 = 0.4396, PC2 = -1.44331), tolerance = 1e-3) }) - test_that("cronbachs_alpha, matrix", { m <- as.matrix(mtcars[c("cyl", "gear", "carb", "hp")]) expect_equal(cronbachs_alpha(m), 0.09463206, tolerance = 1e-3)