From 413d85b3f9b76456cea79cc1b1f5537e53726b17 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 13 Jul 2024 22:54:01 +0200 Subject: [PATCH] Confidence intervals for ICC, it seems that none of the `ci_method`s work (neither default, `boot` or `analytical`). (#747) --- DESCRIPTION | 8 ++++---- R/check_distribution.R | 14 ++++++------- R/check_homogeneity.R | 2 +- R/helpers.R | 2 +- R/icc.R | 33 +++++++++++++++++++++---------- R/r2_bayes.R | 2 +- R/r2_nakagawa.R | 22 ++++++++++++++------- tests/testthat/test-helpers.R | 2 +- tests/testthat/test-r2_nakagawa.R | 1 + 9 files changed, 54 insertions(+), 32 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3807dda9c..8ea3d81df 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: performance Title: Assessment of Regression Models Performance -Version: 0.12.0.8 +Version: 0.12.0.9 Authors@R: c(person(given = "Daniel", family = "Lüdecke", @@ -70,8 +70,8 @@ Depends: R (>= 3.6) Imports: bayestestR (>= 0.13.2), - insight (>= 0.20.1), - datawizard (>= 0.11.0), + insight (>= 0.20.2), + datawizard (>= 0.10.0), stats, utils Suggests: @@ -131,6 +131,7 @@ Suggests: quantreg, qqplotr (>= 0.0.6), randomForest, + RcppEigen, rempsyc, rmarkdown, rstanarm, @@ -154,4 +155,3 @@ Config/Needs/website: r-lib/pkgdown, easystats/easystatstemplate Config/rcmdcheck/ignore-inconsequential-notes: true -Remotes: easystats/insight diff --git a/R/check_distribution.R b/R/check_distribution.R index fe26f0f4c..d743b3ac1 100644 --- a/R/check_distribution.R +++ b/R/check_distribution.R @@ -191,25 +191,25 @@ check_distribution.numeric <- function(model) { # validation check, remove missings x <- x[!is.na(x)] - mode <- NULL + mode_value <- NULL # find mode for integer, or MAP for distributions if (all(.is_integer(x))) { - mode <- datawizard::distribution_mode(x) + mode_value <- datawizard::distribution_mode(x) } else { # this might fail, so we wrap in ".safe()" - mode <- tryCatch( + mode_value <- tryCatch( as.numeric(bayestestR::map_estimate(x, bw = "nrd0")), error = function(e) NULL ) - if (is.null(mode)) { - mode <- tryCatch( + if (is.null(mode_value)) { + mode_value <- tryCatch( as.numeric(bayestestR::map_estimate(x, bw = "kernel")), error = function(e) NULL ) } } - if (is.null(mode)) { + if (is.null(mode_value)) { mean_mode_diff <- mean(x) - datawizard::distribution_mode(x) msg <- "Could not accurately estimate the mode." if (!is.null(type)) { @@ -217,7 +217,7 @@ check_distribution.numeric <- function(model) { } insight::format_alert(msg) } else { - mean_mode_diff <- .safe(mean(x) - mode) + mean_mode_diff <- .safe(mean(x) - mode_value) } data.frame( diff --git a/R/check_homogeneity.R b/R/check_homogeneity.R index 76d73bc19..d6b486810 100644 --- a/R/check_homogeneity.R +++ b/R/check_homogeneity.R @@ -165,7 +165,7 @@ check_homogeneity.afex_aov <- function(x, method = "levene", ...) { between <- between[!is_covar] } - form <- stats::formula(paste0(dv, "~", paste0(between, collapse = "*"))) + form <- stats::formula(paste0(dv, "~", paste(between, collapse = "*"))) test <- car::leveneTest(form, ag_data, center = mean, ...) p.val <- test[1, "Pr(>F)"] diff --git a/R/helpers.R b/R/helpers.R index c231d6226..09b211678 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -1,6 +1,6 @@ # small wrapper around this commonly used try-catch .safe <- function(code, on_error = NULL) { - if (getOption("easystats_erros", FALSE) && is.null(on_error)) { + if (isTRUE(getOption("easystats_errors", FALSE) && is.null(on_error))) { code } else { tryCatch(code, error = function(e) on_error) diff --git a/R/icc.R b/R/icc.R index 52117bc4a..420893f1e 100644 --- a/R/icc.R +++ b/R/icc.R @@ -249,7 +249,12 @@ icc <- function(model, # iccs between groups # n_grps <- length(vars$var.intercept) # level_combinations <- utils::combn(1:n_grps, m = n_grps - 1, simplify = FALSE) - # icc_grp <- sapply(level_combinations, function(v) vars$var.intercept[v[1]] / (vars$var.intercept[v[1]] + vars$var.intercept[v[2]])) + # icc_grp <- sapply( + # level_combinations, + # function(v) { + # vars$var.intercept[v[1]] / (vars$var.intercept[v[1]] + vars$var.intercept[v[2]]) + # } + # ) # # out2 <- data.frame( # Group1 = group_names[sapply(level_combinations, function(i) i[1])], @@ -275,11 +280,11 @@ icc <- function(model, # this is experimental! if (identical(ci_method, "analytical")) { result <- .safe(.analytical_icc_ci(model, ci)) - if (!is.null(result)) { + if (is.null(result)) { + icc_ci_adjusted <- icc_ci_unadjusted <- NA + } else { icc_ci_adjusted <- result$ICC_adjusted icc_ci_unadjusted <- result$ICC_unadjusted - } else { - icc_ci_adjusted <- icc_ci_unadjusted <- NA } } else { result <- .bootstrap_icc(model, iterations, tolerance, ci_method, ...) @@ -428,7 +433,7 @@ print.icc <- function(x, digits = 3, ...) { } # separate lines for multiple R2 - out <- paste0(out, collapse = "\n") + out <- paste(out, collapse = "\n") cat(out) cat("\n") @@ -591,7 +596,11 @@ print.icc_decomposed <- function(x, digits = 2, ...) { .boot_icc_fun <- function(data, indices, model, tolerance) { d <- data[indices, ] # allows boot to select sample fit <- suppressWarnings(suppressMessages(stats::update(model, data = d))) - vars <- .compute_random_vars(fit, tolerance, verbose = FALSE) + vars <- .compute_random_vars( + fit, + tolerance, + verbose = isTRUE(getOption("easystats_errors", FALSE)) + ) if (is.null(vars) || all(is.na(vars))) { return(c(NA, NA)) } @@ -604,7 +613,11 @@ print.icc_decomposed <- function(x, digits = 2, ...) { # bootstrapping using "lme4::bootMer" .boot_icc_fun_lme4 <- function(model) { - vars <- .compute_random_vars(model, tolerance = 1e-05, verbose = FALSE) + vars <- .compute_random_vars( + model, + tolerance = 1e-10, + verbose = isTRUE(getOption("easystats_errors", FALSE)) + ) if (is.null(vars) || all(is.na(vars))) { return(c(NA, NA)) } @@ -685,10 +698,10 @@ print.icc_decomposed <- function(x, digits = 2, ...) { } model_rank <- tryCatch( - if (!is.null(model$rank)) { - model$rank - df_int - } else { + if (is.null(model$rank)) { insight::n_parameters(model) - df_int + } else { + model$rank - df_int }, error = function(e) insight::n_parameters(model) - df_int ) diff --git a/R/r2_bayes.R b/R/r2_bayes.R index 098d0e21d..f96e98b41 100644 --- a/R/r2_bayes.R +++ b/R/r2_bayes.R @@ -31,7 +31,7 @@ #' `r2_posterior()` is the actual workhorse for `r2_bayes()` and returns a #' posterior sample of Bayesian R2 values. #' -#' @examplesIf require("rstanarm") && require("rstantools") && require("brms") +#' @examplesIf require("rstanarm") && require("rstantools") && require("brms") && require("RcppEigen") #' library(performance) #' \donttest{ #' model <- suppressWarnings(rstanarm::stan_glm( diff --git a/R/r2_nakagawa.R b/R/r2_nakagawa.R index 59d4d1906..dfa1eb6dc 100644 --- a/R/r2_nakagawa.R +++ b/R/r2_nakagawa.R @@ -154,7 +154,7 @@ r2_nakagawa <- function(model, if (insight::is_empty_object(vars$var.random) || is.na(vars$var.random)) { if (verbose) { # if no random effect variance, return simple R2 - insight::print_color("Random effect variances not available. Returned R2 does not account for random effects.\n", "red") + insight::print_color("Random effect variances not available. Returned R2 does not account for random effects.\n", "red") # nolint } r2_marginal <- vars$var.fixed / (vars$var.fixed + vars$var.residual) r2_conditional <- NA @@ -172,11 +172,11 @@ r2_nakagawa <- function(model, # this is experimental! if (identical(ci_method, "analytical")) { result <- .safe(.analytical_icc_ci(model, ci, fun = "r2_nakagawa")) - if (!is.null(result)) { + if (is.null(result)) { + r2_ci_marginal <- r2_ci_conditional <- NA + } else { r2_ci_marginal <- result$R2_marginal r2_ci_conditional <- result$R2_conditional - } else { - r2_ci_marginal <- r2_ci_conditional <- NA } } else { result <- .bootstrap_r2_nakagawa(model, iterations, tolerance, ci_method, ...) @@ -266,7 +266,7 @@ print.r2_nakagawa <- function(x, digits = 3, ...) { } # separate lines for multiple R2 - out <- paste0(out, collapse = "\n") + out <- paste(out, collapse = "\n") cat(out) cat("\n") @@ -281,7 +281,11 @@ print.r2_nakagawa <- function(x, digits = 3, ...) { .boot_r2_fun <- function(data, indices, model, tolerance) { d <- data[indices, ] # allows boot to select sample fit <- suppressWarnings(suppressMessages(stats::update(model, data = d))) - vars <- .compute_random_vars(fit, tolerance, verbose = FALSE) + vars <- .compute_random_vars( + fit, + tolerance, + verbose = isTRUE(getOption("easystats_errors", FALSE)) + ) if (is.null(vars) || all(is.na(vars))) { return(c(NA, NA)) } @@ -298,7 +302,11 @@ print.r2_nakagawa <- function(x, digits = 3, ...) { # bootstrapping using "lme4::bootMer" .boot_r2_fun_lme4 <- function(model) { - vars <- .compute_random_vars(model, tolerance = 1e-05, verbose = FALSE) + vars <- .compute_random_vars( + model, + tolerance = 1e-10, + verbose = isTRUE(getOption("easystats_errors", FALSE)) + ) if (is.null(vars) || all(is.na(vars))) { return(c(NA, NA)) } diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R index d1d6a5545..91b09db34 100644 --- a/tests/testthat/test-helpers.R +++ b/tests/testthat/test-helpers.R @@ -1,7 +1,7 @@ skip_on_cran() skip_if_not_installed("withr") withr::with_options( - list(easystats_erros = TRUE), + list(easystats_errors = TRUE), test_that(".safe works with options", { expect_error(performance:::.safe(mean(fd)), regex = "object 'fd' not found") expect_identical(performance:::.safe(mean(fd), 1L), 1L) diff --git a/tests/testthat/test-r2_nakagawa.R b/tests/testthat/test-r2_nakagawa.R index 541109944..12ea23f00 100644 --- a/tests/testthat/test-r2_nakagawa.R +++ b/tests/testthat/test-r2_nakagawa.R @@ -1,3 +1,4 @@ +skip_on_os("mac") skip_if_not_installed("lme4") model <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)