From 2db192d27c1c0970191b01439803f55aa5c4ef8f Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 24 Jun 2022 09:32:56 +0200 Subject: [PATCH 01/21] allow to toggle CIs for random effects parameters --- R/extract_random_variances.R | 8 +++++++- R/methods_cplm.R | 4 +++- R/methods_glmmTMB.R | 3 ++- R/methods_lme4.R | 7 ++++++- R/methods_mjoint.R | 3 ++- R/methods_panelr.R | 7 +++++-- man/model_parameters.averaging.Rd | 1 + man/model_parameters.merMod.Rd | 27 ++++++++++++++++++++------- 8 files changed, 46 insertions(+), 14 deletions(-) diff --git a/R/extract_random_variances.R b/R/extract_random_variances.R index 86a963765..907582afb 100644 --- a/R/extract_random_variances.R +++ b/R/extract_random_variances.R @@ -11,6 +11,7 @@ effects = "random", component = "conditional", ci_method = NULL, + random_ci = TRUE, verbose = FALSE, ...) { out <- suppressWarnings( @@ -20,6 +21,7 @@ effects = effects, component = component, ci_method = ci_method, + random_ci = random_ci, verbose = verbose, ... ) @@ -43,6 +45,7 @@ effects = "random", component = "all", ci_method = NULL, + random_ci = TRUE, verbose = FALSE, ...) { component <- match.arg(component, choices = c("all", "conditional", "zero_inflated", "zi", "dispersion")) @@ -54,6 +57,7 @@ effects = effects, component = "conditional", ci_method = ci_method, + random_ci = random_ci, verbose = verbose, ... ) @@ -77,6 +81,7 @@ effects = effects, component = "zi", ci_method = ci_method, + random_ci = random_ci, verbose = FALSE, ... ) @@ -116,6 +121,7 @@ effects = "random", component = "conditional", ci_method = NULL, + random_ci = TRUE, verbose = FALSE, ...) { varcorr <- .get_variance_information(model, component) @@ -211,7 +217,7 @@ sigma_param <- out$Parameter == "SD (Observations)" # add confidence intervals? - if (!is.null(ci) && !all(is.na(ci)) && length(ci) == 1) { + if (!is.null(ci) && !all(is.na(ci)) && length(ci) == 1 && isTRUE(random_ci)) { out <- .random_sd_ci(model, out, ci_method, ci, corr_param, sigma_param, component, verbose = verbose) } diff --git a/R/methods_cplm.R b/R/methods_cplm.R index f45675346..e48776453 100644 --- a/R/methods_cplm.R +++ b/R/methods_cplm.R @@ -228,9 +228,10 @@ model_parameters.cpglmm <- function(model, exponentiate = FALSE, ci_method = NULL, p_adjust = NULL, + include_sigma = FALSE, + random_ci = TRUE, verbose = TRUE, df_method = ci_method, - include_sigma = FALSE, ...) { ## TODO remove later @@ -264,6 +265,7 @@ model_parameters.cpglmm <- function(model, group_level = group_level, ci_method = ci_method, include_sigma = include_sigma, + random_ci = random_ci, verbose = verbose, ... ) diff --git a/R/methods_glmmTMB.R b/R/methods_glmmTMB.R index b0b2bd0fe..5bd02f354 100644 --- a/R/methods_glmmTMB.R +++ b/R/methods_glmmTMB.R @@ -26,6 +26,7 @@ model_parameters.glmmTMB <- function(model, verbose = TRUE, df_method = ci_method, include_sigma = FALSE, + random_ci = TRUE, ...) { ## TODO remove later @@ -163,7 +164,7 @@ model_parameters.glmmTMB <- function(model, warning(insight::format_message("Cannot extract confidence intervals for random variance parameters from models with more than one grouping factor."), call. = FALSE) } } else { - params_variance <- .extract_random_variances(model, ci = ci, effects = effects, component = component, ci_method = ci_method, verbose = verbose) + params_variance <- .extract_random_variances(model, ci = ci, effects = effects, component = component, ci_method = ci_method, random_ci = random_ci, verbose = verbose) # remove redundant dispersion parameter if (isTRUE(dispersion_param) && !is.null(params) && !is.null(params$Component)) { disp <- which(params$Component == "dispersion") diff --git a/R/methods_lme4.R b/R/methods_lme4.R index 055bd4080..1dc85b197 100644 --- a/R/methods_lme4.R +++ b/R/methods_lme4.R @@ -22,6 +22,10 @@ #' variance and the variance for the additive overdispersion term (see #' [insight::get_variance()] for details). Defaults to `FALSE` for mixed models #' due to the longer computation time. +#' @param random_ci Logical, if `TRUE` (default), includes the confidence +#' intervals for random effects parameters. Only applies if `effects` is not +#' `"fixed"` and if `ci` is not `NULL`. Set `random_ci = FALSE` if computation +#' of the model summary is too much time consuming. #' @inheritParams model_parameters.default #' @inheritParams model_parameters.stanreg #' @@ -114,6 +118,7 @@ model_parameters.merMod <- function(model, include_sigma = FALSE, vcov = NULL, vcov_args = NULL, + random_ci = TRUE, ...) { dots <- list(...) @@ -212,7 +217,7 @@ model_parameters.merMod <- function(model, } if (effects %in% c("random", "all") && isFALSE(group_level)) { - params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = ci_method, verbose = verbose) + params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = ci_method, random_ci = random_ci, verbose = verbose) } # merge random and fixed effects, if necessary diff --git a/R/methods_mjoint.R b/R/methods_mjoint.R index d36efaf8c..c66241d7c 100644 --- a/R/methods_mjoint.R +++ b/R/methods_mjoint.R @@ -9,6 +9,7 @@ model_parameters.mjoint <- function(model, keep = NULL, drop = NULL, parameters = keep, + random_ci = TRUE, verbose = TRUE, ...) { effects <- match.arg(effects, choices = c("fixed", "random", "all")) @@ -36,7 +37,7 @@ model_parameters.mjoint <- function(model, } if (effects %in% c("random", "all")) { - params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = NULL, verbose = verbose) + params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = NULL, random_ci = random_ci, verbose = verbose) params_variance$Component <- "conditional" } diff --git a/R/methods_panelr.R b/R/methods_panelr.R index a9618d499..f6f3e04bd 100644 --- a/R/methods_panelr.R +++ b/R/methods_panelr.R @@ -13,8 +13,9 @@ model_parameters.wbm <- function(model, iterations = 1000, exponentiate = FALSE, p_adjust = NULL, - verbose = TRUE, include_sigma = FALSE, + random_ci = TRUE, + verbose = TRUE, ...) { effects <- match.arg(effects, choices = c("fixed", "random", "all")) @@ -31,6 +32,7 @@ model_parameters.wbm <- function(model, group_level = group_level, ci_method = NULL, include_sigma = include_sigma, + random_ci = random_ci, verbose = verbose, ... ) @@ -119,6 +121,7 @@ p_value.wbgee <- p_value.wbm group_level, ci_method, include_sigma = FALSE, + random_ci = TRUE, verbose = TRUE, ...) { params <- params_random <- params_variance <- att <- NULL @@ -148,7 +151,7 @@ p_value.wbgee <- p_value.wbm } if (effects %in% c("random", "all") && isFALSE(group_level)) { - params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = ci_method, verbose = verbose) + params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = ci_method, random_ci = random_ci, verbose = verbose) } diff --git a/man/model_parameters.averaging.Rd b/man/model_parameters.averaging.Rd index 829ff65b2..42cef58a5 100644 --- a/man/model_parameters.averaging.Rd +++ b/man/model_parameters.averaging.Rd @@ -467,6 +467,7 @@ keep = NULL, drop = NULL, parameters = keep, + random_ci = TRUE, verbose = TRUE, ... ) diff --git a/man/model_parameters.merMod.Rd b/man/model_parameters.merMod.Rd index 9c482ac4a..8e12bffba 100644 --- a/man/model_parameters.merMod.Rd +++ b/man/model_parameters.merMod.Rd @@ -29,9 +29,10 @@ exponentiate = FALSE, ci_method = NULL, p_adjust = NULL, + include_sigma = FALSE, + random_ci = TRUE, verbose = TRUE, df_method = ci_method, - include_sigma = FALSE, ... ) @@ -55,6 +56,7 @@ verbose = TRUE, df_method = ci_method, include_sigma = FALSE, + random_ci = TRUE, ... ) @@ -79,6 +81,7 @@ include_sigma = FALSE, vcov = NULL, vcov_args = NULL, + random_ci = TRUE, ... ) @@ -111,6 +114,7 @@ verbose = TRUE, df_method = ci_method, include_sigma = FALSE, + random_ci = TRUE, ... ) @@ -134,6 +138,7 @@ verbose = TRUE, df_method = ci_method, include_sigma = FALSE, + random_ci = TRUE, ... ) @@ -171,6 +176,7 @@ include_sigma = FALSE, vcov = NULL, vcov_args = NULL, + random_ci = TRUE, ... ) @@ -198,9 +204,10 @@ exponentiate = FALSE, ci_method = NULL, p_adjust = NULL, + include_sigma = FALSE, + random_ci = TRUE, verbose = TRUE, df_method = ci_method, - include_sigma = FALSE, ... ) @@ -215,9 +222,10 @@ exponentiate = FALSE, ci_method = NULL, p_adjust = NULL, + include_sigma = FALSE, + random_ci = TRUE, verbose = TRUE, df_method = ci_method, - include_sigma = FALSE, ... ) @@ -307,16 +315,21 @@ possible adjustment methods are \code{"tukey"}, \code{"scheffe"}, \code{"sidak"} and \code{"none"} to explicitly disable adjustment for \code{emmGrid} objects (from \strong{emmeans}).} -\item{verbose}{Toggle warnings and messages.} - -\item{df_method}{Deprecated. Please use \code{ci_method}.} - \item{include_sigma}{Logical, if \code{TRUE}, includes the residual standard deviation. For mixed models, this is defined as the sum of the distribution-specific variance and the variance for the additive overdispersion term (see \code{\link[insight:get_variance]{insight::get_variance()}} for details). Defaults to \code{FALSE} for mixed models due to the longer computation time.} +\item{random_ci}{Logical, if \code{TRUE} (default), includes the confidence +intervals for random effects parameters. Only applies if \code{effects} is not +\code{"fixed"} and if \code{ci} is not \code{NULL}. Set \code{random_ci = FALSE} if computation +of the model summary is too much time consuming.} + +\item{verbose}{Toggle warnings and messages.} + +\item{df_method}{Deprecated. Please use \code{ci_method}.} + \item{...}{Arguments passed to or from other methods.} \item{component}{Should all parameters, parameters for the conditional model, From bc5a97ce13dbe495449f2a673815d1f2f853a083 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 24 Jun 2022 09:34:18 +0200 Subject: [PATCH 02/21] Update NEWS.md --- NEWS.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NEWS.md b/NEWS.md index 73a0ba737..71954f098 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,6 +18,11 @@ * `model_parameters()` now also includes standard errors and confidence intervals for slope-slope-correlations of random effects variances. +* `model_parameters()` for mixed models gains a `random_ci` argument, to toggle + whether confidence intervals for random effects parameters should also be + computed. Set to `FALSE` if calculation of confidence intervals for random + effects parameters takes too long. + * `ci()` for *glmmTMB* models with `method = "profile"` is now more robust. ## Bug fixes From ecc3aea22b96775be9b6ea6e372da410df7763b5 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 24 Jun 2022 09:46:26 +0200 Subject: [PATCH 03/21] use updates std names --- DESCRIPTION | 2 +- R/methods_marginaleffects.R | 10 ++++------ 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 59587c6cf..ef6e2afcd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.18.1.4 +Version: 0.18.1.5 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/R/methods_marginaleffects.R b/R/methods_marginaleffects.R index 2d62c4e25..2370361ac 100644 --- a/R/methods_marginaleffects.R +++ b/R/methods_marginaleffects.R @@ -9,12 +9,10 @@ model_parameters.marginaleffects <- function(model, ci = .95, ...) { - out <- marginaleffects::tidy(model, conf_level = ci, ...) - - out <- datawizard::data_rename( - insight::standardize_names(out), - pattern = c("type", "value"), - replacement = c("Type", "Level")) + out <- insight::standardize_names( + marginaleffects::tidy(model, conf_level = ci, ...), + style = "easystats" + ) out <- tryCatch( .add_model_parameters_attributes(out, model, ci, ...), From 7b1336e3969fe06467db4e98d30b4dbd2cd7bef9 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 24 Jun 2022 13:11:19 +0200 Subject: [PATCH 04/21] column names --- R/standardize_parameters.R | 4 ++-- R/utils_format.R | 2 +- R/utils_model_parameters.R | 10 ++++++++-- 3 files changed, 11 insertions(+), 5 deletions(-) diff --git a/R/standardize_parameters.R b/R/standardize_parameters.R index 41ff8bd6b..03b8ae28d 100644 --- a/R/standardize_parameters.R +++ b/R/standardize_parameters.R @@ -209,11 +209,11 @@ standardize_parameters.default <- function(model, colnm <- c("Component", "Response", "Group", "Parameter", utils::head(.col_2_scale, -2), "CI", "CI_low", "CI_high") pars <- pars[, colnm[colnm %in% colnames(pars)]] - if (!is.null(coefficient_name) && coefficient_name %in% c("Odds Ratio", "Risk Ratio", "IRR")) { + if (!is.null(coefficient_name) && coefficient_name %in% c("Odds Ratio", "Risk Ratio", "IRR", "Prevalence Ratio")) { colnames(pars)[colnames(pars) == "Coefficient"] <- gsub(" ", "_", coefficient_name) } - i <- colnames(pars) %in% c("Coefficient", "Median", "Mean", "MAP", c("Odds_Ratio", "Risk_Ratio", "IRR")) + i <- colnames(pars) %in% c("Coefficient", "Median", "Mean", "MAP", "Odds_Ratio", "Risk_Ratio", "IRR", "Prevalence_Ratio") colnames(pars)[i] <- paste0("Std_", colnames(pars)[i]) ## SE attribute? diff --git a/R/utils_format.R b/R/utils_format.R index 5b12416f4..1fc6bdb13 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -152,7 +152,7 @@ # that contain the random effects or zero-inflated parameters .all_coefficient_types <- function() { - c("Odds Ratio", "Risk Ratio", "IRR", "Log-Odds", "Log-Mean", "Probability", "Marginal Means", "Estimated Counts", "Ratio") + c("Odds Ratio", "Risk Ratio", "Prevalence Ratio", "IRR", "Log-Odds", "Log-Mean", "Log-Ratio", "Log-Prevalence", "Probability", "Marginal Means", "Estimated Counts", "Ratio") } diff --git a/R/utils_model_parameters.R b/R/utils_model_parameters.R index d18ebaea5..ba10a84f9 100644 --- a/R/utils_model_parameters.R +++ b/R/utils_model_parameters.R @@ -243,7 +243,9 @@ } else if (!is.null(info)) { if (!info$family == "unknown") { if (isTRUE(exponentiate)) { - if ((info$is_binomial && info$is_logit) || info$is_ordinal || info$is_multinomial || info$is_categorical) { + if (info$is_exponential && identical(info$link_function, "log")) { + coef_col <- "Prevalence Ratio" + } else if ((info$is_binomial && info$is_logit) || info$is_ordinal || info$is_multinomial || info$is_categorical) { coef_col <- "Odds Ratio" } else if (info$is_binomial && !info$is_logit) { coef_col <- "Risk Ratio" @@ -251,8 +253,12 @@ coef_col <- "IRR" } } else { - if (info$is_binomial || info$is_ordinal || info$is_multinomial || info$is_categorical) { + if (info$is_exponential && identical(info$link_function, "log")) { + coef_col <- "Log-Prevalence" + } else if ((info$is_binomial && info$is_logit) || info$is_ordinal || info$is_multinomial || info$is_categorical) { coef_col <- "Log-Odds" + } else if (info$is_binomial && !info$is_logit) { + coef_col <- "Log-Risk" } else if (info$is_count) { coef_col <- "Log-Mean" } From e2226bf441890b33b5b09827a4797236f53307c4 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 24 Jun 2022 13:44:50 +0200 Subject: [PATCH 05/21] add test --- tests/testthat/test-model_parameters.glm.R | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/testthat/test-model_parameters.glm.R b/tests/testthat/test-model_parameters.glm.R index d6b2e1a8e..84d400e55 100644 --- a/tests/testthat/test-model_parameters.glm.R +++ b/tests/testthat/test-model_parameters.glm.R @@ -79,4 +79,23 @@ if (requiet("testthat") && requiet("parameters") && requiet("boot")) { params <- model_parameters(model, component = "conditional", effects = "fixed", verbose = FALSE) }) + + # test printing for prevalence ratios + clotting <- data.frame( + u = c(5,10,15,20,30,40,60,80,100), + lot1 = c(118,58,42,35,27,25,21,19,18), + lot2 = c(69,35,26,21,18,16,13,12,12)) + m <- glm(lot1 ~ log(u), data = clotting, family = Gamma("log")) + mp <- model_parameters(m, exponentiate = TRUE) + + test_that("model_parameters.glm - Gamma - print", { + expect_equal( + capture.output(mp), + c("Parameter | Prevalence Ratio | SE | 95% CI | t(7) | p", + "---------------------------------------------------------------------------", + "(Intercept) | 245.48 | 46.72 | [173.66, 351.67] | 28.92 | < .001", + "u [log] | 0.55 | 0.03 | [ 0.49, 0.61] | -10.88 | < .001" + ) + ) + }) } From 53fb8c2106d28dee36afe45ddb97ea676ffa3ca4 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 24 Jun 2022 17:51:35 +0200 Subject: [PATCH 06/21] fix check issues --- R/cluster_meta.R | 10 ++++++---- R/extract_parameters.R | 2 +- R/methods_mjoint.R | 1 - man/model_parameters.averaging.Rd | 1 - 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/cluster_meta.R b/R/cluster_meta.R index 69b734ac3..67d5ae30b 100644 --- a/R/cluster_meta.R +++ b/R/cluster_meta.R @@ -117,8 +117,10 @@ cluster_meta <- function(list_of_clusters, rownames = NULL, ...) { #' @export #' @inheritParams stats::predict predict.cluster_meta <- function(object, n = NULL, ...) { - if(is.null(n)) stop("The number of clusters to extract `n` must be entered.") - d <- as.dist(abs(object - 1)) - model <- hclust(d) - cutree(model, k = n) + if (is.null(n)) { + stop("The number of clusters to extract `n` must be entered.", call. = FALSE) + } + d <- stats::as.dist(abs(object - 1)) + model <- stats::hclust(d) + stats::cutree(model, k = n) } diff --git a/R/extract_parameters.R b/R/extract_parameters.R index d427234c7..320e4279f 100644 --- a/R/extract_parameters.R +++ b/R/extract_parameters.R @@ -900,7 +900,7 @@ dots <- list(...) dots <- dots[names(dots) %in% valid] args <- c(list( model, se = TRUE, level = ci, type = type), dots) - f <- getFromNamespace("standardizedsolution", "lavaan") + f <- utils::getFromNamespace("standardizedsolution", "lavaan") data <- do.call("f", args) names(data)[names(data) == "est.std"] <- "est" } diff --git a/R/methods_mjoint.R b/R/methods_mjoint.R index c66241d7c..62e4920bb 100644 --- a/R/methods_mjoint.R +++ b/R/methods_mjoint.R @@ -9,7 +9,6 @@ model_parameters.mjoint <- function(model, keep = NULL, drop = NULL, parameters = keep, - random_ci = TRUE, verbose = TRUE, ...) { effects <- match.arg(effects, choices = c("fixed", "random", "all")) diff --git a/man/model_parameters.averaging.Rd b/man/model_parameters.averaging.Rd index 42cef58a5..829ff65b2 100644 --- a/man/model_parameters.averaging.Rd +++ b/man/model_parameters.averaging.Rd @@ -467,7 +467,6 @@ keep = NULL, drop = NULL, parameters = keep, - random_ci = TRUE, verbose = TRUE, ... ) From fc35acfebfef118dd8628ae48aaa5129f6d30c66 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sat, 25 Jun 2022 07:26:14 -0400 Subject: [PATCH 07/21] Issue 397: imputation with Hmisc and rms::orm --- DESCRIPTION | 1 + R/methods_lrm.R | 12 +++++++++++- tests/testthat/test-Hmisc.R | 31 +++++++++++++++++++++++++++++++ 3 files changed, 43 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/test-Hmisc.R diff --git a/DESCRIPTION b/DESCRIPTION index ef6e2afcd..af17b28eb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -123,6 +123,7 @@ Suggests: GPArotation, gt, httr, + Hmisc, ivprobit, ivreg, knitr, diff --git a/R/methods_lrm.R b/R/methods_lrm.R index 3990ad685..fd973be42 100644 --- a/R/methods_lrm.R +++ b/R/methods_lrm.R @@ -44,7 +44,17 @@ standard_error.psm <- standard_error.lrm #' @export p_value.lrm <- function(model, ...) { stat <- insight::get_statistic(model) - p <- 2 * stats::pt(abs(stat$Statistic), df = degrees_of_freedom(model, method = "any"), lower.tail = FALSE) + + # Issue: 697: typically the degrees of freedom are the same for every + # observation, but the value is repeated. This poses problems in multiple + # imputation models with Hmisc when we get more df values than parameters. + df <- degrees_of_freedom(model, method = "any") + dfu <- unique(df) + if (length(dfu) == 1) { + df <- dfu + } + + p <- 2 * stats::pt(abs(stat$Statistic), df = df, lower.tail = FALSE) .data_frame( Parameter = .remove_backticks_from_string(stat$Parameter), diff --git a/tests/testthat/test-Hmisc.R b/tests/testthat/test-Hmisc.R new file mode 100644 index 000000000..6cb76efd7 --- /dev/null +++ b/tests/testthat/test-Hmisc.R @@ -0,0 +1,31 @@ +requiet("Hmisc") +requiet("rms") + +test_that("issue 697", { + set.seed(1) + n <- 100 + df <- data.frame( + y = round(runif(n), 2), + x1 = sample(c(-1, 0, 1), n, TRUE), + x2 = sample(c(-1, 0, 1), n, TRUE)) + df$x1[c(0, 1, 2)] <- NA + imputer <- suppressWarnings(Hmisc::transcan( + ~ x1 + x2, + data = df, + imputed = TRUE, + n.impute = 2, + pr = FALSE, + pl = FALSE)) + + suppressWarnings( + mod <- Hmisc::fit.mult.impute( + y ~ x1 + x2, fitter = orm, xtrans = imputer, data = df, pr = FALSE) + ) + + expect_s3_class(parameters(mod), "parameters_model") + expect_s3_class(standard_error(mod), "data.frame") + expect_s3_class(p_value(mod), "data.frame") + expect_equal(nrow(parameters(mod)), 3) + expect_equal(nrow(standard_error(mod)), 3) + expect_equal(nrow(p_value(mod)), 3) +}) From d51ae75d745463c485e6e953f57d869a5255fe1d Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 26 Jun 2022 16:00:13 +0200 Subject: [PATCH 08/21] #736 --- DESCRIPTION | 2 +- NEWS.md | 2 +- R/extract_random_variances.R | 46 ++++++++++++++++----- R/methods_cplm.R | 6 +-- R/methods_glmmTMB.R | 8 ++-- R/methods_lme4.R | 20 +++++---- R/methods_mjoint.R | 2 +- R/methods_panelr.R | 12 +++--- man/model_parameters.merMod.Rd | 74 ++++++++++++++++++---------------- 9 files changed, 106 insertions(+), 66 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index af17b28eb..ae50c6653 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.18.1.5 +Version: 0.18.1.6 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/NEWS.md b/NEWS.md index 71954f098..3d608d197 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,7 +18,7 @@ * `model_parameters()` now also includes standard errors and confidence intervals for slope-slope-correlations of random effects variances. -* `model_parameters()` for mixed models gains a `random_ci` argument, to toggle +* `model_parameters()` for mixed models gains a `ci_random` argument, to toggle whether confidence intervals for random effects parameters should also be computed. Set to `FALSE` if calculation of confidence intervals for random effects parameters takes too long. diff --git a/R/extract_random_variances.R b/R/extract_random_variances.R index 907582afb..a2d264b37 100644 --- a/R/extract_random_variances.R +++ b/R/extract_random_variances.R @@ -11,7 +11,7 @@ effects = "random", component = "conditional", ci_method = NULL, - random_ci = TRUE, + ci_random = NULL, verbose = FALSE, ...) { out <- suppressWarnings( @@ -21,7 +21,7 @@ effects = effects, component = component, ci_method = ci_method, - random_ci = random_ci, + ci_random = ci_random, verbose = verbose, ... ) @@ -45,7 +45,7 @@ effects = "random", component = "all", ci_method = NULL, - random_ci = TRUE, + ci_random = NULL, verbose = FALSE, ...) { component <- match.arg(component, choices = c("all", "conditional", "zero_inflated", "zi", "dispersion")) @@ -57,7 +57,7 @@ effects = effects, component = "conditional", ci_method = ci_method, - random_ci = random_ci, + ci_random = ci_random, verbose = verbose, ... ) @@ -81,7 +81,7 @@ effects = effects, component = "zi", ci_method = ci_method, - random_ci = random_ci, + ci_random = ci_random, verbose = FALSE, ... ) @@ -121,7 +121,7 @@ effects = "random", component = "conditional", ci_method = NULL, - random_ci = TRUE, + ci_random = NULL, verbose = FALSE, ...) { varcorr <- .get_variance_information(model, component) @@ -217,8 +217,8 @@ sigma_param <- out$Parameter == "SD (Observations)" # add confidence intervals? - if (!is.null(ci) && !all(is.na(ci)) && length(ci) == 1 && isTRUE(random_ci)) { - out <- .random_sd_ci(model, out, ci_method, ci, corr_param, sigma_param, component, verbose = verbose) + if (!is.null(ci) && !all(is.na(ci)) && length(ci) == 1 && !isFALSE(ci_random)) { + out <- .random_sd_ci(model, out, ci_method, ci, ci_random, corr_param, sigma_param, component, verbose = verbose) } out <- out[c("Parameter", "Level", "Coefficient", "SE", ci_cols, stat_column, "df_error", "p", "Effects", "Group")] @@ -303,13 +303,41 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... # extract CI for random SD ------------------------ -.random_sd_ci <- function(model, out, ci_method, ci, corr_param, sigma_param, component = NULL, verbose = FALSE) { +.random_sd_ci <- function(model, out, ci_method, ci, ci_random, corr_param, sigma_param, component = NULL, verbose = FALSE) { ## TODO needs to be removed once MCM > 0.1.5 is on CRAN if (grepl("^mcm_lmer", insight::safe_deparse(insight::get_call(model)))) { return(out) } + # heuristic to check whether CIs for random effects should be computed or + # not. If `ci_random=NULL`, we check model complexity and decide whether to + # go on or not. For models with larger samples sized or more complex random + # effects, this might be quite time consuming. + + if (is.null(ci_random)) { + # check sample size, don't compute by default when larger than 1000 + nobs <- insight::n_obs(model) + if (nobs >= 1000) { + return(out) + } + + # check complexity of random effects + re <- insight::find_random(model, flatten = TRUE) + rs <- insight::find_random_slopes(model) + + # quit if if random slopes and larger sample size or more than 1 grouping factor + if (!is.null(rs) && (nobs >= 500 || length(re) > 1)) { + return(out) + } + + # quit if if than two grouping factors + if (length(re) > 2) { + return(out) + } + } + + if (inherits(model, c("merMod", "glmerMod", "lmerMod"))) { # lme4 - boot and profile diff --git a/R/methods_cplm.R b/R/methods_cplm.R index e48776453..3328bd812 100644 --- a/R/methods_cplm.R +++ b/R/methods_cplm.R @@ -220,16 +220,16 @@ standard_error.cpglm <- function(model, ...) { #' @export model_parameters.cpglmm <- function(model, ci = .95, + ci_method = NULL, + ci_random = NULL, bootstrap = FALSE, iterations = 1000, standardize = NULL, effects = "all", group_level = FALSE, exponentiate = FALSE, - ci_method = NULL, p_adjust = NULL, include_sigma = FALSE, - random_ci = TRUE, verbose = TRUE, df_method = ci_method, ...) { @@ -265,7 +265,7 @@ model_parameters.cpglmm <- function(model, group_level = group_level, ci_method = ci_method, include_sigma = include_sigma, - random_ci = random_ci, + ci_random = ci_random, verbose = verbose, ... ) diff --git a/R/methods_glmmTMB.R b/R/methods_glmmTMB.R index 5bd02f354..4a6d39856 100644 --- a/R/methods_glmmTMB.R +++ b/R/methods_glmmTMB.R @@ -9,14 +9,15 @@ #' @export model_parameters.glmmTMB <- function(model, ci = .95, + ci_method = "wald", + ci_random = NULL, bootstrap = FALSE, iterations = 1000, + standardize = NULL, effects = "all", component = "all", group_level = FALSE, - standardize = NULL, exponentiate = FALSE, - ci_method = "wald", p_adjust = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), @@ -26,7 +27,6 @@ model_parameters.glmmTMB <- function(model, verbose = TRUE, df_method = ci_method, include_sigma = FALSE, - random_ci = TRUE, ...) { ## TODO remove later @@ -164,7 +164,7 @@ model_parameters.glmmTMB <- function(model, warning(insight::format_message("Cannot extract confidence intervals for random variance parameters from models with more than one grouping factor."), call. = FALSE) } } else { - params_variance <- .extract_random_variances(model, ci = ci, effects = effects, component = component, ci_method = ci_method, random_ci = random_ci, verbose = verbose) + params_variance <- .extract_random_variances(model, ci = ci, effects = effects, component = component, ci_method = ci_method, ci_random = ci_random, verbose = verbose) # remove redundant dispersion parameter if (isTRUE(dispersion_param) && !is.null(params) && !is.null(params$Component)) { disp <- which(params$Component == "dispersion") diff --git a/R/methods_lme4.R b/R/methods_lme4.R index 1dc85b197..e3c44185b 100644 --- a/R/methods_lme4.R +++ b/R/methods_lme4.R @@ -22,10 +22,16 @@ #' variance and the variance for the additive overdispersion term (see #' [insight::get_variance()] for details). Defaults to `FALSE` for mixed models #' due to the longer computation time. -#' @param random_ci Logical, if `TRUE` (default), includes the confidence -#' intervals for random effects parameters. Only applies if `effects` is not -#' `"fixed"` and if `ci` is not `NULL`. Set `random_ci = FALSE` if computation -#' of the model summary is too much time consuming. +#' @param ci_random Logical, if `TRUE`, includes the confidence intervals for +#' random effects parameters. Only applies if `effects` is not `"fixed"` and +#' if `ci` is not `NULL`. Set `ci_random = FALSE` if computation of the model +#' summary is too much time consuming. By default, `ci_random = NULL`, which +#' uses a heuristic to guess if computation of confidence intervals for random +#' effects will be time consuming or not. For models with larger sample size +#' and/or more complex random effects structures, confidence intervals will +#' not be computed, for simpler models or fewer observations, confidence +#' intervals will be included. Set explicitly to `TRUE` or `FALSE` to enforce +#' or omit confidence intervals of random effects. #' @inheritParams model_parameters.default #' @inheritParams model_parameters.stanreg #' @@ -100,8 +106,9 @@ #' @export model_parameters.merMod <- function(model, ci = .95, - bootstrap = FALSE, ci_method = NULL, + ci_random = NULL, + bootstrap = FALSE, iterations = 1000, standardize = NULL, effects = "all", @@ -118,7 +125,6 @@ model_parameters.merMod <- function(model, include_sigma = FALSE, vcov = NULL, vcov_args = NULL, - random_ci = TRUE, ...) { dots <- list(...) @@ -217,7 +223,7 @@ model_parameters.merMod <- function(model, } if (effects %in% c("random", "all") && isFALSE(group_level)) { - params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = ci_method, random_ci = random_ci, verbose = verbose) + params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = ci_method, ci_random = ci_random, verbose = verbose) } # merge random and fixed effects, if necessary diff --git a/R/methods_mjoint.R b/R/methods_mjoint.R index 62e4920bb..f4e901683 100644 --- a/R/methods_mjoint.R +++ b/R/methods_mjoint.R @@ -36,7 +36,7 @@ model_parameters.mjoint <- function(model, } if (effects %in% c("random", "all")) { - params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = NULL, random_ci = random_ci, verbose = verbose) + params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = NULL, ci_random = FALSE, verbose = verbose) params_variance$Component <- "conditional" } diff --git a/R/methods_panelr.R b/R/methods_panelr.R index f6f3e04bd..6fcd875e8 100644 --- a/R/methods_panelr.R +++ b/R/methods_panelr.R @@ -7,14 +7,14 @@ #' @export model_parameters.wbm <- function(model, ci = .95, - effects = "all", - group_level = FALSE, + ci_random = NULL, bootstrap = FALSE, iterations = 1000, + effects = "all", + group_level = FALSE, exponentiate = FALSE, p_adjust = NULL, include_sigma = FALSE, - random_ci = TRUE, verbose = TRUE, ...) { effects <- match.arg(effects, choices = c("fixed", "random", "all")) @@ -32,7 +32,7 @@ model_parameters.wbm <- function(model, group_level = group_level, ci_method = NULL, include_sigma = include_sigma, - random_ci = random_ci, + ci_random = ci_random, verbose = verbose, ... ) @@ -111,6 +111,7 @@ p_value.wbgee <- p_value.wbm .mixed_model_parameters_generic <- function(model, ci, + ci_random = NULL, bootstrap, iterations, merge_by, @@ -121,7 +122,6 @@ p_value.wbgee <- p_value.wbm group_level, ci_method, include_sigma = FALSE, - random_ci = TRUE, verbose = TRUE, ...) { params <- params_random <- params_variance <- att <- NULL @@ -151,7 +151,7 @@ p_value.wbgee <- p_value.wbm } if (effects %in% c("random", "all") && isFALSE(group_level)) { - params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = ci_method, random_ci = random_ci, verbose = verbose) + params_variance <- .extract_random_variances(model, ci = ci, effects = effects, ci_method = ci_method, ci_random = ci_random, verbose = verbose) } diff --git a/man/model_parameters.merMod.Rd b/man/model_parameters.merMod.Rd index 8e12bffba..e28cd3f91 100644 --- a/man/model_parameters.merMod.Rd +++ b/man/model_parameters.merMod.Rd @@ -21,16 +21,16 @@ \method{model_parameters}{cpglmm}( model, ci = 0.95, + ci_method = NULL, + ci_random = NULL, bootstrap = FALSE, iterations = 1000, standardize = NULL, effects = "all", group_level = FALSE, exponentiate = FALSE, - ci_method = NULL, p_adjust = NULL, include_sigma = FALSE, - random_ci = TRUE, verbose = TRUE, df_method = ci_method, ... @@ -39,14 +39,15 @@ \method{model_parameters}{glmmTMB}( model, ci = 0.95, + ci_method = "wald", + ci_random = NULL, bootstrap = FALSE, iterations = 1000, + standardize = NULL, effects = "all", component = "all", group_level = FALSE, - standardize = NULL, exponentiate = FALSE, - ci_method = "wald", p_adjust = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), @@ -56,15 +57,15 @@ verbose = TRUE, df_method = ci_method, include_sigma = FALSE, - random_ci = TRUE, ... ) \method{model_parameters}{merMod}( model, ci = 0.95, - bootstrap = FALSE, ci_method = NULL, + ci_random = NULL, + bootstrap = FALSE, iterations = 1000, standardize = NULL, effects = "all", @@ -81,7 +82,6 @@ include_sigma = FALSE, vcov = NULL, vcov_args = NULL, - random_ci = TRUE, ... ) @@ -97,14 +97,15 @@ \method{model_parameters}{mixed}( model, ci = 0.95, + ci_method = "wald", + ci_random = NULL, bootstrap = FALSE, iterations = 1000, + standardize = NULL, effects = "all", component = "all", group_level = FALSE, - standardize = NULL, exponentiate = FALSE, - ci_method = "wald", p_adjust = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), @@ -114,21 +115,21 @@ verbose = TRUE, df_method = ci_method, include_sigma = FALSE, - random_ci = TRUE, ... ) \method{model_parameters}{MixMod}( model, ci = 0.95, + ci_method = "wald", + ci_random = NULL, bootstrap = FALSE, iterations = 1000, + standardize = NULL, effects = "all", component = "all", group_level = FALSE, - standardize = NULL, exponentiate = FALSE, - ci_method = "wald", p_adjust = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), @@ -138,7 +139,6 @@ verbose = TRUE, df_method = ci_method, include_sigma = FALSE, - random_ci = TRUE, ... ) @@ -158,8 +158,9 @@ \method{model_parameters}{lme}( model, ci = 0.95, - bootstrap = FALSE, ci_method = NULL, + ci_random = NULL, + bootstrap = FALSE, iterations = 1000, standardize = NULL, effects = "all", @@ -176,7 +177,6 @@ include_sigma = FALSE, vcov = NULL, vcov_args = NULL, - random_ci = TRUE, ... ) @@ -196,16 +196,16 @@ \method{model_parameters}{clmm}( model, ci = 0.95, + ci_method = NULL, + ci_random = NULL, bootstrap = FALSE, iterations = 1000, standardize = NULL, effects = "all", group_level = FALSE, exponentiate = FALSE, - ci_method = NULL, p_adjust = NULL, include_sigma = FALSE, - random_ci = TRUE, verbose = TRUE, df_method = ci_method, ... @@ -214,16 +214,16 @@ \method{model_parameters}{rlmerMod}( model, ci = 0.95, + ci_method = NULL, + ci_random = NULL, bootstrap = FALSE, iterations = 1000, standardize = NULL, effects = "all", group_level = FALSE, exponentiate = FALSE, - ci_method = NULL, p_adjust = NULL, include_sigma = FALSE, - random_ci = TRUE, verbose = TRUE, df_method = ci_method, ... @@ -253,6 +253,27 @@ \item{ci}{Confidence Interval (CI) level. Default to \code{0.95} (\verb{95\%}).} +\item{ci_method}{Method for computing degrees of freedom for +confidence intervals (CI) and the related p-values. Allowed are following +options (which vary depending on the model class): \code{"residual"}, +\code{"normal"}, \code{"likelihood"}, \code{"satterthwaite"}, \code{"kenward"}, \code{"wald"}, +\code{"profile"}, \code{"boot"}, \code{"uniroot"}, \code{"ml1"}, \code{"betwithin"}, \code{"hdi"}, +\code{"quantile"}, \code{"ci"}, \code{"eti"}, \code{"si"}, \code{"bci"}, or \code{"bcai"}. See section +\emph{Confidence intervals and approximation of degrees of freedom} in +\code{\link[=model_parameters]{model_parameters()}} for further details. When \code{ci_method=NULL}, in most +cases \code{"wald"} is used then.} + +\item{ci_random}{Logical, if \code{TRUE}, includes the confidence intervals for +random effects parameters. Only applies if \code{effects} is not \code{"fixed"} and +if \code{ci} is not \code{NULL}. Set \code{ci_random = FALSE} if computation of the model +summary is too much time consuming. By default, \code{ci_random = NULL}, which +uses a heuristic to guess if computation of confidence intervals for random +effects will be time consuming or not. For models with larger sample size +and/or more complex random effects structures, confidence intervals will +not be computed, for simpler models or fewer observations, confidence +intervals will be included. Set explicitly to \code{TRUE} or \code{FALSE} to enforce +or omit confidence intervals of random effects.} + \item{bootstrap}{Should estimates be based on bootstrapped model? If \code{TRUE}, then arguments of \link[=model_parameters.stanreg]{Bayesian regressions} apply (see also \code{\link[=bootstrap_parameters]{bootstrap_parameters()}}).} @@ -299,16 +320,6 @@ captures this uncertainty. For \code{compare_parameters()}, \code{exponentiate = "nongaussian"} will only exponentiate coefficients from non-Gaussian families.} -\item{ci_method}{Method for computing degrees of freedom for -confidence intervals (CI) and the related p-values. Allowed are following -options (which vary depending on the model class): \code{"residual"}, -\code{"normal"}, \code{"likelihood"}, \code{"satterthwaite"}, \code{"kenward"}, \code{"wald"}, -\code{"profile"}, \code{"boot"}, \code{"uniroot"}, \code{"ml1"}, \code{"betwithin"}, \code{"hdi"}, -\code{"quantile"}, \code{"ci"}, \code{"eti"}, \code{"si"}, \code{"bci"}, or \code{"bcai"}. See section -\emph{Confidence intervals and approximation of degrees of freedom} in -\code{\link[=model_parameters]{model_parameters()}} for further details. When \code{ci_method=NULL}, in most -cases \code{"wald"} is used then.} - \item{p_adjust}{Character vector, if not \code{NULL}, indicates the method to adjust p-values. See \code{\link[stats:p.adjust]{stats::p.adjust()}} for details. Further possible adjustment methods are \code{"tukey"}, \code{"scheffe"}, @@ -321,11 +332,6 @@ variance and the variance for the additive overdispersion term (see \code{\link[insight:get_variance]{insight::get_variance()}} for details). Defaults to \code{FALSE} for mixed models due to the longer computation time.} -\item{random_ci}{Logical, if \code{TRUE} (default), includes the confidence -intervals for random effects parameters. Only applies if \code{effects} is not -\code{"fixed"} and if \code{ci} is not \code{NULL}. Set \code{random_ci = FALSE} if computation -of the model summary is too much time consuming.} - \item{verbose}{Toggle warnings and messages.} \item{df_method}{Deprecated. Please use \code{ci_method}.} From c1cf59a7128206748b026c524634fa6d701e7b5a Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 26 Jun 2022 16:24:01 +0200 Subject: [PATCH 09/21] fix tests --- tests/testthat/test-model_parameters_random_pars.R | 2 +- tests/testthat/test-random_effects_ci.R | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-model_parameters_random_pars.R b/tests/testthat/test-model_parameters_random_pars.R index 7835b7760..036c21e1f 100644 --- a/tests/testthat/test-model_parameters_random_pars.R +++ b/tests/testthat/test-model_parameters_random_pars.R @@ -57,7 +57,7 @@ if (.runThisTest && } model <- lmer(Reaction ~ Days + (1 | grp / subgrp) + (1 | Subject), data = sleepstudy) - mp <- model_parameters(model, effects = "random") + mp <- model_parameters(model, effects = "random", ci_random = TRUE) test_that("model_parameters-random pars 5", { expect_equal(mp$Coefficient, as.data.frame(lme4::VarCorr(model))$sdcor, tolerance = 1e-3) diff --git a/tests/testthat/test-random_effects_ci.R b/tests/testthat/test-random_effects_ci.R index 7c97d072f..ad6a699fa 100644 --- a/tests/testthat/test-random_effects_ci.R +++ b/tests/testthat/test-random_effects_ci.R @@ -32,11 +32,11 @@ if (.runThisTest && !osx && ## TODO also check messages for profiled CI - expect_message(mp1 <- model_parameters(m1), "meaningful") - mp2 <- model_parameters(m2) - expect_message(mp3 <- model_parameters(m3), "meaningful") - expect_message(mp4 <- model_parameters(m4), "meaningful") - expect_message(mp5 <- model_parameters(m5), "meaningful") + expect_message(mp1 <- model_parameters(m1, ci_random = TRUE), "meaningful") + mp2 <- model_parameters(m2, ci_random = TRUE) + expect_message(mp3 <- model_parameters(m3, ci_random = TRUE), "meaningful") + expect_message(mp4 <- model_parameters(m4, ci_random = TRUE), "meaningful") + expect_message(mp5 <- model_parameters(m5, ci_random = TRUE), "meaningful") # model 1 --------------------- @@ -271,7 +271,7 @@ if (.runThisTest && !osx && data(cake) m <- lmer(angle ~ poly(temp, 2) + (poly(temp, 2) | replicate) + (1 | recipe), data = cake) - mp <- model_parameters(m) + mp <- model_parameters(m, ci_random = TRUE) test_that("random effects CIs, poly slope", { expect_equal( From 121ac81d8b3b2d6fca1b0bb30e649d2f9f12db67 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 26 Jun 2022 16:45:17 +0200 Subject: [PATCH 10/21] fix tests --- tests/testthat/test-glmmTMB.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test-glmmTMB.R b/tests/testthat/test-glmmTMB.R index 3d1c92482..c2d7d38cb 100644 --- a/tests/testthat/test-glmmTMB.R +++ b/tests/testthat/test-glmmTMB.R @@ -425,7 +425,7 @@ if (.runThisTest && ) ) - mp <- model_parameters(m4, effects = "random", component = "conditional") + mp <- model_parameters(m4, ci_random = TRUE, effects = "random", component = "conditional") out <- utils::capture.output(print(mp)) expect_equal( out, @@ -440,7 +440,7 @@ if (.runThisTest && ) ) - mp <- model_parameters(m4, effects = "fixed", component = "zero_inflated") + mp <- model_parameters(m4, ci_random = TRUE, effects = "fixed", component = "zero_inflated") out <- utils::capture.output(print(mp)) expect_equal( out[-6], @@ -454,7 +454,7 @@ if (.runThisTest && ) ) - mp <- model_parameters(m4, effects = "random", component = "zero_inflated") + mp <- model_parameters(m4, ci_random = TRUE, effects = "random", component = "zero_inflated") out <- utils::capture.output(print(mp)) expect_equal( out, @@ -469,7 +469,7 @@ if (.runThisTest && ) ) - mp <- model_parameters(m4, effects = "all", component = "conditional") + mp <- model_parameters(m4, ci_random = TRUE, effects = "all", component = "conditional") out <- utils::capture.output(print(mp)) expect_equal( out[-5], @@ -491,7 +491,7 @@ if (.runThisTest && ) ) - mp <- model_parameters(m4, effects = "all", component = "zero_inflated") + mp <- model_parameters(m4, effects = "all", ci_random = TRUE, component = "zero_inflated") out <- utils::capture.output(print(mp)) expect_equal( out[-6], @@ -513,7 +513,7 @@ if (.runThisTest && ) ) - mp <- model_parameters(m4, effects = "all", component = "all") + mp <- model_parameters(m4, effects = "all", component = "all", ci_random = TRUE) out <- utils::capture.output(print(mp)) expect_equal( out[-c(5, 14)], @@ -553,7 +553,7 @@ if (.runThisTest && # proper printing of digits --------------------- test_that("print-model_parameters glmmTMB digits", { - mp <- model_parameters(m4, effects = "all", component = "all") + mp <- model_parameters(m4, ci_random = TRUE, effects = "all", component = "all") out <- utils::capture.output(print(mp, digits = 4, ci_digits = 5)) expect_equal( out[-c(5, 14)], @@ -590,7 +590,7 @@ if (.runThisTest && ) ) - mp <- model_parameters(m4, effects = "all", component = "all", digits = 4, ci_digits = 5) + mp <- model_parameters(m4, effects = "all", component = "all", ci_random = TRUE, digits = 4, ci_digits = 5) out <- utils::capture.output(print(mp)) expect_equal( out[-c(5, 14)], @@ -647,7 +647,7 @@ if (.runThisTest && if (!is.null(model_pr)) { test_that("print-model_parameters glmmTMB CI alignment", { - mp <- model_parameters(model_pr, effects = "random", component = "all") + mp <- model_parameters(model_pr, effects = "random", component = "all", ci_random = TRUE) out <- utils::capture.output(print(mp)) expect_equal( out, From da35f59765996159e3e50b9452cba1375c968a04 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 26 Jun 2022 21:38:46 +0200 Subject: [PATCH 11/21] docs --- R/methods_lme4.R | 15 ++++++++++----- man/model_parameters.merMod.Rd | 15 ++++++++++----- 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/R/methods_lme4.R b/R/methods_lme4.R index e3c44185b..014d15a3f 100644 --- a/R/methods_lme4.R +++ b/R/methods_lme4.R @@ -27,11 +27,16 @@ #' if `ci` is not `NULL`. Set `ci_random = FALSE` if computation of the model #' summary is too much time consuming. By default, `ci_random = NULL`, which #' uses a heuristic to guess if computation of confidence intervals for random -#' effects will be time consuming or not. For models with larger sample size -#' and/or more complex random effects structures, confidence intervals will -#' not be computed, for simpler models or fewer observations, confidence -#' intervals will be included. Set explicitly to `TRUE` or `FALSE` to enforce -#' or omit confidence intervals of random effects. +#' effects is fast enough or not. For models with larger sample size and/or +#' more complex random effects structures, confidence intervals will not be +#' computed, for simpler models or fewer observations, confidence intervals +#' will be included. Set explicitly to `TRUE` or `FALSE` to enforce or omit +#' calculation of confidence intervals. **Note**: For `merMod` objects and +#' if `ci_method` is *not* `"boot"` or `"profile"`, the **merDeriv** package +#' is loaded, if installed, to calculate the variance-covariance matrix for +#' random effects. Thus, all further calls to `summary.merMod()` will rely +#' on `merDeriv.vcov()`, which might make `summary()` (much) slower for +#' `merMod` objects. #' @inheritParams model_parameters.default #' @inheritParams model_parameters.stanreg #' diff --git a/man/model_parameters.merMod.Rd b/man/model_parameters.merMod.Rd index e28cd3f91..1359fea1d 100644 --- a/man/model_parameters.merMod.Rd +++ b/man/model_parameters.merMod.Rd @@ -268,11 +268,16 @@ random effects parameters. Only applies if \code{effects} is not \code{"fixed"} if \code{ci} is not \code{NULL}. Set \code{ci_random = FALSE} if computation of the model summary is too much time consuming. By default, \code{ci_random = NULL}, which uses a heuristic to guess if computation of confidence intervals for random -effects will be time consuming or not. For models with larger sample size -and/or more complex random effects structures, confidence intervals will -not be computed, for simpler models or fewer observations, confidence -intervals will be included. Set explicitly to \code{TRUE} or \code{FALSE} to enforce -or omit confidence intervals of random effects.} +effects is fast enough or not. For models with larger sample size and/or +more complex random effects structures, confidence intervals will not be +computed, for simpler models or fewer observations, confidence intervals +will be included. Set explicitly to \code{TRUE} or \code{FALSE} to enforce or omit +calculation of confidence intervals. \strong{Note}: For \code{merMod} objects and +if \code{ci_method} is \emph{not} \code{"boot"} or \code{"profile"}, the \strong{merDeriv} package +is loaded, if installed, to calculate the variance-covariance matrix for +random effects. Thus, all further calls to \code{summary.merMod()} will rely +on \code{merDeriv.vcov()}, which might make \code{summary()} (much) slower for +\code{merMod} objects.} \item{bootstrap}{Should estimates be based on bootstrapped model? If \code{TRUE}, then arguments of \link[=model_parameters.stanreg]{Bayesian regressions} apply (see also From afa140672d4c18e979063acad55add7195bda26b Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 27 Jun 2022 09:03:58 +0200 Subject: [PATCH 12/21] make sure r-universe builds binaries --- DESCRIPTION | 15 +--- WIP/DESCRIPTION | 209 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 210 insertions(+), 14 deletions(-) create mode 100644 WIP/DESCRIPTION diff --git a/DESCRIPTION b/DESCRIPTION index ae50c6653..a974e85b5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -193,17 +193,4 @@ Language: en-US RoxygenNote: 7.2.0 Config/testthat/edition: 3 Roxygen: list(markdown = TRUE) -Remotes: - easystats/insight -RemoteType: github -RemoteHost: api.github.com -RemoteRepo: glmmTMB -RemoteUsername: glmmTMB -RemoteRef: ci_tweaks -RemoteSha: fd8bb78acd8b198147285ce94b1f67043349f570 -RemoteSubdir: glmmTMB -GithubRepo: glmmTMB -GithubUsername: glmmTMB -GithubRef: ci_tweaks -GithubSHA1: fd8bb78acd8b198147285ce94b1f67043349f570 -GithubSubdir: glmmTMB +Remotes: easystats/insight diff --git a/WIP/DESCRIPTION b/WIP/DESCRIPTION new file mode 100644 index 000000000..ae50c6653 --- /dev/null +++ b/WIP/DESCRIPTION @@ -0,0 +1,209 @@ +Type: Package +Package: parameters +Title: Processing of Model Parameters +Version: 0.18.1.6 +Authors@R: + c(person(given = "Daniel", + family = "Lüdecke", + role = c("aut", "cre"), + email = "d.luedecke@uke.de", + comment = c(ORCID = "0000-0002-8895-3206", Twitter = "@strengejacke")), + person(given = "Dominique", + family = "Makowski", + role = "aut", + email = "dom.makowski@gmail.com", + comment = c(ORCID = "0000-0001-5375-9967", Twitter = "@Dom_Makowski")), + person(given = "Mattan S.", + family = "Ben-Shachar", + role = "aut", + email = "matanshm@post.bgu.ac.il", + comment = c(ORCID = "0000-0002-4287-4801")), + person(given = "Indrajeet", + family = "Patil", + role = "aut", + email = "patilindrajeet.science@gmail.com", + comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@patilindrajeets")), + person(given = "Søren", + family = "Højsgaard", + role = "aut", + email = "sorenh@math.aau.dk"), + person(given = "Brenton M.", + family = "Wiernik", + role = "aut", + email = "brenton@wiernik.org", + comment = c(ORCID = "0000-0001-9560-6336", Twitter = "@bmwiernik")), + person(given = "Zen J.", + family = "Lau", + role = "ctb", + email = "zenjuen.lau@ntu.edu.sg"), + person(given = "Vincent", + family = "Arel-Bundock", + role = "ctb", + email = "vincent.arel-bundock@umontreal.ca", + comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@vincentab")), + person(given = "Jeffrey", + family = "Girard", + role = "ctb", + email = "me@jmgirard.com", + comment = c(ORCID = "0000-0002-7359-3746", Twitter = "@jeffreymgirard")), + person(given = "Christina", + family = "Maimone", + role = "rev", + email = "christina.maimone@northwestern.edu"), + person(given = "Niels", + family = "Ohlsen", + role = "rev", + comment = c(Twitter = "@Niels_Bremen")), + person(given = "Douglas Ezra", + family = "Morrison", + role = "ctb", + email = "dmorrison01@ucla.edu", + comment = c(ORCID = "0000-0002-7195-830X", Twitter = "@demstats1"))) +Maintainer: Daniel Lüdecke +Description: Utilities for processing the parameters of various + statistical models. Beyond computing p values, CIs, and other indices + for a wide variety of models (see list of supported models using the + function 'insight::supported_models()'), this package implements + features like bootstrapping or simulating of parameters and models, + feature reduction (feature extraction and variable selection) as well + as functions to describe data and variable characteristics (e.g. + skewness, kurtosis, smoothness or distribution). +License: GPL-3 +URL: https://easystats.github.io/parameters/ +BugReports: https://github.com/easystats/parameters/issues +Depends: + R (>= 3.5) +Imports: + bayestestR (>= 0.12.1), + datawizard (>= 0.4.1), + insight (>= 0.17.1.8), + graphics, + methods, + stats, + utils +Suggests: + AER, + afex, + aod, + BayesFactor, + BayesFM, + bbmle, + betareg, + biglm, + blme, + boot, + brglm2, + brms, + broom, + cAIC4, + car, + cgam, + ClassDiscovery, + clubSandwich, + cluster, + cplm, + dbscan, + drc, + DRR, + effectsize (>= 0.6.0), + EGAnet (>= 0.7), + emmeans (>= 1.7.0), + factoextra, + FactoMineR, + fastICA, + fixest, + fpc, + gam, + gamlss, + gee, + geepack, + ggplot2, + GLMMadaptive, + glmmTMB, + GPArotation, + gt, + httr, + Hmisc, + ivprobit, + ivreg, + knitr, + lavaan, + lavaSearch2, + lfe, + lm.beta, + lme4, + lmerTest, + lmtest, + logspline, + lqmm, + M3C, + magrittr, + marginaleffects, + MASS, + Matrix, + mclust, + MCMCglmm, + mediation, + merDeriv, + metaBMA, + metafor, + mfx, + mgcv, + mice, + multcomp, + MuMIn, + NbClust, + nFactors, + nlme, + nnet, + openxlsx, + ordinal, + panelr, + pbkrtest, + PCDimension, + performance (>= 0.8.0), + plm, + PMCMRplus, + poorman, + posterior, + PROreg, + pscl, + psych, + pvclust, + quantreg, + randomForest, + rmarkdown, + rms, + rstanarm, + sandwich, + see (>= 0.6.9), + sjstats, + survey, + survival, + testthat, + TMB, + tripack, + truncreg, + VGAM, + WRS2 +VignetteBuilder: + knitr +Encoding: UTF-8 +Language: en-US +RoxygenNote: 7.2.0 +Config/testthat/edition: 3 +Roxygen: list(markdown = TRUE) +Remotes: + easystats/insight +RemoteType: github +RemoteHost: api.github.com +RemoteRepo: glmmTMB +RemoteUsername: glmmTMB +RemoteRef: ci_tweaks +RemoteSha: fd8bb78acd8b198147285ce94b1f67043349f570 +RemoteSubdir: glmmTMB +GithubRepo: glmmTMB +GithubUsername: glmmTMB +GithubRef: ci_tweaks +GithubSHA1: fd8bb78acd8b198147285ce94b1f67043349f570 +GithubSubdir: glmmTMB From 2e1668b850305e5759faf36cfe462f181e93e72c Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 27 Jun 2022 13:03:22 +0200 Subject: [PATCH 13/21] close #736 --- R/extract_random_variances.R | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/R/extract_random_variances.R b/R/extract_random_variances.R index a2d264b37..b48f72f20 100644 --- a/R/extract_random_variances.R +++ b/R/extract_random_variances.R @@ -385,9 +385,11 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... # lme4 - wald / normal CI + merDeriv_loaded <- isNamespaceLoaded("merDeriv") + # Wald based CIs # see https://stat.ethz.ch/pipermail/r-sig-mixed-models/2022q1/029985.html - if (all(insight::check_if_installed(c("merDeriv", "lme4"), quietly = TRUE))) { + if (all(suppressMessages(insight::check_if_installed(c("merDeriv", "lme4"), quietly = TRUE)))) { # this may fail, so wrap in try-catch out <- tryCatch( @@ -506,6 +508,12 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... out } ) + + # detach + if (!merDeriv_loaded) { + .unregister_vcov() + } + } else if (isTRUE(verbose)) { message(insight::format_message("Package 'merDeriv' needs to be installed to compute confidence intervals for random effect parameters.")) } @@ -804,3 +812,19 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... x } } + + + + +# this is used to only temporarily load merDeriv and to point registered +# methods from merDeriv to lme4-methods. if merDeriv was loaded before, +# nothing will be changed. If merDeriv was not loaded, vcov-methods registered +# by merDeriv will be re-registered to use lme4::vcov.merMod. This is no problem, +# because *if* useres load merDeriv later manually, merDeriv-vcov-methods will +# be registered again. + +.unregister_vcov <- function() { + unloadNamespace("merDeriv") + suppressWarnings(suppressMessages(registerS3method("vcov", "lmerMod", method = lme4::vcov.merMod))) + suppressWarnings(suppressMessages(registerS3method("vcov", "glmerMod", method = lme4::vcov.merMod))) +} From 44ab4e8ecd074dbee77ac86c50abcdaec2e491a6 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 27 Jun 2022 13:13:09 +0200 Subject: [PATCH 14/21] informative warning --- R/extract_random_variances.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/extract_random_variances.R b/R/extract_random_variances.R index b48f72f20..1ae0fecfe 100644 --- a/R/extract_random_variances.R +++ b/R/extract_random_variances.R @@ -496,6 +496,9 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... if (grepl("nAGQ of at least 1 is required", e$message, fixed = TRUE)) { message(insight::format_message("Argument 'nAGQ' needs to be larger than 0 to compute confidence intervals for random effect parameters.")) } + if (grepl("Multiple cluster variables detected.", e$message, fixed = TRUE)) { + message(insight::format_message("Confidence intervals for random effect parameters are currently not supported for multiple grouping variables.")) + } if (grepl("exactly singular", e$message, fixed = TRUE) || grepl("computationally singular", e$message, fixed = TRUE) || grepl("Exact singular", e$message, fixed = TRUE)) { From 45202fc81c476e82aac3e4d0c0b423b2bfb0bff1 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 27 Jun 2022 13:37:42 +0200 Subject: [PATCH 15/21] update docs --- R/methods_lme4.R | 11 +++-------- man/model_parameters.merMod.Rd | 11 +++-------- 2 files changed, 6 insertions(+), 16 deletions(-) diff --git a/R/methods_lme4.R b/R/methods_lme4.R index 014d15a3f..8d91fd809 100644 --- a/R/methods_lme4.R +++ b/R/methods_lme4.R @@ -29,14 +29,9 @@ #' uses a heuristic to guess if computation of confidence intervals for random #' effects is fast enough or not. For models with larger sample size and/or #' more complex random effects structures, confidence intervals will not be -#' computed, for simpler models or fewer observations, confidence intervals -#' will be included. Set explicitly to `TRUE` or `FALSE` to enforce or omit -#' calculation of confidence intervals. **Note**: For `merMod` objects and -#' if `ci_method` is *not* `"boot"` or `"profile"`, the **merDeriv** package -#' is loaded, if installed, to calculate the variance-covariance matrix for -#' random effects. Thus, all further calls to `summary.merMod()` will rely -#' on `merDeriv.vcov()`, which might make `summary()` (much) slower for -#' `merMod` objects. +#' computed by default, for simpler models or fewer observations, confidence +#' intervals will be included. Set explicitly to `TRUE` or `FALSE` to enforce +#' or omit calculation of confidence intervals. #' @inheritParams model_parameters.default #' @inheritParams model_parameters.stanreg #' diff --git a/man/model_parameters.merMod.Rd b/man/model_parameters.merMod.Rd index 1359fea1d..fb7513f8c 100644 --- a/man/model_parameters.merMod.Rd +++ b/man/model_parameters.merMod.Rd @@ -270,14 +270,9 @@ summary is too much time consuming. By default, \code{ci_random = NULL}, which uses a heuristic to guess if computation of confidence intervals for random effects is fast enough or not. For models with larger sample size and/or more complex random effects structures, confidence intervals will not be -computed, for simpler models or fewer observations, confidence intervals -will be included. Set explicitly to \code{TRUE} or \code{FALSE} to enforce or omit -calculation of confidence intervals. \strong{Note}: For \code{merMod} objects and -if \code{ci_method} is \emph{not} \code{"boot"} or \code{"profile"}, the \strong{merDeriv} package -is loaded, if installed, to calculate the variance-covariance matrix for -random effects. Thus, all further calls to \code{summary.merMod()} will rely -on \code{merDeriv.vcov()}, which might make \code{summary()} (much) slower for -\code{merMod} objects.} +computed by default, for simpler models or fewer observations, confidence +intervals will be included. Set explicitly to \code{TRUE} or \code{FALSE} to enforce +or omit calculation of confidence intervals.} \item{bootstrap}{Should estimates be based on bootstrapped model? If \code{TRUE}, then arguments of \link[=model_parameters.stanreg]{Bayesian regressions} apply (see also From bd354f9f634e690bd8a51b0ebb39e17cc1a632a7 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Tue, 28 Jun 2022 10:52:47 -0400 Subject: [PATCH 16/21] version bump for downstream conditional test --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a974e85b5..dd3b06172 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.18.1.6 +Version: 0.18.1.7 Authors@R: c(person(given = "Daniel", family = "Lüdecke", From 22e3601becd87631f4e4a595bfb8859a11fbc09d Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Tue, 5 Jul 2022 00:17:49 +0200 Subject: [PATCH 17/21] style --- R/1_model_parameters.R | 1 - R/3_p_value.R | 1 - R/check_factorstructure.R | 2 - R/ci_generic.R | 1 - R/ci_profile_boot.R | 3 +- R/cluster_analysis.R | 2 - R/cluster_centers.R | 1 - R/cluster_meta.R | 3 +- R/compare_parameters.R | 2 - R/equivalence_test.R | 4 - R/extract_parameters.R | 10 +- R/extract_parameters_anova.R | 6 +- R/extract_random_variances.R | 11 +- R/factor_analysis.R | 1 - R/format.R | 2 - R/format_p_adjust.R | 3 - R/format_parameters.R | 8 +- R/methods_MCMCglmm.R | 1 - R/methods_bayesQR.R | 2 - R/methods_brglm2.R | 1 - R/methods_brms.R | 3 - R/methods_car.R | 4 +- R/methods_cplm.R | 1 - R/methods_emmeans.R | 4 - R/methods_glmmTMB.R | 11 +- R/methods_htest.R | 22 ++-- R/methods_kmeans.R | 1 - R/methods_lavaan.R | 2 - R/methods_lqmm.R | 1 - R/methods_marginaleffects.R | 4 +- R/methods_metaplus.R | 2 - R/methods_mlm.R | 35 +++--- R/methods_multcomp.R | 2 - R/methods_nlme.R | 1 - R/methods_psych.R | 3 - R/methods_rstan.R | 1 - R/methods_rstanarm.R | 4 - R/parameters_type.R | 2 - R/pool_parameters.R | 1 - R/print_html.R | 1 - R/robust_estimation.R | 2 - R/sort_parameters.R | 8 +- R/standardize_info.R | 6 +- R/standardize_posteriors.R | 2 +- R/utils.R | 3 +- R/utils_format.R | 3 - WIP/bootstrapping.Rmd | 16 +-- WIP/extract_random_variances.R | 20 +-- WIP/model_parameters_robust.Rmd | 38 +++--- WIP/select_parameters.stanreg.R | 1 - tests/testthat/test-Hmisc.R | 30 +++-- tests/testthat/test-compare_parameters.R | 1 - tests/testthat/test-glmer.R | 8 +- tests/testthat/test-glmmTMB.R | 11 +- tests/testthat/test-mlm.R | 1 - tests/testthat/test-model_parameters.anova.R | 12 +- .../test-model_parameters.aov_es_ci.R | 1 - tests/testthat/test-model_parameters.glm.R | 10 +- tests/testthat/test-model_parameters.lqmm.R | 1 - tests/testthat/test-model_parameters.mixed.R | 8 +- tests/testthat/test-model_parameters_df.R | 2 - .../test-model_parameters_random_pars.R | 24 ++-- tests/testthat/test-model_parameters_robust.R | 1 - tests/testthat/test-p_value.R | 2 +- tests/testthat/test-panelr.R | 8 +- tests/testthat/test-quantreg.R | 1 - .../testthat/test-random_effects_ci-glmmTMB.R | 86 ++++++++----- tests/testthat/test-random_effects_ci.R | 116 +++++++++++------- tests/testthat/test-robust.R | 3 - tests/testthat/test-standardize_info.R | 2 +- tests/testthat/test-wrs2.R | 1 - vignettes/clustering.Rmd | 77 ++++++------ vignettes/efa_cfa.Rmd | 2 +- vignettes/model_parameters.Rmd | 1 - vignettes/model_parameters_print.Rmd | 53 +++++--- vignettes/standardize_parameters_effsize.Rmd | 30 +++-- 76 files changed, 385 insertions(+), 376 deletions(-) diff --git a/R/1_model_parameters.R b/R/1_model_parameters.R index 2a3d74089..dc7d9a92c 100644 --- a/R/1_model_parameters.R +++ b/R/1_model_parameters.R @@ -535,7 +535,6 @@ model_parameters.default <- function(model, ) args <- c(args, dots) params <- do.call("bootstrap_parameters", args) - } else { # set default method for CI if (is.null(ci_method) || missing(ci_method)) { diff --git a/R/3_p_value.R b/R/3_p_value.R index 043617af9..afd41e8e5 100644 --- a/R/3_p_value.R +++ b/R/3_p_value.R @@ -174,7 +174,6 @@ p_value.default <- function(model, p <- NULL if (ncol(cs) >= 4) { - # do we have a p-value column based on t? pvcn <- which(colnames(cs) == "Pr(>|t|)") diff --git a/R/check_factorstructure.R b/R/check_factorstructure.R index d484e5a95..dec52308a 100644 --- a/R/check_factorstructure.R +++ b/R/check_factorstructure.R @@ -14,7 +14,6 @@ #' [check_kmo()], [check_sphericity_bartlett()] and [check_clusterstructure()]. #' @export check_factorstructure <- function(x, ...) { - # TODO: detect (and remove?) factors # TODO: This could be improved using the correlation package to use different correlation methods @@ -145,7 +144,6 @@ check_kmo <- function(x, ...) { #' approximation in factor analysis. Biometrika, 38(3/4), 337-344. #' @export check_sphericity_bartlett <- function(x, ...) { - # This could be improved using the correlation package to use different correlation methods cormatrix <- stats::cor(x, use = "pairwise.complete.obs", ...) diff --git a/R/ci_generic.R b/R/ci_generic.R index 3cea60ec2..7adb7612c 100644 --- a/R/ci_generic.R +++ b/R/ci_generic.R @@ -8,7 +8,6 @@ vcov_args = NULL, verbose = TRUE, ...) { - # check method if (is.null(method)) { method <- "wald" diff --git a/R/ci_profile_boot.R b/R/ci_profile_boot.R index 050fb72e8..82cc9f6d1 100644 --- a/R/ci_profile_boot.R +++ b/R/ci_profile_boot.R @@ -81,7 +81,8 @@ out <- as.data.frame(stats::confint(x, method = "profile", level = ci, ...)) } else { out <- tryCatch(as.data.frame(stats::confint(profiled, level = ci, ...)), - error = function(e) NULL) + error = function(e) NULL + ) if (is.null(out)) { out <- as.data.frame(stats::confint(x, method = "profile", level = ci, ...)) } diff --git a/R/cluster_analysis.R b/R/cluster_analysis.R index 5c9cdf3fc..6b74f8a43 100644 --- a/R/cluster_analysis.R +++ b/R/cluster_analysis.R @@ -132,8 +132,6 @@ cluster_analysis <- function(x, dbscan_eps = 15, iterations = 100, ...) { - - # match arguments method <- match.arg(method, choices = c("kmeans", "hkmeans", "pam", "pamk", "hclust", "dbscan", "hdbscan", "mixture"), several.ok = TRUE) diff --git a/R/cluster_centers.R b/R/cluster_centers.R index 770cbc78a..7e46a0e3b 100644 --- a/R/cluster_centers.R +++ b/R/cluster_centers.R @@ -17,7 +17,6 @@ #' cluster_centers(iris[1:4], clusters = k$cluster, fun = median) #' @export cluster_centers <- function(data, clusters, fun = mean, ...) { - # Get n obs params <- data.frame(table(clusters)) names(params) <- c("Cluster", "n_Obs") diff --git a/R/cluster_meta.R b/R/cluster_meta.R index 67d5ae30b..47483da51 100644 --- a/R/cluster_meta.R +++ b/R/cluster_meta.R @@ -32,7 +32,7 @@ #' heatmap(m, scale = "none") #' #' # Extract 3 clusters -#' predict(m, n=3) +#' predict(m, n = 3) #' #' # Convert to dissimilarity #' d <- as.dist(abs(m - 1)) @@ -81,7 +81,6 @@ cluster_meta <- function(list_of_clusters, rownames = NULL, ...) { #' @keywords internal .cluster_meta_matrix <- function(data) { - # Internal function .get_prob <- function(x) { if (any(is.na(x))) { diff --git a/R/compare_parameters.R b/R/compare_parameters.R index 3a31e7b52..d0216c7e6 100644 --- a/R/compare_parameters.R +++ b/R/compare_parameters.R @@ -150,11 +150,9 @@ compare_parameters <- function(..., model_name <- model_names[[i]] if (inherits(model, "parameters_model")) { - # we already have model parameters object... dat <- model } else { - # set default-ci_type for Bayesian models if (.is_bayesian_model(model) && !ci_method %in% c("hdi", "quantile", "ci", "eti", "si", "bci", "bcai")) { ci_method_tmp <- "eti" diff --git a/R/equivalence_test.R b/R/equivalence_test.R index c3d211685..92a77ee1d 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -226,7 +226,6 @@ equivalence_test.merMod <- function(x, effects = c("fixed", "random"), verbose = TRUE, ...) { - # ==== argument matching ==== rule <- match.arg(tolower(rule), choices = c("bayes", "classic", "cet")) @@ -270,7 +269,6 @@ equivalence_test.parameters_simulate_model <- function(x, ci = .95, verbose = TRUE, ...) { - # ==== retrieve model, to define rope range for simulated model parameters ==== model <- .get_object(x) @@ -310,7 +308,6 @@ equivalence_test.parameters_simulate_model <- function(x, rule = "classic", verbose = TRUE, ...) { - # ==== define rope range ==== if (all(range == "default")) { @@ -601,7 +598,6 @@ format.equivalence_test_lm <- function(x, format = "text", zap_small = FALSE, ...) { - # default brackets are parenthesis for HTML / MD if ((is.null(ci_brackets) || isTRUE(ci_brackets)) && (identical(format, "html") || identical(format, "markdown"))) { ci_brackets <- c("(", ")") diff --git a/R/extract_parameters.R b/R/extract_parameters.R index 320e4279f..0b8e76aa7 100644 --- a/R/extract_parameters.R +++ b/R/extract_parameters.R @@ -312,11 +312,13 @@ .add_sigma_residual_df <- function(params, model) { if (is.null(params$Component) || !"sigma" %in% params$Component) { sig <- tryCatch(suppressWarnings(insight::get_sigma(model, ci = NULL, verbose = FALSE)), - error = function(e) NULL) + error = function(e) NULL + ) attr(params, "sigma") <- as.numeric(sig) resdf <- tryCatch(suppressWarnings(insight::get_df(model, type = "residual")), - error = function(e) NULL) + error = function(e) NULL + ) attr(params, "residual_df") <- as.numeric(resdf) } params @@ -351,7 +353,6 @@ drop = NULL, column = NULL, verbose = TRUE) { - # check pattern if (!is.null(keep) && length(keep) > 1) { keep <- paste0("(", paste0(keep, collapse = "|"), ")") @@ -623,7 +624,6 @@ .add_within_between_effects <- function(model, parameters) { - # This function checks whether the model contains predictors that were # "demeaned" using the "demean()" function. If so, these columns have an # attribute indicating the within or between effect, and in such cases, @@ -899,7 +899,7 @@ valid <- names(formals(lavaan::standardizedsolution)) dots <- list(...) dots <- dots[names(dots) %in% valid] - args <- c(list( model, se = TRUE, level = ci, type = type), dots) + args <- c(list(model, se = TRUE, level = ci, type = type), dots) f <- utils::getFromNamespace("standardizedsolution", "lavaan") data <- do.call("f", args) names(data)[names(data) == "est.std"] <- "est" diff --git a/R/extract_parameters_anova.R b/R/extract_parameters_anova.R index 4ee305142..11d535a72 100644 --- a/R/extract_parameters_anova.R +++ b/R/extract_parameters_anova.R @@ -1,6 +1,5 @@ #' @keywords internal .extract_parameters_anova <- function(model, test = "multivariate") { - # Processing if ("manova" %in% class(model)) { parameters <- .extract_anova_manova(model) @@ -193,8 +192,9 @@ hypothesis <- m_attr$heading[grep("=", m_attr$heading)] parameters_xtra <- data.frame( Parameter = hypothesis, - Coefficient = m_attr$value, - SE = sqrt(as.numeric(diag(m_attr$vcov)))) + Coefficient = m_attr$value, + SE = sqrt(as.numeric(diag(m_attr$vcov))) + ) row.names(parameters_xtra) <- row.names(parameters) <- NULL parameters <- cbind(parameters_xtra, parameters) parameters$Parameter <- gsub(" ", " ", parameters$Parameter) ## Annoying extra space sometimes diff --git a/R/extract_random_variances.R b/R/extract_random_variances.R index 1ae0fecfe..46115e066 100644 --- a/R/extract_random_variances.R +++ b/R/extract_random_variances.R @@ -304,7 +304,6 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... # extract CI for random SD ------------------------ .random_sd_ci <- function(model, out, ci_method, ci, ci_random, corr_param, sigma_param, component = NULL, verbose = FALSE) { - ## TODO needs to be removed once MCM > 0.1.5 is on CRAN if (grepl("^mcm_lmer", insight::safe_deparse(insight::get_call(model)))) { return(out) @@ -339,7 +338,6 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... if (inherits(model, c("merMod", "glmerMod", "lmerMod"))) { - # lme4 - boot and profile if (!is.null(ci_method) && ci_method %in% c("profile", "boot")) { @@ -382,7 +380,6 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... } ) } else if (!is.null(ci_method)) { - # lme4 - wald / normal CI merDeriv_loaded <- isNamespaceLoaded("merDeriv") @@ -390,7 +387,6 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... # Wald based CIs # see https://stat.ethz.ch/pipermail/r-sig-mixed-models/2022q1/029985.html if (all(suppressMessages(insight::check_if_installed(c("merDeriv", "lme4"), quietly = TRUE)))) { - # this may fail, so wrap in try-catch out <- tryCatch( { @@ -500,8 +496,8 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... message(insight::format_message("Confidence intervals for random effect parameters are currently not supported for multiple grouping variables.")) } if (grepl("exactly singular", e$message, fixed = TRUE) || - grepl("computationally singular", e$message, fixed = TRUE) || - grepl("Exact singular", e$message, fixed = TRUE)) { + grepl("computationally singular", e$message, fixed = TRUE) || + grepl("Exact singular", e$message, fixed = TRUE)) { message(insight::format_message( "Cannot compute standard errors and confidence intervals for random effects parameters.", "Your model may suffer from singularity (see '?lme4::isSingular' and '?performance::check_singularity')." @@ -516,13 +512,11 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... if (!merDeriv_loaded) { .unregister_vcov() } - } else if (isTRUE(verbose)) { message(insight::format_message("Package 'merDeriv' needs to be installed to compute confidence intervals for random effect parameters.")) } } } else if (inherits(model, "glmmTMB")) { - # glmmTMB random-effects-CI ## TODO "profile" seems to be less stable, so only wald? @@ -646,7 +640,6 @@ as.data.frame.VarCorr.lme <- function(x, row.names = NULL, optional = FALSE, ... # store essential information about variance components... # basically, this function should return lme4::VarCorr(x) .get_variance_information <- function(model, model_component = "conditional") { - # reason to be installed reason <- "to compute random effect variances for mixed models" diff --git a/R/factor_analysis.R b/R/factor_analysis.R index 06aaf563b..034cb1e8a 100644 --- a/R/factor_analysis.R +++ b/R/factor_analysis.R @@ -22,7 +22,6 @@ factor_analysis.data.frame <- function(x, standardize = TRUE, cor = NULL, ...) { - # Standardize if (standardize && is.null(cor)) { x <- as.data.frame(scale(x)) diff --git a/R/format.R b/R/format.R index acacd2142..3bd06a115 100644 --- a/R/format.R +++ b/R/format.R @@ -421,7 +421,6 @@ format.parameters_sem <- function(x, # footer: residual standard deviation .add_footer_sigma <- function(footer = NULL, digits, sigma, residual_df = NULL, type = "text") { if (!is.null(sigma)) { - # format residual df if (!is.null(residual_df)) { res_df <- paste0(" (df = ", residual_df, ")") @@ -549,7 +548,6 @@ format.parameters_sem <- function(x, # footer: model formula .add_footer_formula <- function(footer = NULL, model_formula, n_obs = NULL, type = "text") { if (!is.null(model_formula)) { - # format n of observations if (!is.null(n_obs)) { n <- paste0(" (", n_obs, " Observations)") diff --git a/R/format_p_adjust.R b/R/format_p_adjust.R index f9f29888d..12ddc8787 100644 --- a/R/format_p_adjust.R +++ b/R/format_p_adjust.R @@ -34,10 +34,8 @@ format_p_adjust <- function(method) { .p_adjust <- function(params, p_adjust, model = NULL, verbose = TRUE) { - # check if we have any adjustment at all, and a p-column if (!is.null(p_adjust) && "p" %in% colnames(params) && p_adjust != "none") { - ## TODO add "mvt" method from emmeans # prepare arguments @@ -63,7 +61,6 @@ format_p_adjust <- function(method) { # only proceed if valid argument-value if (tolower(p_adjust) %in% all_methods) { - # save old values, to check if p-adjustment worked old_p_vals <- params$p # find statistic column diff --git a/R/format_parameters.R b/R/format_parameters.R index 2e773fc50..fd04d2b3e 100644 --- a/R/format_parameters.R +++ b/R/format_parameters.R @@ -179,14 +179,13 @@ format_parameters.parameters_model <- function(model, ...) { level = type$Level, brackets = brackets ) - } else if (components[j] %in% types$Secondary_Parameter) { type <- types[!is.na(types$Secondary_Parameter) & types$Secondary_Parameter == components[j], ] components[j] <- .format_parameter( components[j], - variable = type[1,]$Secondary_Variable, - type = type[1,]$Secondary_Type, - level = type[1,]$Secondary_Level, + variable = type[1, ]$Secondary_Variable, + type = type[1, ]$Secondary_Type, + level = type[1, ]$Secondary_Level, brackets = brackets ) } @@ -219,7 +218,6 @@ format_parameters.parameters_model <- function(model, ...) { #' @keywords internal .format_parameter <- function(name, variable, type, level, brackets = brackets) { - # Factors if (type == "factor") { name <- .format_factor(name = name, variable = variable, brackets = brackets) diff --git a/R/methods_MCMCglmm.R b/R/methods_MCMCglmm.R index 7a4b346b7..62571a016 100644 --- a/R/methods_MCMCglmm.R +++ b/R/methods_MCMCglmm.R @@ -39,7 +39,6 @@ model_parameters.MCMCglmm <- function(model, parameters = keep, verbose = TRUE, ...) { - # Processing params <- .extract_parameters_bayesian( diff --git a/R/methods_bayesQR.R b/R/methods_bayesQR.R index 292031898..49387ae71 100644 --- a/R/methods_bayesQR.R +++ b/R/methods_bayesQR.R @@ -16,8 +16,6 @@ model_parameters.bayesQR <- function(model, parameters = keep, verbose = TRUE, ...) { - - # Processing params <- .extract_parameters_bayesian( model, diff --git a/R/methods_brglm2.R b/R/methods_brglm2.R index 35c445dc2..e47659c3a 100644 --- a/R/methods_brglm2.R +++ b/R/methods_brglm2.R @@ -16,7 +16,6 @@ model_parameters.bracl <- function(model, p_adjust = NULL, verbose = TRUE, ...) { - # sanity check, warn if unsupported argument is used. dot_args <- .check_dots( dots = list(...), diff --git a/R/methods_brms.R b/R/methods_brms.R index 52540e21d..07d0c291a 100644 --- a/R/methods_brms.R +++ b/R/methods_brms.R @@ -45,7 +45,6 @@ model_parameters.brmsfit <- function(model, ... ) } else { - # Processing params <- .extract_parameters_bayesian( model, @@ -115,8 +114,6 @@ model_parameters.brmsfit <- function(model, drop_parameters = NULL, verbose = TRUE, ...) { - - # parameters smd <- insight::get_parameters(model, effects = "fixed", component = "conditional") studies <- insight::get_parameters(model, effects = "random", parameters = "^(?!sd_)") diff --git a/R/methods_car.R b/R/methods_car.R index a4e17c1a8..8df8f7f4a 100644 --- a/R/methods_car.R +++ b/R/methods_car.R @@ -1,7 +1,6 @@ #' @rdname model_parameters.averaging #' @export model_parameters.deltaMethod <- function(model, p_adjust = NULL, verbose = TRUE, ...) { - dots <- list(...) if ("ci" %in% names(dots)) { warning(insight::format_message("The `ci` argument is not supported by `model_parameters` for objects of this class. Use the `level` argument of the `deltaMethod` function instead."), call. = FALSE) @@ -47,7 +46,8 @@ model_parameters.deltaMethod <- function(model, p_adjust = NULL, verbose = TRUE, ci_method = "residual", p_adjust = p_adjust, summary = FALSE, - verbose = verbose) + verbose = verbose + ) args <- c(args, dots) params <- do.call(".add_model_parameters_attributes", args) diff --git a/R/methods_cplm.R b/R/methods_cplm.R index 3328bd812..b7fdcbf66 100644 --- a/R/methods_cplm.R +++ b/R/methods_cplm.R @@ -233,7 +233,6 @@ model_parameters.cpglmm <- function(model, verbose = TRUE, df_method = ci_method, ...) { - ## TODO remove later if (!missing(df_method) && !identical(ci_method, df_method)) { warning(insight::format_message("Argument 'df_method' is deprecated. Please use 'ci_method' instead."), call. = FALSE) diff --git a/R/methods_emmeans.R b/R/methods_emmeans.R index a14cbf883..eaeaf68a6 100644 --- a/R/methods_emmeans.R +++ b/R/methods_emmeans.R @@ -18,7 +18,6 @@ model_parameters.emmGrid <- function(model, parameters = NULL, verbose = TRUE, ...) { - # set default for p-adjust emm_padjust <- tryCatch( { @@ -37,7 +36,6 @@ model_parameters.emmGrid <- function(model, # we assume frequentist here... if (!.is_bayesian_emmeans(model)) { - # get statistic, se and p statistic <- insight::get_statistic(model, ci = ci, adjust = "none") SE <- standard_error(model) @@ -53,7 +51,6 @@ model_parameters.emmGrid <- function(model, params <- .p_adjust(params, p_adjust, model, verbose) } } else { - # Bayesian models go here... params <- bayestestR::describe_posterior( model, @@ -337,7 +334,6 @@ p_value.emm_list <- function(model, adjust = "none", ...) { # any missing values? if (anyNA(out$p)) { - # standard errors se <- unlist(lapply(s, function(i) { if (is.null(i$SE)) { diff --git a/R/methods_glmmTMB.R b/R/methods_glmmTMB.R index 4a6d39856..5e1e853bc 100644 --- a/R/methods_glmmTMB.R +++ b/R/methods_glmmTMB.R @@ -28,7 +28,6 @@ model_parameters.glmmTMB <- function(model, df_method = ci_method, include_sigma = FALSE, ...) { - ## TODO remove later if (!missing(df_method) && !identical(ci_method, df_method)) { warning(insight::format_message("Argument 'df_method' is deprecated. Please use 'ci_method' instead."), call. = FALSE) @@ -172,10 +171,11 @@ model_parameters.glmmTMB <- function(model, # check if we have dispersion parameter, and either no sigma # or sigma equals dispersion if (length(disp) > 0 && - length(resid) > 0 && - isTRUE(all.equal(params_variance$Coefficient[resid], - params$Coefficient[disp], - tolerance = 1e-5))) { + length(resid) > 0 && + isTRUE(all.equal(params_variance$Coefficient[resid], + params$Coefficient[disp], + tolerance = 1e-5 + ))) { params <- params[-disp, ] } } @@ -282,7 +282,6 @@ ci.glmmTMB <- function(x, out <- lapply(ci, function(i) .ci_uniroot_glmmTMB(x, ci = i, component = component, ...)) do.call(rbind, out) } else { - # all other .ci_generic(model = x, ci = ci, dof = dof, method = method, component = component, ...) } diff --git a/R/methods_htest.R b/R/methods_htest.R index 872c9077a..fe42a78f1 100644 --- a/R/methods_htest.R +++ b/R/methods_htest.R @@ -182,15 +182,12 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { m_info <- insight::model_info(model, verbose = FALSE) if (m_info$is_correlation) { - # correlation --------- out <- .extract_htest_correlation(model) } else if (.is_levenetest(model)) { - # levene's test --------- out <- .extract_htest_levenetest(model) } else if (m_info$is_ttest) { - # t-test ----------- out <- .extract_htest_ttest(model) out <- .add_effectsize_ttest(model, @@ -203,7 +200,6 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { ... ) } else if (m_info$is_ranktest) { - # rank-test (kruskal / wilcox / friedman) ----------- out <- .extract_htest_ranktest(model) @@ -237,7 +233,6 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { ) } } else if (m_info$is_onewaytest) { - # one-way test ----------- out <- .extract_htest_oneway(model) out <- .add_effectsize_oneway( @@ -250,7 +245,6 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { verbose = verbose ) } else if (m_info$is_chi2test) { - # chi2- and mcnemar-test ----------- out <- .extract_htest_chi2(model) if (grepl("^McNemar", model$method)) { @@ -272,15 +266,12 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { ) } } else if (m_info$is_proptest) { - # test of proportion -------------- out <- .extract_htest_prop(model) } else if (m_info$is_binomtest) { - # exact binomial test -------------- out <- .extract_htest_binom(model) } else if (m_info$is_ftest) { - # F test for equal variances -------------- out <- .extract_htest_vartest(model) } else { @@ -700,8 +691,10 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { }, error = function(e) { if (verbose) { - msg <- c("Could not compute effectsize Cramer's V.", - paste0("Possible reason: ", e$message)) + msg <- c( + "Could not compute effectsize Cramer's V.", + paste0("Possible reason: ", e$message) + ) message(insight::format_message(msg)) } NULL @@ -732,8 +725,10 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { }, error = function(e) { if (verbose) { - msg <- c("Could not compute effectsize Phi.", - paste0("Possible reason: ", e$message)) + msg <- c( + "Could not compute effectsize Phi.", + paste0("Possible reason: ", e$message) + ) message(insight::format_message(msg)) } NULL @@ -808,7 +803,6 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { } if (requireNamespace("effectsize", quietly = TRUE)) { - # standardized d if (!is.null(standardized_d)) { es <- effectsize::effectsize( diff --git a/R/methods_kmeans.R b/R/methods_kmeans.R index baadfbb80..868ca6b8d 100644 --- a/R/methods_kmeans.R +++ b/R/methods_kmeans.R @@ -138,7 +138,6 @@ predict.parameters_clusters <- function(object, newdata = NULL, names = NULL, .. # Add labels if (!is.null(names)) { - # List if (is.list(names)) { out <- as.factor(out) diff --git a/R/methods_lavaan.R b/R/methods_lavaan.R index 126de2e61..cf0fdc628 100644 --- a/R/methods_lavaan.R +++ b/R/methods_lavaan.R @@ -56,8 +56,6 @@ model_parameters.blavaan <- function(model, parameters = keep, verbose = TRUE, ...) { - - # Processing params <- .extract_parameters_bayesian( model, diff --git a/R/methods_lqmm.R b/R/methods_lqmm.R index 089e6aea1..69b35e41e 100644 --- a/R/methods_lqmm.R +++ b/R/methods_lqmm.R @@ -7,7 +7,6 @@ model_parameters.lqmm <- function(model, p_adjust = NULL, verbose = TRUE, ...) { - # Processing if (bootstrap) { parameters <- bootstrap_parameters( diff --git a/R/methods_marginaleffects.R b/R/methods_marginaleffects.R index 2370361ac..f35674304 100644 --- a/R/methods_marginaleffects.R +++ b/R/methods_marginaleffects.R @@ -8,7 +8,6 @@ model_parameters.marginaleffects <- function(model, ci = .95, ...) { - out <- insight::standardize_names( marginaleffects::tidy(model, conf_level = ci, ...), style = "easystats" @@ -16,7 +15,8 @@ model_parameters.marginaleffects <- function(model, out <- tryCatch( .add_model_parameters_attributes(out, model, ci, ...), - error = function(e) out) + error = function(e) out + ) attr(out, "object_name") <- insight::safe_deparse(substitute(model)) diff --git a/R/methods_metaplus.R b/R/methods_metaplus.R index 55398554b..a56a498e4 100644 --- a/R/methods_metaplus.R +++ b/R/methods_metaplus.R @@ -151,7 +151,6 @@ model_parameters.meta_random <- function(model, include_studies = TRUE, verbose = TRUE, ...) { - # process arguments params <- as.data.frame(model$estimates) ci_method <- match.arg(ci_method, choices = c("hdi", "eti", "quantile")) @@ -312,7 +311,6 @@ model_parameters.meta_bma <- function(model, include_studies = TRUE, verbose = TRUE, ...) { - # process arguments params <- as.data.frame(model$estimates) ci_method <- match.arg(ci_method, choices = c("hdi", "eti", "quantile")) diff --git a/R/methods_mlm.R b/R/methods_mlm.R index bcc32f437..c7d1ce854 100644 --- a/R/methods_mlm.R +++ b/R/methods_mlm.R @@ -69,7 +69,6 @@ standard_error.mlm <- function(model, vcov = NULL, vcov_args = NULL, ...) { - se <- standard_error.default(model, vcov = vcov, vcov_args = vcov_args, ...) est <- insight::get_parameters(model, ...) # assumes se and est are sorted the same way @@ -78,11 +77,12 @@ standard_error.mlm <- function(model, se$Response <- est$Response return(se) - # manually + # manually } else { if (!is.null(vcov)) { warning(insight::format_message( - "Unable to extract the variance-covariance matrix requested in `vcov`.")) + "Unable to extract the variance-covariance matrix requested in `vcov`." + )) } cs <- stats::coef(summary(model)) se <- lapply(names(cs), function(x) { @@ -91,7 +91,8 @@ standard_error.mlm <- function(model, Parameter = rownames(params), SE = params[, "Std. Error"], Response = gsub("^Response (.*)", "\\1", x) - )}) + ) + }) se <- insight::text_remove_backticks(do.call(rbind, se), verbose = FALSE) return(se) } @@ -100,7 +101,6 @@ standard_error.mlm <- function(model, #' @export p_value.mlm <- function(model, vcov = NULL, vcov_args = NULL, ...) { - out <- p_value.default(model, vcov = vcov, vcov_args = vcov_args, ...) est <- insight::get_parameters(model, ...) # assumes out and est are sorted the same way @@ -108,11 +108,12 @@ p_value.mlm <- function(model, vcov = NULL, vcov_args = NULL, ...) { out$Parameter <- est$Parameter out$Response <- est$Response - # manually + # manually } else { if (!is.null(vcov)) { warning(insight::format_message( - "Unable to extract the variance-covariance matrix requested in `vcov`.")) + "Unable to extract the variance-covariance matrix requested in `vcov`." + )) } cs <- stats::coef(summary(model)) p <- lapply(names(cs), function(x) { @@ -135,7 +136,6 @@ ci.mlm <- function(x, vcov = NULL, vcov_args = NULL, ci = .95, ...) { - # .ci_generic may not handle weights properly (not sure) if (is.null(insight::find_weights(x)) && is.null(vcov)) { out <- lapply(ci, function(i) { @@ -151,23 +151,24 @@ ci.mlm <- function(x, }) out <- insight::text_remove_backticks(do.call(rbind, out), verbose = FALSE) - # .ci_generic does handle `vcov` correctly. + # .ci_generic does handle `vcov` correctly. } else { out <- .data_frame(.ci_generic(x, - ci = ci, - vcov = vcov, - vcov_args = vcov_args, - ...)) + ci = ci, + vcov = vcov, + vcov_args = vcov_args, + ... + )) resp <- insight::get_parameters(x)$Response if (!"Reponse" %in% colnames(out) && nrow(out) == length(resp)) { - out[["Response"]] <- resp + out[["Response"]] <- resp } else { if (!isTRUE(all(out$Response == resp))) { stop(insight::format_message( - "Unable to assign labels to the model's parameters. Please report", - "this problem to the `parameters` Issue Tracker:", - "https://github.com/easystats/parameters/issues" + "Unable to assign labels to the model's parameters. Please report", + "this problem to the `parameters` Issue Tracker:", + "https://github.com/easystats/parameters/issues" ), call. = FALSE) } } diff --git a/R/methods_multcomp.R b/R/methods_multcomp.R index 1c345dd0b..48b8aa5f8 100644 --- a/R/methods_multcomp.R +++ b/R/methods_multcomp.R @@ -37,7 +37,6 @@ model_parameters.glht <- function(model, exponentiate = FALSE, verbose = TRUE, ...) { - # p-adjustment method s <- summary(model) p_adjust <- s$test$type @@ -63,7 +62,6 @@ model_parameters.glht <- function(model, #' @export ci.glht <- function(x, ci = .95, ...) { - # backward compatibility with `robust` argument dots <- list(...) if ("robust" %in% names(dots) && !"vcov" %in% names(dots)) { diff --git a/R/methods_nlme.R b/R/methods_nlme.R index a3fd6d707..bf637cfcc 100644 --- a/R/methods_nlme.R +++ b/R/methods_nlme.R @@ -62,7 +62,6 @@ p_value.lme <- function(model, vcov = NULL, vcov_args = NULL, ...) { - # default values if (is.null(vcov)) { cs <- stats::coef(summary(model)) diff --git a/R/methods_psych.R b/R/methods_psych.R index a3bea4281..2ef048ab0 100644 --- a/R/methods_psych.R +++ b/R/methods_psych.R @@ -88,7 +88,6 @@ #' #' # lavaan ------------------------------------- #' if (require("lavaan", quietly = TRUE)) { -#' #' # Confirmatory Factor Analysis (CFA) --------- #' #' structure <- " visual =~ x1 + x2 + x3 @@ -158,7 +157,6 @@ model_parameters.principal <- function(model, labels = NULL, verbose = TRUE, ...) { - # n n <- model$factors @@ -250,7 +248,6 @@ model_parameters.fa.ci <- model_parameters.fa #' @rdname model_parameters.principal #' @export model_parameters.omega <- function(model, verbose = TRUE, ...) { - # Table of omega coefficients table_om <- model$omega.group colnames(table_om) <- c("Omega_Total", "Omega_Hierarchical", "Omega_Group") diff --git a/R/methods_rstan.R b/R/methods_rstan.R index 97a32c8b3..8ad384b05 100644 --- a/R/methods_rstan.R +++ b/R/methods_rstan.R @@ -18,7 +18,6 @@ model_parameters.stanfit <- function(model, parameters = keep, verbose = TRUE, ...) { - # Processing params <- .extract_parameters_bayesian( model, diff --git a/R/methods_rstanarm.R b/R/methods_rstanarm.R index ebad5f36f..0f3b34f2d 100644 --- a/R/methods_rstanarm.R +++ b/R/methods_rstanarm.R @@ -79,8 +79,6 @@ model_parameters.stanreg <- function(model, parameters = keep, verbose = TRUE, ...) { - - # Processing params <- .extract_parameters_bayesian( model, @@ -149,8 +147,6 @@ model_parameters.stanmvreg <- function(model, parameters = keep, verbose = TRUE, ...) { - - # Processing params <- .extract_parameters_bayesian( model, diff --git a/R/parameters_type.R b/R/parameters_type.R index b8a7d00ae..b26846401 100644 --- a/R/parameters_type.R +++ b/R/parameters_type.R @@ -54,7 +54,6 @@ #' @return A data frame. #' @export parameters_type <- function(model, ...) { - # Get info params <- data.frame( Parameter = insight::find_parameters(model, effects = "fixed", flatten = TRUE), @@ -161,7 +160,6 @@ parameters_type <- function(model, ...) { #' @keywords internal .parameters_type <- function(name, data, reference) { if (grepl(":", name, fixed = TRUE)) { - # Split var <- unlist(strsplit(name, ":", fixed = TRUE)) if (length(var) > 2) { diff --git a/R/pool_parameters.R b/R/pool_parameters.R index d3fe5e501..d76dd95ec 100644 --- a/R/pool_parameters.R +++ b/R/pool_parameters.R @@ -52,7 +52,6 @@ pool_parameters <- function(x, component = "conditional", verbose = TRUE, ...) { - # check input, save original model ----- original_model <- random_params <- NULL diff --git a/R/print_html.R b/R/print_html.R index d4dee8788..1d00cb6d2 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -108,7 +108,6 @@ print_html.compare_parameters <- function(x, footer = NULL, style = NULL, ...) { - # check if user supplied digits attributes if (missing(digits)) { digits <- .additional_arguments(x, "digits", digits) diff --git a/R/robust_estimation.R b/R/robust_estimation.R index 1c32e96f2..ad7659625 100644 --- a/R/robust_estimation.R +++ b/R/robust_estimation.R @@ -11,7 +11,6 @@ standard_error_robust <- function(model, vcov_args = NULL, component = "conditional", ...) { - # exceptions if (inherits(model, "gee")) { return(standard_error(model, ...)) @@ -41,7 +40,6 @@ p_value_robust <- function(model, component = "conditional", method = NULL, ...) { - # exceptions if (inherits(model, "gee")) { return(p_value(model, ...)) diff --git a/R/sort_parameters.R b/R/sort_parameters.R index 1bacb6940..7d6a0c11f 100644 --- a/R/sort_parameters.R +++ b/R/sort_parameters.R @@ -39,10 +39,10 @@ sort_parameters.default <- function(x, sort = "none", column = "Coefficient", .. } # new row indices to use for sorting - new_row_order <- switch(sort, - "ascending" = order(x[[column]], decreasing = FALSE), - "descending" = order(x[[column]], decreasing = TRUE) - ) + new_row_order <- switch(sort, + "ascending" = order(x[[column]], decreasing = FALSE), + "descending" = order(x[[column]], decreasing = TRUE) + ) x[new_row_order, ] } diff --git a/R/standardize_info.R b/R/standardize_info.R index b0a87129b..2c0122124 100644 --- a/R/standardize_info.R +++ b/R/standardize_info.R @@ -114,8 +114,8 @@ standardize_info.default <- function(model, # Pseudo (for LMM) if (include_pseudo && - mi$is_mixed && - length(insight::find_random(model)$random) == 1) { + mi$is_mixed && + length(insight::find_random(model)$random) == 1) { out <- merge( out, .std_info_pseudo( @@ -299,7 +299,7 @@ standardize_info.default <- function(model, for (i in seq_along(names(model_matrix))) { var <- names(model_matrix)[i] if (any(types$Parameter == var) && - types$Link[types$Parameter == var] == "Difference") { + types$Link[types$Parameter == var] == "Difference") { parent_var <- types$Variable[types$Parameter == var] intercept <- unique(data[[parent_var]])[1] response_at_intercept <- response[data[[parent_var]] == intercept] diff --git a/R/standardize_posteriors.R b/R/standardize_posteriors.R index 0584ade05..d07e4477a 100644 --- a/R/standardize_posteriors.R +++ b/R/standardize_posteriors.R @@ -58,7 +58,7 @@ standardise_posteriors <- standardize_posteriors if (robust && method == "pseudo") { warning("'robust' standardization not available for 'pseudo' method.", - call. = FALSE + call. = FALSE ) robust <- FALSE } diff --git a/R/utils.R b/R/utils.R index 1e7513474..dfcc82bae 100644 --- a/R/utils.R +++ b/R/utils.R @@ -88,7 +88,8 @@ NULL } ) - if (is.null(model) || inherits(model, "parameters_model")) { # prevent self reference + if (is.null(model) || inherits(model, "parameters_model")) { + # prevent self reference model <- tryCatch( { get(obj_name, envir = globalenv()) diff --git a/R/utils_format.R b/R/utils_format.R index 1fc6bdb13..4a14bb64d 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -334,7 +334,6 @@ indent_parameters <- NULL if (is.list(groups)) { - # find parameter names and replace by rowindex group_rows <- lapply(groups, function(i) { if (is.character(i)) { @@ -373,7 +372,6 @@ } names(groups) <- names(group_rows) } else { - # find parameter names and replace by rowindex group_names <- names(groups) groups <- match(groups, x$Parameter) @@ -607,7 +605,6 @@ for (type in names(tables)) { - # do we have emmeans emlist? and contrasts? model_class <- attributes(tables[[type]])$model_class em_list_coef_name <- (!is.null(model_class) && "emm_list" %in% model_class && diff --git a/WIP/bootstrapping.Rmd b/WIP/bootstrapping.Rmd index b26a8a5a2..e4fc054de 100644 --- a/WIP/bootstrapping.Rmd +++ b/WIP/bootstrapping.Rmd @@ -21,9 +21,9 @@ bibliography: bibliography.bib ```{r message=FALSE, warning=FALSE, include=FALSE} library(knitr) -options(knitr.kable.NA = '') -knitr::opts_chunk$set(comment=">") -options(digits=2) +options(knitr.kable.NA = "") +knitr::opts_chunk$set(comment = ">") +options(digits = 2) if (!requireNamespace("ggplot2", quietly = TRUE) || !requireNamespace("parameters", quietly = TRUE) || @@ -32,9 +32,9 @@ if (!requireNamespace("ggplot2", quietly = TRUE) || knitr::opts_chunk$set(eval = FALSE) } else { library(parameters) -library(ggplot2) -library(poorman) -library(tidyr) + library(ggplot2) + library(poorman) + library(tidyr) } set.seed(333) @@ -70,7 +70,7 @@ df_long <- df %>% gather(Type, Distance) %>% mutate(Type = forcats::fct_relevel(Type, c("Coefficient", "Bootstrapped_1000", "Bootstrapped_4000"))) -df_long %>% +df_long %>% ggplot(aes(y = Distance, x = Type, fill = Type)) + geom_violin() + geom_hline(yintercept = 0, linetype = "dashed") + @@ -96,7 +96,7 @@ bayestestR::bayesfactor(BayesFactor::ttestBF(df$Bootstrapped_4000)) ```{r message=FALSE, warning=FALSE} library(emmeans) -lm(Distance ~ Type, data = df_long) %>% +lm(Distance ~ Type, data = df_long) %>% emmeans::emmeans(~Type) ``` diff --git a/WIP/extract_random_variances.R b/WIP/extract_random_variances.R index 85c9671b7..2e929c873 100644 --- a/WIP/extract_random_variances.R +++ b/WIP/extract_random_variances.R @@ -116,20 +116,23 @@ ci_method = NULL, verbose = FALSE, ...) { - varcorr <- .get_variance_information(model, component) ran_intercept <- tryCatch(data.frame(.random_intercept_variance(varcorr)), - error = function(e) NULL) + error = function(e) NULL + ) ran_slope <- tryCatch(data.frame(.random_slope_variance(model, varcorr)), - error = function(e) NULL) + error = function(e) NULL + ) ran_corr <- tryCatch(data.frame(.random_slope_intercept_corr(model, varcorr)), - error = function(e) NULL) + error = function(e) NULL + ) ran_slopes_corr <- tryCatch(data.frame(.random_slopes_corr(model, varcorr)), - error = function(e) NULL) + error = function(e) NULL + ) # sigma/dispersion only once, @@ -302,7 +305,6 @@ # extract CI for random SD ------------------------ .random_sd_ci <- function(model, out, ci_method, ci, corr_param, sigma_param, component = NULL, verbose = FALSE) { - ## TODO needs to be removed once MCM > 0.1.5 is on CRAN if (grepl("^mcm_lmer", insight::safe_deparse(insight::get_call(model)))) { return(out) @@ -338,7 +340,6 @@ # Wald based CIs # see https://stat.ethz.ch/pipermail/r-sig-mixed-models/2022q1/029985.html if (all(insight::check_if_installed(c("merDeriv", "lme4"), quietly = TRUE))) { - # this may fail, so wrap in try-catch tryCatch( { @@ -444,8 +445,8 @@ message(insight::format_message("Argument 'nAGQ' needs to be larger than 0 to compute confidence intervals for random effect parameters.")) } if (grepl("exactly singular", e$message, fixed = TRUE) || - grepl("computationally singular", e$message, fixed = TRUE) || - grepl("Exact singular", e$message, fixed = TRUE)) { + grepl("computationally singular", e$message, fixed = TRUE) || + grepl("Exact singular", e$message, fixed = TRUE)) { message(insight::format_message( "Cannot compute standard errors and confidence intervals for random effects parameters.", "Your model may suffer from singularity (see '?lme4::isSingular' and '?performance::check_singularity')." @@ -618,7 +619,6 @@ # store essential information about variance components... # basically, this function should return lme4::VarCorr(x) .get_variance_information <- function(model, model_component = "conditional") { - # reason to be installed reason <- "to compute random effect variances for mixed models" diff --git a/WIP/model_parameters_robust.Rmd b/WIP/model_parameters_robust.Rmd index 8ad77e98b..1a4a8e926 100644 --- a/WIP/model_parameters_robust.Rmd +++ b/WIP/model_parameters_robust.Rmd @@ -21,14 +21,14 @@ bibliography: bibliography.bib ```{r message=FALSE, warning=FALSE, include=FALSE} library(knitr) -options(knitr.kable.NA = '') +options(knitr.kable.NA = "") options(digits = 2) knitr::opts_chunk$set(comment = "#>") if (!requireNamespace("poorman", quietly = TRUE) || - !requireNamespace("clubSandwich", quietly = TRUE) || - !requireNamespace("sandwich", quietly = TRUE) || - !requireNamespace("lme4", quietly = TRUE)) { + !requireNamespace("clubSandwich", quietly = TRUE) || + !requireNamespace("sandwich", quietly = TRUE) || + !requireNamespace("lme4", quietly = TRUE)) { knitr::opts_chunk$set(eval = FALSE) } else { library(parameters) @@ -85,9 +85,9 @@ Usually, clustered covariance matrix estimation is used when there is a cluster- iris$cluster <- factor(rep(LETTERS[1:8], length.out = nrow(iris))) # change estimation-type, defining additional arguments mp <- model_parameters( - model, - robust = TRUE, - vcov_estimation = "CL", + model, + robust = TRUE, + vcov_estimation = "CL", vcov_type = "HC1", vcov_args = list(cluster = iris$cluster) ) @@ -108,10 +108,10 @@ iris$cluster <- factor(rep(LETTERS[1:8], length.out = nrow(iris))) # cluster-robust estimation mp <- model_parameters( - model, - robust = TRUE, - vcov_estimation = "CR", - vcov_type = "CR1", + model, + robust = TRUE, + vcov_estimation = "CR", + vcov_type = "CR1", vcov_args = list(cluster = iris$cluster) ) mp @@ -155,10 +155,10 @@ model_parameters(model) # model parameters, cluster robust estimation for mixed models model_parameters( - model, - robust = TRUE, - vcov_estimation = "CR", - vcov_type = "CR1", + model, + robust = TRUE, + vcov_estimation = "CR", + vcov_type = "CR1", vcov_args = list(cluster = iris$grp) ) ``` @@ -170,11 +170,11 @@ Again, robust estimation can be combined with standardization for linear mixed m ```{r} # model parameters, cluster robust estimation on standardized mixed model model_parameters( - model, + model, standardize = "refit", - robust = TRUE, - vcov_estimation = "CR", - vcov_type = "CR1", + robust = TRUE, + vcov_estimation = "CR", + vcov_type = "CR1", vcov_args = list(cluster = iris$grp) ) ``` diff --git a/WIP/select_parameters.stanreg.R b/WIP/select_parameters.stanreg.R index 28c9c11c0..1c9cf86c3 100644 --- a/WIP/select_parameters.stanreg.R +++ b/WIP/select_parameters.stanreg.R @@ -39,7 +39,6 @@ select_parameters.brmsfit <- select_parameters.stanreg #' @keywords internal .reconstruct_formula <- function(parameters, model) { - # # Clean # if (utils::tail(parameters, 1) == "sigma") { # parameters <- parameters[1:length(parameters) - 1] diff --git a/tests/testthat/test-Hmisc.R b/tests/testthat/test-Hmisc.R index 6cb76efd7..fa9bb9a1a 100644 --- a/tests/testthat/test-Hmisc.R +++ b/tests/testthat/test-Hmisc.R @@ -5,23 +5,27 @@ test_that("issue 697", { set.seed(1) n <- 100 df <- data.frame( - y = round(runif(n), 2), - x1 = sample(c(-1, 0, 1), n, TRUE), - x2 = sample(c(-1, 0, 1), n, TRUE)) + y = round(runif(n), 2), + x1 = sample(c(-1, 0, 1), n, TRUE), + x2 = sample(c(-1, 0, 1), n, TRUE) + ) df$x1[c(0, 1, 2)] <- NA imputer <- suppressWarnings(Hmisc::transcan( - ~ x1 + x2, - data = df, - imputed = TRUE, - n.impute = 2, - pr = FALSE, - pl = FALSE)) - + ~ x1 + x2, + data = df, + imputed = TRUE, + n.impute = 2, + pr = FALSE, + pl = FALSE + )) + suppressWarnings( - mod <- Hmisc::fit.mult.impute( - y ~ x1 + x2, fitter = orm, xtrans = imputer, data = df, pr = FALSE) + mod <- Hmisc::fit.mult.impute( + y ~ x1 + x2, + fitter = orm, xtrans = imputer, data = df, pr = FALSE + ) ) - + expect_s3_class(parameters(mod), "parameters_model") expect_s3_class(standard_error(mod), "data.frame") expect_s3_class(p_value(mod), "data.frame") diff --git a/tests/testthat/test-compare_parameters.R b/tests/testthat/test-compare_parameters.R index 956a8ac6b..5e378cbfd 100644 --- a/tests/testthat/test-compare_parameters.R +++ b/tests/testthat/test-compare_parameters.R @@ -77,5 +77,4 @@ if (requiet("testthat") && requiet("parameters") && requiet("insight")) { out <- utils::capture.output(compare_parameters(m1, m2, column_names = c("linear model (m1)", "logistic reg. (m2)"))) expect_equal(out[1], "Parameter | linear model (m1) | logistic reg. (m2)") }) - } diff --git a/tests/testthat/test-glmer.R b/tests/testthat/test-glmer.R index 30a28c6c9..34a80e03f 100644 --- a/tests/testthat/test-glmer.R +++ b/tests/testthat/test-glmer.R @@ -1,10 +1,10 @@ .runThisTest <- Sys.getenv("RunAllparametersTests") == "yes" if (.runThisTest && - getRversion() >= "3.6.0" && - requiet("testthat") && - requiet("parameters") && - requiet("lme4")) { + getRversion() >= "3.6.0" && + requiet("testthat") && + requiet("parameters") && + requiet("lme4")) { data("cbpp") set.seed(123) model <- glmer( diff --git a/tests/testthat/test-glmmTMB.R b/tests/testthat/test-glmmTMB.R index c2d7d38cb..0e717d09e 100644 --- a/tests/testthat/test-glmmTMB.R +++ b/tests/testthat/test-glmmTMB.R @@ -1,10 +1,10 @@ .runThisTest <- Sys.getenv("RunAllparametersTests") == "yes" if (.runThisTest && - getRversion() >= "3.6.0" && - requiet("testthat") && - requiet("parameters") && - requiet("glmmTMB")) { + getRversion() >= "3.6.0" && + requiet("testthat") && + requiet("parameters") && + requiet("glmmTMB")) { data("fish") data("Salamanders") @@ -671,7 +671,8 @@ if (.runThisTest && out <- utils::capture.output(print(mp)) expect_equal( out, - c("# Fixed Effects", + c( + "# Fixed Effects", "", "Parameter | Log-Mean | SE | 95% CI | z | p", "---------------------------------------------------------------------", diff --git a/tests/testthat/test-mlm.R b/tests/testthat/test-mlm.R index c27b0c2dd..7e732ac9e 100644 --- a/tests/testthat/test-mlm.R +++ b/tests/testthat/test-mlm.R @@ -74,5 +74,4 @@ if (requiet("testthat") && requiet("parameters") && getRversion() >= "3.6.0") { expect_equal(p2$CI_low, ci[, 1], ignore_attr = TRUE) expect_equal(p2$CI_high, ci[, 2], ignore_attr = TRUE) }) - } diff --git a/tests/testthat/test-model_parameters.anova.R b/tests/testthat/test-model_parameters.anova.R index e8ce427dc..ce5cd6b18 100644 --- a/tests/testthat/test-model_parameters.anova.R +++ b/tests/testthat/test-model_parameters.anova.R @@ -43,20 +43,20 @@ if (.runThisTest && requiet("insight") && requiet("testthat") && requiet("parame test_that("linear hypothesis tests", { requiet("car") - mod.davis <- lm(weight ~ repwt, data=Davis) - + mod.davis <- lm(weight ~ repwt, data = Davis) + ## the following are equivalent: - p1 <- parameters(linearHypothesis(mod.davis, diag(2), c(0,1))) + p1 <- parameters(linearHypothesis(mod.davis, diag(2), c(0, 1))) p2 <- parameters(linearHypothesis(mod.davis, c("(Intercept) = 0", "repwt = 1"))) - p3 <- parameters(linearHypothesis(mod.davis, c("(Intercept)", "repwt"), c(0,1))) + p3 <- parameters(linearHypothesis(mod.davis, c("(Intercept)", "repwt"), c(0, 1))) p4 <- parameters(linearHypothesis(mod.davis, c("(Intercept)", "repwt = 1"))) expect_equal(p1, p2, ignore_attr = TRUE) expect_equal(p1, p3, ignore_attr = TRUE) expect_equal(p1, p4, ignore_attr = TRUE) expect_equal(nrow(p1), 2) expect_equal(p1$Parameter, c("(Intercept) = 0", "repwt = 1")) - - mod.duncan <- lm(prestige ~ income + education, data=Duncan) + + mod.duncan <- lm(prestige ~ income + education, data = Duncan) p <- parameters(linearHypothesis(mod.duncan, "1*income - 1*education + 1 = 1")) expect_equal(nrow(p), 1) expect_equal(p$Parameter, "income - education = 0") diff --git a/tests/testthat/test-model_parameters.aov_es_ci.R b/tests/testthat/test-model_parameters.aov_es_ci.R index cf95c2d36..568d9197d 100644 --- a/tests/testthat/test-model_parameters.aov_es_ci.R +++ b/tests/testthat/test-model_parameters.aov_es_ci.R @@ -134,7 +134,6 @@ if (requiet("insight") && requiet("effectsize") && requiet("testthat") && requie # stricter tests --------------------------------------------------------- if (requiet("car") && requiet("gam")) { - # aov ------------------------------------------------ test_that("works with aov", { diff --git a/tests/testthat/test-model_parameters.glm.R b/tests/testthat/test-model_parameters.glm.R index 84d400e55..19162c4fd 100644 --- a/tests/testthat/test-model_parameters.glm.R +++ b/tests/testthat/test-model_parameters.glm.R @@ -82,16 +82,18 @@ if (requiet("testthat") && requiet("parameters") && requiet("boot")) { # test printing for prevalence ratios clotting <- data.frame( - u = c(5,10,15,20,30,40,60,80,100), - lot1 = c(118,58,42,35,27,25,21,19,18), - lot2 = c(69,35,26,21,18,16,13,12,12)) + u = c(5, 10, 15, 20, 30, 40, 60, 80, 100), + lot1 = c(118, 58, 42, 35, 27, 25, 21, 19, 18), + lot2 = c(69, 35, 26, 21, 18, 16, 13, 12, 12) + ) m <- glm(lot1 ~ log(u), data = clotting, family = Gamma("log")) mp <- model_parameters(m, exponentiate = TRUE) test_that("model_parameters.glm - Gamma - print", { expect_equal( capture.output(mp), - c("Parameter | Prevalence Ratio | SE | 95% CI | t(7) | p", + c( + "Parameter | Prevalence Ratio | SE | 95% CI | t(7) | p", "---------------------------------------------------------------------------", "(Intercept) | 245.48 | 46.72 | [173.66, 351.67] | 28.92 | < .001", "u [log] | 0.55 | 0.03 | [ 0.49, 0.61] | -10.88 | < .001" diff --git a/tests/testthat/test-model_parameters.lqmm.R b/tests/testthat/test-model_parameters.lqmm.R index 172e2709e..d0830427e 100644 --- a/tests/testthat/test-model_parameters.lqmm.R +++ b/tests/testthat/test-model_parameters.lqmm.R @@ -39,7 +39,6 @@ if (FALSE && requiet("testthat") && requiet("lqmm") && requiet("parameters")) { # lqmm ----------------------- test_that("model_parameters - lqmm", { - # setup set.seed(123) diff --git a/tests/testthat/test-model_parameters.mixed.R b/tests/testthat/test-model_parameters.mixed.R index 6c5346055..fc0845cc3 100644 --- a/tests/testthat/test-model_parameters.mixed.R +++ b/tests/testthat/test-model_parameters.mixed.R @@ -1,10 +1,10 @@ .runThisTest <- Sys.getenv("RunAllparametersTests") == "yes" if (.runThisTest && - getRversion() >= "3.6.0" && - requiet("testthat") && - requiet("parameters") && - requiet("lme4")) { + getRversion() >= "3.6.0" && + requiet("testthat") && + requiet("parameters") && + requiet("lme4")) { data(mtcars) m1 <- lme4::lmer(wt ~ cyl + (1 | gear), data = mtcars) m2 <- lme4::glmer(vs ~ cyl + (1 | gear), data = mtcars, family = "binomial") diff --git a/tests/testthat/test-model_parameters_df.R b/tests/testthat/test-model_parameters_df.R index fd77d201e..e4c190da3 100644 --- a/tests/testthat/test-model_parameters_df.R +++ b/tests/testthat/test-model_parameters_df.R @@ -1,8 +1,6 @@ .runThisTest <- Sys.getenv("RunAllparametersTests") == "yes" if (.runThisTest && requiet("testthat") && requiet("parameters")) { - - # glm --------------------------- set.seed(123) diff --git a/tests/testthat/test-model_parameters_random_pars.R b/tests/testthat/test-model_parameters_random_pars.R index 036c21e1f..4382fa919 100644 --- a/tests/testthat/test-model_parameters_random_pars.R +++ b/tests/testthat/test-model_parameters_random_pars.R @@ -88,9 +88,11 @@ if (.runThisTest && expect_equal(mp$CI_low, c(16.7131, 21.12065, 24.1964, -0.36662, -0.59868, -0.93174, 24.18608), tolerance = 1e-3) expect_equal( mp$Parameter, - c("SD (Intercept)", "SD (Days2(3,6])", "SD (Days2(6,10])", "Cor (Intercept~Days2(3,6])", + c( + "SD (Intercept)", "SD (Days2(3,6])", "SD (Days2(6,10])", "Cor (Intercept~Days2(3,6])", "Cor (Intercept~Days2(6,10])", "Cor (Days2(3,6]~Days2(6,10])", - "SD (Observations)") + "SD (Observations)" + ) ) }) @@ -103,9 +105,11 @@ if (.runThisTest && expect_equal(mp$CI_low, c(16.713, 37.06178, 36.14261, -0.65336, -0.92243, -0.99569, 24.18612), tolerance = 1e-3) expect_equal( mp$Parameter, - c("SD (Days2(-1,3])", "SD (Days2(3,6])", "SD (Days2(6,10])", + c( + "SD (Days2(-1,3])", "SD (Days2(3,6])", "SD (Days2(6,10])", "Cor (Days2(-1,3]~Days2(3,6])", "Cor (Days2(-1,3]~Days2(6,10])", - "Cor (Days2(3,6]~Days2(6,10])", "SD (Observations)") + "Cor (Days2(3,6]~Days2(6,10])", "SD (Observations)" + ) ) }) @@ -117,9 +121,11 @@ if (.runThisTest && expect_true(all(is.na(mp$SE))) expect_equal( mp$Parameter, - c("SD (Intercept)", "SD (Days2(-1,3])", "SD (Days2(3,6])", "SD (Days2(6,10])", + c( + "SD (Intercept)", "SD (Days2(-1,3])", "SD (Days2(3,6])", "SD (Days2(6,10])", "Cor (Days2(-1,3]~Days2(3,6])", "Cor (Days2(-1,3]~Days2(6,10])", - "Cor (Days2(3,6]~Days2(6,10])", "SD (Observations)") + "Cor (Days2(3,6]~Days2(6,10])", "SD (Observations)" + ) ) }) @@ -132,9 +138,11 @@ if (.runThisTest && expect_equal(mp$CI_low, c(16.713, 37.06178, 36.14261, -0.65336, -0.92243, -0.99569, 24.18612), tolerance = 1e-3) expect_equal( mp$Parameter, - c("SD (Days2(-1,3])", "SD (Days2(3,6])", "SD (Days2(6,10])", + c( + "SD (Days2(-1,3])", "SD (Days2(3,6])", "SD (Days2(6,10])", "Cor (Days2(-1,3]~Days2(3,6])", "Cor (Days2(-1,3]~Days2(6,10])", - "Cor (Days2(3,6]~Days2(6,10])", "SD (Observations)") + "Cor (Days2(3,6]~Days2(6,10])", "SD (Observations)" + ) ) }) } diff --git a/tests/testthat/test-model_parameters_robust.R b/tests/testthat/test-model_parameters_robust.R index 2fd1d1f16..00b75a74f 100644 --- a/tests/testthat/test-model_parameters_robust.R +++ b/tests/testthat/test-model_parameters_robust.R @@ -124,7 +124,6 @@ if (requiet("testthat") && model <- lmer(Petal.Length ~ Sepal.Length + (1 | Species), data = iris) if (packageVersion("parameters") < "0.16.9.9") { - ## TODO this one actually is not correct. test_that("ci_ml1, robust", { diff --git a/tests/testthat/test-p_value.R b/tests/testthat/test-p_value.R index 214c40655..43de16d99 100644 --- a/tests/testthat/test-p_value.R +++ b/tests/testthat/test-p_value.R @@ -2,7 +2,7 @@ if (requiet("testthat") && requiet("parameters")) { test_that("p_value", { - expect_equal(p_value(c(1,1,1)), p_value(-c(1,1,1)), tolerance = 1e-3) + expect_equal(p_value(c(1, 1, 1)), p_value(-c(1, 1, 1)), tolerance = 1e-3) set.seed(123) x <- rnorm(100, mean = 1.5) diff --git a/tests/testthat/test-panelr.R b/tests/testthat/test-panelr.R index 2b18d0c1f..0f7cb9609 100644 --- a/tests/testthat/test-panelr.R +++ b/tests/testthat/test-panelr.R @@ -1,10 +1,10 @@ .runThisTest <- Sys.getenv("RunAllparametersTests") == "yes" if (.runThisTest && - getRversion() >= "3.6.0" && - requiet("testthat") && - requiet("parameters") && - requiet("panelr")) { + getRversion() >= "3.6.0" && + requiet("testthat") && + requiet("parameters") && + requiet("panelr")) { data("WageData") wages <- panel_data(WageData, id = id, wave = t) m1 <- wbm(lwage ~ lag(union) + wks | blk + fem | blk * lag(union), data = wages) diff --git a/tests/testthat/test-quantreg.R b/tests/testthat/test-quantreg.R index b68a79538..b1341413a 100644 --- a/tests/testthat/test-quantreg.R +++ b/tests/testthat/test-quantreg.R @@ -6,7 +6,6 @@ if (.runThisTest && requiet("tripack") && requiet("insight") && requiet("quantreg")) { - # rqss --------- data("CobarOre") diff --git a/tests/testthat/test-random_effects_ci-glmmTMB.R b/tests/testthat/test-random_effects_ci-glmmTMB.R index 0ada1aebf..68ac23e03 100644 --- a/tests/testthat/test-random_effects_ci-glmmTMB.R +++ b/tests/testthat/test-random_effects_ci-glmmTMB.R @@ -25,12 +25,11 @@ win_os <- tryCatch( ## TODO also check messages for profiled CI if (.runThisTest && win_os && - requiet("testthat") && - requiet("parameters") && - requiet("glmmTMB") && - requiet("lme4") && - packageVersion("glmmTMB") > "1.1.3") { - + requiet("testthat") && + requiet("parameters") && + requiet("glmmTMB") && + requiet("lme4") && + packageVersion("glmmTMB") > "1.1.3") { data(sleepstudy) data(cake) set.seed(123) @@ -53,7 +52,8 @@ if (.runThisTest && win_os && test_that("random effects CIs, two slopes, categorical", { expect_equal( mp1$CI_low, - c(28.9123, 5.03115, -1.87304, -2.42081, -3.2708, -2.57695, 0.21571, + c( + 28.9123, 5.03115, -1.87304, -2.42081, -3.2708, -2.57695, 0.21571, 4.17466, NaN, 0, 0.26247, 0.34089, 0.02477, 0.65731, 0.3902, 0.14685, 0.01322, 0.62182, 0.99915, NaN, NaN, NaN, -0.31609, -0.48806, NaN, -0.8346, NaN, -0.60153, NA, NA, NA, NA, NA, NA, @@ -65,7 +65,8 @@ if (.runThisTest && win_os && expect_equal( mp1$Parameter, - c("(Intercept)", "temperature.L", "temperature.Q", "temperature.C", + c( + "(Intercept)", "temperature.L", "temperature.Q", "temperature.C", "temperature^4", "temperature^5", "SD (Intercept)", "SD (Intercept)", "SD (temperature.L)", "SD (temperature.Q)", "SD (temperature.C)", "SD (temperature^4)", "SD (temperature^5)", "SD (temperature.L)", @@ -85,12 +86,14 @@ if (.runThisTest && win_os && "Cor (temperature.Q~temperature.C)", "Cor (temperature.Q~temperature^4)", "Cor (temperature.Q~temperature^5)", "Cor (temperature.C~temperature^4)", "Cor (temperature.C~temperature^5)", "Cor (temperature^4~temperature^5)", - "SD (Observations)") + "SD (Observations)" + ) ) expect_equal( mp1$Group, - c("", "", "", "", "", "", "recipe", "replicate", "recipe", "recipe", + c( + "", "", "", "", "", "", "recipe", "replicate", "recipe", "recipe", "recipe", "recipe", "recipe", "replicate", "replicate", "replicate", "replicate", "replicate", "recipe", "recipe", "recipe", "recipe", "recipe", "replicate", "replicate", "replicate", "replicate", @@ -113,8 +116,10 @@ if (.runThisTest && win_os && expect_equal( mp2$Parameter, - c("(Intercept)", "Days", "SD (Intercept)", "SD (Days)", "Cor (Intercept~Days)", - "SD (Observations)") + c( + "(Intercept)", "Days", "SD (Intercept)", "SD (Days)", "Cor (Intercept~Days)", + "SD (Observations)" + ) ) }) @@ -122,16 +127,19 @@ if (.runThisTest && win_os && test_that("random effects CIs, categorical slope-1", { expect_equal( mp3$CI_low, - c(31.20278, 4.35879, -2.63767, -2.80041, -3.54983, -3.16627, + c( + 31.20278, 4.35879, -2.63767, -2.80041, -3.54983, -3.16627, 0, NaN, NaN, 0, NaN, NaN, NaN, NaN, -0.49203, -0.41167, NaN, - NA, NA, NA, NA, NA, NA, NA, NA, NA, NaN, 7.08478), + NA, NA, NA, NA, NA, NA, NA, NA, NA, NaN, 7.08478 + ), tolerance = 1e-2, ignore_attr = TRUE ) expect_equal( mp3$Parameter, - c("(Intercept)", "temperature.L", "temperature.Q", "temperature.C", + c( + "(Intercept)", "temperature.L", "temperature.Q", "temperature.C", "temperature^4", "temperature^5", "SD (Intercept)", "SD (temperature.L)", "SD (temperature.Q)", "SD (temperature.C)", "SD (temperature^4)", "SD (temperature^5)", "Cor (Intercept~temperature.L)", "Cor (Intercept~temperature.Q)", @@ -141,15 +149,18 @@ if (.runThisTest && win_os && "Cor (temperature.L~temperature^5)", "Cor (temperature.Q~temperature.C)", "Cor (temperature.Q~temperature^4)", "Cor (temperature.Q~temperature^5)", "Cor (temperature.C~temperature^4)", "Cor (temperature.C~temperature^5)", - "Cor (temperature^4~temperature^5)", "SD (Observations)") + "Cor (temperature^4~temperature^5)", "SD (Observations)" + ) ) expect_equal( mp3$Group, - c("", "", "", "", "", "", "recipe", "recipe", "recipe", "recipe", + c( + "", "", "", "", "", "", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", - "recipe", "recipe", "recipe", "Residual") + "recipe", "recipe", "recipe", "Residual" + ) ) }) @@ -157,17 +168,20 @@ if (.runThisTest && win_os && test_that("random effects CIs, categorical slope-2", { expect_equal( mp4$CI_low, - c(29.01131, 5.01247, -1.89444, -1.96275, -2.66798, -2.50892, + c( + 29.01131, 5.01247, -1.89444, -1.96275, -2.66798, -2.50892, 4.23497, 0.62985, 0.36934, 0.1398, 0.01133, 0.60758, 0.56678, 0.26866, NaN, NaN, NaN, NA, NA, NA, NA, NA, NA, NA, NA, NA, NaN, - 4.23582), + 4.23582 + ), tolerance = 1e-2, ignore_attr = TRUE ) expect_equal( mp4$Parameter, - c("(Intercept)", "temperature.L", "temperature.Q", "temperature.C", + c( + "(Intercept)", "temperature.L", "temperature.Q", "temperature.C", "temperature^4", "temperature^5", "SD (Intercept)", "SD (temperature.L)", "SD (temperature.Q)", "SD (temperature.C)", "SD (temperature^4)", "SD (temperature^5)", "Cor (Intercept~temperature.L)", "Cor (Intercept~temperature.Q)", @@ -177,16 +191,19 @@ if (.runThisTest && win_os && "Cor (temperature.L~temperature^5)", "Cor (temperature.Q~temperature.C)", "Cor (temperature.Q~temperature^4)", "Cor (temperature.Q~temperature^5)", "Cor (temperature.C~temperature^4)", "Cor (temperature.C~temperature^5)", - "Cor (temperature^4~temperature^5)", "SD (Observations)") + "Cor (temperature^4~temperature^5)", "SD (Observations)" + ) ) expect_equal( mp4$Group, - c("", "", "", "", "", "", "replicate", "replicate", "replicate", + c( + "", "", "", "", "", "", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", - "replicate", "replicate", "replicate", "Residual") + "replicate", "replicate", "replicate", "Residual" + ) ) }) @@ -194,17 +211,21 @@ if (.runThisTest && win_os && test_that("random effects CIs, double slope", { expect_equal( mp5$CI_low, - c(238.40607, 7.52296, 15.01708, 3.80547, NaN, -0.48781, NaN, - NaN, 22.80046), + c( + 238.40607, 7.52296, 15.01708, 3.80547, NaN, -0.48781, NaN, + NaN, 22.80046 + ), tolerance = 1e-2, ignore_attr = TRUE ) expect_equal( mp5$Parameter, - c("(Intercept)", "Days", "SD (Intercept)", "SD (Days)", "SD (Months)", + c( + "(Intercept)", "Days", "SD (Intercept)", "SD (Days)", "SD (Months)", "Cor (Intercept~Days)", "Cor (Intercept~Months)", - "Cor (Days~Months)", "SD (Observations)") + "Cor (Days~Months)", "SD (Observations)" + ) ) }) @@ -249,8 +270,10 @@ if (.runThisTest && win_os && expect_equal( mp5$Parameter, - c("(Intercept)", "Days", "SD (Days)", "SD (Months)", "Cor (Days~Months)", - "SD (Observations)") + c( + "(Intercept)", "Days", "SD (Days)", "SD (Months)", "Cor (Days~Months)", + "SD (Observations)" + ) ) }) @@ -260,5 +283,4 @@ if (.runThisTest && win_os && mp2 <- model_parameters(m2, ci_method = "profile") expect_message(print(mp2), regexp = "(.*)profile-likelihood(.*)z-distribution(.*)") }) - -} \ No newline at end of file +} diff --git a/tests/testthat/test-random_effects_ci.R b/tests/testthat/test-random_effects_ci.R index ad6a699fa..b951187a4 100644 --- a/tests/testthat/test-random_effects_ci.R +++ b/tests/testthat/test-random_effects_ci.R @@ -15,10 +15,9 @@ osx <- tryCatch( ) if (.runThisTest && !osx && - requiet("testthat") && - requiet("parameters") && - requiet("lme4")) { - + requiet("testthat") && + requiet("parameters") && + requiet("lme4")) { data(sleepstudy) data(cake) set.seed(123) @@ -44,19 +43,22 @@ if (.runThisTest && !osx && test_that("random effects CIs, two slopes, categorical", { expect_equal( mp1$CI_low, - c(28.75568, 4.97893, -1.95002, -2.69995, -3.62201, -2.69102, + c( + 28.75568, 4.97893, -1.95002, -2.69995, -3.62201, -2.69102, 4.28558, 0.21474, 0.40062, 0.10169, 0.04953, 1e-05, 0.55398, 0, 2e-05, 0.6333, 1.09851, 0.00944, -0.65406, -0.69103, -1, -0.95271, -0.90617, -1, -1, -1, -1, -1, -1, -0.99802, -1, -0.75274, -0.99836, -1, -0.96895, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 4.07985), + -1, 4.07985 + ), tolerance = 1e-3, ignore_attr = TRUE ) expect_equal( mp1$Parameter, - c("(Intercept)", "temperature.L", "temperature.Q", "temperature.C", + c( + "(Intercept)", "temperature.L", "temperature.Q", "temperature.C", "temperature^4", "temperature^5", "SD (Intercept)", "SD (Intercept)", "SD (temperature.L)", "SD (temperature.Q)", "SD (temperature.C)", "SD (temperature^4)", "SD (temperature^5)", "SD (temperature.L)", @@ -76,19 +78,22 @@ if (.runThisTest && !osx && "Cor (temperature.Q~temperature.C)", "Cor (temperature.Q~temperature^4)", "Cor (temperature.Q~temperature^5)", "Cor (temperature.C~temperature^4)", "Cor (temperature.C~temperature^5)", "Cor (temperature^4~temperature^5)", - "SD (Observations)") + "SD (Observations)" + ) ) expect_equal( mp1$Group, - c("", "", "", "", "", "", "replicate", "recipe", "replicate", + c( + "", "", "", "", "", "", "replicate", "recipe", "replicate", "replicate", "replicate", "replicate", "replicate", "recipe", "recipe", "recipe", "recipe", "recipe", "replicate", "replicate", "replicate", "replicate", "replicate", "recipe", "recipe", "recipe", "recipe", "recipe", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "recipe", "recipe", "recipe", "recipe", "recipe", - "recipe", "recipe", "recipe", "recipe", "recipe", "Residual") + "recipe", "recipe", "recipe", "recipe", "recipe", "Residual" + ) ) }) @@ -106,8 +111,10 @@ if (.runThisTest && !osx && expect_equal( mp2$Parameter, - c("(Intercept)", "Days", "SD (Intercept)", "SD (Days)", "Cor (Intercept~Days)", - "SD (Observations)") + c( + "(Intercept)", "Days", "SD (Intercept)", "SD (Days)", "Cor (Intercept~Days)", + "SD (Observations)" + ) ) expect_equal( @@ -123,16 +130,19 @@ if (.runThisTest && !osx && test_that("random effects CIs, categorical slope-1", { expect_equal( mp3$CI_low, - c(30.91139, 4.33247, -2.6798, -3.20703, -4.07681, -3.27237, 0.06301, + c( + 30.91139, 4.33247, -2.6798, -3.20703, -4.07681, -3.27237, 0.06301, 0, 0, 0.1192, 0.32213, 0, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 7.09933), + -1, -1, -1, -1, -1, -1, 7.09933 + ), tolerance = 1e-3, ignore_attr = TRUE ) expect_equal( mp3$Parameter, - c("(Intercept)", "temperature.L", "temperature.Q", "temperature.C", + c( + "(Intercept)", "temperature.L", "temperature.Q", "temperature.C", "temperature^4", "temperature^5", "SD (Intercept)", "SD (temperature.L)", "SD (temperature.Q)", "SD (temperature.C)", "SD (temperature^4)", "SD (temperature^5)", "Cor (Intercept~temperature.L)", "Cor (Intercept~temperature.Q)", @@ -142,15 +152,18 @@ if (.runThisTest && !osx && "Cor (temperature.L~temperature^5)", "Cor (temperature.Q~temperature.C)", "Cor (temperature.Q~temperature^4)", "Cor (temperature.Q~temperature^5)", "Cor (temperature.C~temperature^4)", "Cor (temperature.C~temperature^5)", - "Cor (temperature^4~temperature^5)", "SD (Observations)") + "Cor (temperature^4~temperature^5)", "SD (Observations)" + ) ) expect_equal( mp3$Group, - c("", "", "", "", "", "", "recipe", "recipe", "recipe", "recipe", + c( + "", "", "", "", "", "", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", - "recipe", "recipe", "recipe", "Residual") + "recipe", "recipe", "recipe", "Residual" + ) ) }) @@ -161,17 +174,20 @@ if (.runThisTest && !osx && test_that("random effects CIs, categorical slope-2", { expect_equal( mp4$CI_low, - c(28.88523, 4.96796, -1.93239, -1.98597, -2.68858, -2.5524, 4.27899, + c( + 28.88523, 4.96796, -1.93239, -1.98597, -2.68858, -2.5524, 4.27899, 0.35378, 0.08109, 0.03419, 0, 0.49982, -0.68893, -0.71984, -1, -0.96725, -0.92158, -1, -0.99894, -1, -0.80378, -0.99924, -1, - -0.9778, -1, -1, -1, 4.21143), + -0.9778, -1, -1, -1, 4.21143 + ), tolerance = 1e-3, ignore_attr = TRUE ) expect_equal( mp4$Parameter, - c("(Intercept)", "temperature.L", "temperature.Q", "temperature.C", + c( + "(Intercept)", "temperature.L", "temperature.Q", "temperature.C", "temperature^4", "temperature^5", "SD (Intercept)", "SD (temperature.L)", "SD (temperature.Q)", "SD (temperature.C)", "SD (temperature^4)", "SD (temperature^5)", "Cor (Intercept~temperature.L)", "Cor (Intercept~temperature.Q)", @@ -181,16 +197,19 @@ if (.runThisTest && !osx && "Cor (temperature.L~temperature^5)", "Cor (temperature.Q~temperature.C)", "Cor (temperature.Q~temperature^4)", "Cor (temperature.Q~temperature^5)", "Cor (temperature.C~temperature^4)", "Cor (temperature.C~temperature^5)", - "Cor (temperature^4~temperature^5)", "SD (Observations)") + "Cor (temperature^4~temperature^5)", "SD (Observations)" + ) ) expect_equal( mp4$Group, - c("", "", "", "", "", "", "replicate", "replicate", "replicate", + c( + "", "", "", "", "", "", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", "replicate", - "replicate", "replicate", "replicate", "Residual") + "replicate", "replicate", "replicate", "Residual" + ) ) }) @@ -208,15 +227,19 @@ if (.runThisTest && !osx && expect_equal( mp5$Parameter, - c("(Intercept)", "Days", "SD (Intercept)", "SD (Days)", "SD (Months)", + c( + "(Intercept)", "Days", "SD (Intercept)", "SD (Days)", "SD (Months)", "Cor (Intercept~Days)", "Cor (Intercept~Months)", - "Cor (Days~Months)", "SD (Observations)") + "Cor (Days~Months)", "SD (Observations)" + ) ) expect_equal( mp5$Group, - c("", "", "Subject", "Subject", "Subject", "Subject", "Subject", - "Subject", "Residual") + c( + "", "", "Subject", "Subject", "Subject", "Subject", "Subject", + "Subject", "Residual" + ) ) }) @@ -259,8 +282,10 @@ if (.runThisTest && !osx && expect_equal( mp5$Parameter, - c("(Intercept)", "Days", "SD (Days)", "SD (Months)", "Cor (Days~Months)", - "SD (Observations)") + c( + "(Intercept)", "Days", "SD (Days)", "SD (Months)", "Cor (Days~Months)", + "SD (Observations)" + ) ) }) @@ -276,15 +301,18 @@ if (.runThisTest && !osx && test_that("random effects CIs, poly slope", { expect_equal( mp$CI_low, - c(28.7884, 33.56318, -12.84259, 4.27435, 0.16222, 7.78988, 0.87668, - -0.8172, -1, -1, 4.32855), + c( + 28.7884, 33.56318, -12.84259, 4.27435, 0.16222, 7.78988, 0.87668, + -0.8172, -1, -1, 4.32855 + ), tolerance = 1e-3, ignore_attr = TRUE ) expect_equal( mp$Parameter, - c("(Intercept)", "poly(temp, 2)1", "poly(temp, 2)2", "SD (Intercept)", + c( + "(Intercept)", "poly(temp, 2)1", "poly(temp, 2)2", "SD (Intercept)", "SD (Intercept)", "SD (poly(temp, 2)1)", "SD (poly(temp, 2)2)", "Cor (Intercept~poly(temp, 2)1)", "Cor (Intercept~poly(temp, 2)2)", "Cor (poly(temp, 2)1~poly(temp, 2)2)", "SD (Observations)" @@ -298,7 +326,8 @@ if (.runThisTest && !osx && # poly and categorical random slope -------------------------- m <- lmer(angle ~ poly(temp, 2) + (poly(temp, 2) | replicate) + (temperature | recipe), - data = cake) + data = cake + ) mp <- model_parameters(m, effects = "random") test_that("random effects CIs, poly categorical slope", { @@ -307,16 +336,19 @@ if (.runThisTest && !osx && expect_equal( mp$CI_low, - c(4.27846, 0.22005, 8.22659, 1.17579, 0, 5e-05, 0.37736, 1.24258, + c( + 4.27846, 0.22005, 8.22659, 1.17579, 0, 5e-05, 0.37736, 1.24258, 0, -0.77207, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 4.22056), + -1, -1, -1, -1, -1, 4.22056 + ), tolerance = 1e-3, ignore_attr = TRUE ) expect_equal( mp$Parameter, - c("SD (Intercept)", "SD (Intercept)", "SD (poly(temp, 2)1)", + c( + "SD (Intercept)", "SD (Intercept)", "SD (poly(temp, 2)1)", "SD (poly(temp, 2)2)", "SD (temperature.L)", "SD (temperature.Q)", "SD (temperature.C)", "SD (temperature^4)", "SD (temperature^5)", "Cor (Intercept~poly(temp, 2)1)", "Cor (Intercept~poly(temp, 2)2)", @@ -328,17 +360,19 @@ if (.runThisTest && !osx && "Cor (temperature.Q~temperature.C)", "Cor (temperature.Q~temperature^4)", "Cor (temperature.Q~temperature^5)", "Cor (temperature.C~temperature^4)", "Cor (temperature.C~temperature^5)", "Cor (temperature^4~temperature^5)", - "SD (Observations)") + "SD (Observations)" + ) ) expect_equal( mp$Group, - c("replicate", "recipe", "replicate", "replicate", "recipe", + c( + "replicate", "recipe", "replicate", "replicate", "recipe", "recipe", "recipe", "recipe", "recipe", "replicate", "replicate", "recipe", "recipe", "recipe", "recipe", "recipe", "replicate", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", "recipe", - "recipe", "recipe", "recipe", "Residual") + "recipe", "recipe", "recipe", "Residual" + ) ) }) - } diff --git a/tests/testthat/test-robust.R b/tests/testthat/test-robust.R index 06c21884f..d3ba26267 100644 --- a/tests/testthat/test-robust.R +++ b/tests/testthat/test-robust.R @@ -9,9 +9,6 @@ if (.runThisTest && requiet("ivreg") && requiet("AER") && requiet("sandwich")) { - - - # standard errors ------------------------------------- data(iris) diff --git a/tests/testthat/test-standardize_info.R b/tests/testthat/test-standardize_info.R index 162398714..249fbae65 100644 --- a/tests/testthat/test-standardize_info.R +++ b/tests/testthat/test-standardize_info.R @@ -1,6 +1,6 @@ if (requiet("testthat") && requiet("parameters") && requiet("nlme") && requiet("lme4")) { data("mtcars") - fm1 <- lme(mpg ~ cyl, mtcars, random = ~ 1| gear) + fm1 <- lme(mpg ~ cyl, mtcars, random = ~ 1 | gear) fm2 <- gls(mpg ~ cyl, mtcars) i1 <- standardize_info(fm1) diff --git a/tests/testthat/test-wrs2.R b/tests/testthat/test-wrs2.R index b6132ec4c..f312b56c1 100644 --- a/tests/testthat/test-wrs2.R +++ b/tests/testthat/test-wrs2.R @@ -1,5 +1,4 @@ if (requiet("testthat") && requiet("WRS2") && packageVersion("WRS2") >= "1.1.3" && getRversion() >= "3.6.0") { - # model_parameters.t1way --------------------------------------------------- test_that("model_parameters.t1way", { diff --git a/vignettes/clustering.Rmd b/vignettes/clustering.Rmd index dbe7c5675..f6f46d8c7 100644 --- a/vignettes/clustering.Rmd +++ b/vignettes/clustering.Rmd @@ -72,19 +72,19 @@ library(ggplot2) library(parameters) library(see) -set.seed(33) # Set random seed +set.seed(33) # Set random seed # Select the first 4 numeric columns (drop the Species fator) -data <- iris[1:4] -head(data) # Print the 6 first rows +data <- iris[1:4] +head(data) # Print the 6 first rows # Run PCA pca <- principal_components(data, n = 2) pca_scores <- predict(pca, names = c("PCA_1", "PCA_2")) -pca_scores$True_Clusters <- iris$Species # Add real clusters +pca_scores$True_Clusters <- iris$Species # Add real clusters # Visualize -ggplot(pca_scores, aes(x = PCA_1, y = PCA_2, color = True_Clusters)) + +ggplot(pca_scores, aes(x = PCA_1, y = PCA_2, color = True_Clusters)) + geom_point() + theme_modern() ``` @@ -122,20 +122,20 @@ Now that we know how many clusters we want to extract (let's say that we have a ```{r} rez_kmeans <- cluster_analysis(data, n = 3, method = "kmeans") -rez_kmeans # Show results +rez_kmeans # Show results ``` Note that we can also visualize the **centers** (i.e., the "average" of each variable for each cluster): ```{r} -plot(summary(rez_kmeans)) # Visualize cluster centers +plot(summary(rez_kmeans)) # Visualize cluster centers ``` One can extract the cluster assignments to use it as a new variable by using `predict()`. ```{r} -predict(rez_kmeans) # Get clusters +predict(rez_kmeans) # Get clusters ``` @@ -147,10 +147,10 @@ Hierarchical clustering is also a common clustering algorithm, available in base ```{r} rez_hclust <- cluster_analysis(data, n = 3, method = "hclust") -rez_hclust # Show results +rez_hclust # Show results # Visualize -plot(rez_hclust) + theme_modern() # Visualize +plot(rez_hclust) + theme_modern() # Visualize ``` ### Hierarchical K-Means @@ -160,10 +160,10 @@ Hierarchical K-Means, as its name suggest, is essentially a combination of K-Mea ```{r} rez_hkmeans <- cluster_analysis(data, n = 3, method = "hkmeans") -rez_hkmeans # Show results +rez_hkmeans # Show results # Visualize -plot(rez_hkmeans) + theme_modern() # Visualize +plot(rez_hkmeans) + theme_modern() # Visualize ``` ### K-Medoids (PAM) @@ -173,10 +173,10 @@ Clustering around "medoids", instead of "centroid", is considered to be a more r ```{r} rez_pam <- cluster_analysis(data, n = 3, method = "pam") -rez_pam # Show results +rez_pam # Show results # Visualize -plot(rez_pam) + theme_modern() # Visualize +plot(rez_pam) + theme_modern() # Visualize ``` @@ -189,14 +189,15 @@ Unsupervised clustering methods estimate the optimal number of clusters themselv This method computes p-values for each cluster of the hierarchical cluster structure, and returns the **significant** clusters. This method can return a larger number of smaller clusters and, because it's based on bootstrapping, is quite slow. ```{r} -rez_hclust2 <- cluster_analysis(data, - n = NULL, - method = "hclust", - iterations = 500, - ci = 0.90) - -rez_hclust2 # Show results -plot(rez_hclust2) + theme_modern() # Visualize +rez_hclust2 <- cluster_analysis(data, + n = NULL, + method = "hclust", + iterations = 500, + ci = 0.90 +) + +rez_hclust2 # Show results +plot(rez_hclust2) + theme_modern() # Visualize ``` @@ -207,7 +208,7 @@ Although the DBSCAN method is quite powerful to identify clusters, it is highly The "optimal" **eps** value can be estimated using the [`n_clusters_dbscan()`](https://easystats.github.io/parameters/reference/cluster_analysis.html) function: ```{r} -eps <- n_clusters_dbscan(data, min_size = 0.1) +eps <- n_clusters_dbscan(data, min_size = 0.1) eps plot(eps) ``` @@ -217,8 +218,8 @@ It seems like the numeric method to find the elbow of the curve doesn't work wel ```{r} rez_dbscan <- cluster_analysis(data, method = "dbscan", dbscan_eps = 1.45) -rez_dbscan # Show results -plot(rez_dbscan) + theme_modern() # Visualize +rez_dbscan # Show results +plot(rez_dbscan) + theme_modern() # Visualize ``` ### Hierarchical K-Means @@ -228,10 +229,10 @@ Hierarchical DBSCAN is a variant that does not require the critical **EPS** argu ```{r} rez_hdbscan <- cluster_analysis(data, method = "hdbscan") -rez_hdbscan # Show results +rez_hdbscan # Show results # Visualize -plot(rez_hdbscan) + theme_modern() # Visualize +plot(rez_hdbscan) + theme_modern() # Visualize ``` @@ -242,10 +243,10 @@ This is K-Medoids with an integrated estimation of the number of clusters. See ` ```{r} rez_pamk <- cluster_analysis(data, method = "pamk") -rez_pamk # Show results +rez_pamk # Show results # Visualize -plot(rez_pamk) + theme_modern() # Visualize +plot(rez_pamk) + theme_modern() # Visualize ``` ### Mixture @@ -257,10 +258,10 @@ library(mclust) rez_mixture <- cluster_analysis(data, method = "mixture") -rez_mixture # Show results +rez_mixture # Show results # Visualize -plot(rez_mixture) + theme_modern() # Visualize +plot(rez_mixture) + theme_modern() # Visualize ``` ## Metaclustering @@ -271,14 +272,18 @@ Metaclustering is based on the hypothesis that, as each clustering algorithm emb ```{r} -list_of_results <- list(rez_kmeans, rez_hclust, rez_hkmeans, rez_pam, - rez_hclust2, rez_dbscan, rez_hdbscan, rez_mixture) +list_of_results <- list( + rez_kmeans, rez_hclust, rez_hkmeans, rez_pam, + rez_hclust2, rez_dbscan, rez_hdbscan, rez_mixture +) probability_matrix <- cluster_meta(list_of_results) # Plot the matrix as a reordered heatmap -heatmap(probability_matrix, scale = "none", - col = grDevices::hcl.colors(256, palette = "inferno")) +heatmap(probability_matrix, + scale = "none", + col = grDevices::hcl.colors(256, palette = "inferno") +) ``` @@ -290,4 +295,4 @@ The metaclustering approach confirms our initial hypothesis, *the **setosa** spe ## Resources - [Clustering algorithms overview](https://scikit-learn.org/stable/modules/clustering.html) -- [Density-based Clustering](https://www.datanovia.com/en/lessons/dbscan-density-based-clustering-essentials/) \ No newline at end of file +- [Density-based Clustering](https://www.datanovia.com/en/lessons/dbscan-density-based-clustering-essentials/) diff --git a/vignettes/efa_cfa.Rmd b/vignettes/efa_cfa.Rmd index 5db51c4f6..f53fa000b 100644 --- a/vignettes/efa_cfa.Rmd +++ b/vignettes/efa_cfa.Rmd @@ -242,7 +242,7 @@ performance::compare_performance(big5, big6) ```{r eval=FALSE, include=FALSE} -performance::test_likelihoodratio(big5, big6) # TODO: This doesn't work +performance::test_likelihoodratio(big5, big6) # TODO: This doesn't work ``` All in all, it seems that the Big-5 structure remains quite reliable. diff --git a/vignettes/model_parameters.Rmd b/vignettes/model_parameters.Rmd index 2915de1ee..b584e2a09 100644 --- a/vignettes/model_parameters.Rmd +++ b/vignettes/model_parameters.Rmd @@ -55,7 +55,6 @@ if (!requireNamespace("poorman", quietly = TRUE) || library(brms) library(GLMMadaptive) library(FactoMineR) - } set.seed(333) diff --git a/vignettes/model_parameters_print.Rmd b/vignettes/model_parameters_print.Rmd index ca0e4e709..224265b8a 100644 --- a/vignettes/model_parameters_print.Rmd +++ b/vignettes/model_parameters_print.Rmd @@ -74,9 +74,10 @@ Again by default, the argument `split_components` is `TRUE`, which means that mo library(glmmTMB) data("Salamanders") model <- glmmTMB(count ~ spp + mined + (1 | site), - ziformula = ~spp + mined, - family = nbinom2(), - data = Salamanders) + ziformula = ~ spp + mined, + family = nbinom2(), + data = Salamanders +) model_parameters(model) ``` @@ -121,14 +122,14 @@ data("Salamanders") levels(Salamanders$spp) <- paste("long", levels(Salamanders$spp)) model <- glmmTMB( - count ~ spp + mined + (1 | site), - ziformula = ~mined, - family = poisson(), - data = Salamanders + count ~ spp + mined + (1 | site), + ziformula = ~mined, + family = poisson(), + data = Salamanders ) # default printing -model_parameters(model) +model_parameters(model) ``` The `column_width` argument can be used to either define the width of specific columns, or to fix column widths of the same columns across tables to have the same width. In the latter case, use `column_width = "fixed"` in the `print()` method. @@ -169,19 +170,25 @@ Note that the parameters in the table summary are re-ordered according to the or ```{r} # group parameters, either by parameter name or position -print(mp, groups = list("Engine" = c("cyl6", "cyl8", "vs", "hp"), - "Interactions" = c("gear4:vs", "gear5:vs"), - "Controls" = c(2, 3, 7))) # gear 4 and 5, drat +print(mp, groups = list( + "Engine" = c("cyl6", "cyl8", "vs", "hp"), + "Interactions" = c("gear4:vs", "gear5:vs"), + "Controls" = c(2, 3, 7) +)) # gear 4 and 5, drat ``` If you prefer tables without vertical borders, use the `sep` argument to define the string that is used as border-separator. This argument is passed down to `insight::export_table()`. ```{r} # group parameters, either by parameter name or position -print(mp, sep = " ", - groups = list("Engine" = c("cyl6", "cyl8", "vs", "hp"), - "Interactions" = c("gear4:vs", "gear5:vs"), - "Controls" = c(2, 3, 7))) +print(mp, + sep = " ", + groups = list( + "Engine" = c("cyl6", "cyl8", "vs", "hp"), + "Interactions" = c("gear4:vs", "gear5:vs"), + "Controls" = c(2, 3, 7) + ) +) ``` # Summaries for multiple models @@ -232,11 +239,17 @@ cp <- compare_parameters(lm1, lm2, drop = "^\\(Intercept") as.data.frame(cp)$Parameter # create groups. Interactions only present in 2nd model -print(cp, groups = list(Species = c("Species (versicolor)", - "Species (virginica)"), - Interactions = c("Species (versicolor) * Petal Length", - "Species (virginica) * Petal Length"), - Controls = "Petal Length")) +print(cp, groups = list( + Species = c( + "Species (versicolor)", + "Species (virginica)" + ), + Interactions = c( + "Species (versicolor) * Petal Length", + "Species (virginica) * Petal Length" + ), + Controls = "Petal Length" +)) ``` diff --git a/vignettes/standardize_parameters_effsize.Rmd b/vignettes/standardize_parameters_effsize.Rmd index e16d187f2..acb05a9b7 100644 --- a/vignettes/standardize_parameters_effsize.Rmd +++ b/vignettes/standardize_parameters_effsize.Rmd @@ -17,11 +17,13 @@ bibliography: bibliography.bib ```{r message=FALSE, warning=FALSE, include=FALSE} library(knitr) -knitr::opts_chunk$set(comment = ">", - warning = FALSE, - message = FALSE) +knitr::opts_chunk$set( + comment = ">", + warning = FALSE, + message = FALSE +) options(digits = 2) -options(knitr.kable.NA = '') +options(knitr.kable.NA = "") pkgs <- c("effectsize", "parameters", "correlation") if (!all(sapply(pkgs, requireNamespace, quietly = TRUE))) { @@ -103,7 +105,7 @@ standard deviation of `mpg` (because the response variable was standardized, right?). Let's compute the **Cohen's *d*** between these two levels: ```{r} -cohens_d(mpg ~ am, data = mtcars) +cohens_d(mpg ~ am, data = mtcars) ``` ***It is larger!*** Why? How? Both differences should be expressed in units of @@ -184,14 +186,15 @@ correlation::correlation( select = "salary", select2 = c("xtra_hours", "n_comps", "age", "seniority"), partial = TRUE # get partial correlations -) +) ``` Let's compare these to the standardized slopes: ```{r} mod <- lm(salary ~ xtra_hours + n_comps + age + seniority, - data = hardlyworking) + data = hardlyworking +) standardize_parameters(mod) ``` @@ -221,10 +224,12 @@ Let's convert `age` into a 3-level factor: ```{r} hardlyworking$age_g <- cut(hardlyworking$age, - breaks = c(25,30,35,45)) + breaks = c(25, 30, 35, 45) +) mod <- lm(salary ~ xtra_hours + n_comps + age_g + seniority, - data = hardlyworking) + data = hardlyworking +) model_parameters(mod) ``` @@ -337,7 +342,7 @@ are also called *pseudo*-standardized coefficients.[^Note that like method `"basic"`, these are based on the model matrix.] ```{r, eval=knitr::opts_chunk$get("eval") && require(lme4) && require(lmerTest), warning=FALSE} -m <- lme4::lmer(Reaction ~ Days + (Days|Subject), data = lme4::sleepstudy) +m <- lme4::lmer(Reaction ~ Days + (Days | Subject), data = lme4::sleepstudy) standardize_parameters(m, method = "pseudo", ci_method = "satterthwaite") @@ -362,8 +367,9 @@ predictors: ```{r} mod_b <- glm(am ~ mpg + factor(cyl), - data = mtcars, - family = binomial()) + data = mtcars, + family = binomial() +) standardize_parameters(mod_b, method = "refit", two_sd = TRUE) # standardize_parameters(mod_b, method = "posthoc", two_sd = TRUE) From 9f43f55fb6f9547d71021601cd0510b4e30e68e6 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 7 Jul 2022 08:57:37 +0200 Subject: [PATCH 18/21] https://github.com/easystats/report/issues/263 --- R/extract_parameters_anova.R | 2 +- R/methods_aov.R | 10 ++++++++-- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/R/extract_parameters_anova.R b/R/extract_parameters_anova.R index 11d535a72..d6a40b746 100644 --- a/R/extract_parameters_anova.R +++ b/R/extract_parameters_anova.R @@ -307,7 +307,7 @@ if (requireNamespace("effectsize", quietly = TRUE)) { power <- tryCatch( { - cohens_f2 <- effectsize::cohens_f_squared(model, partial = TRUE) + cohens_f2 <- effectsize::cohens_f_squared(model, partial = TRUE, verbose = FALSE) f2 <- cohens_f2$Cohens_f2[match(cohens_f2$Parameter, params$Parameter)] u <- params$df[params$Parameter != "Residuals"] diff --git a/R/methods_aov.R b/R/methods_aov.R index db7a4b4ec..1d6e8c05a 100644 --- a/R/methods_aov.R +++ b/R/methods_aov.R @@ -162,7 +162,7 @@ model_parameters.aov <- function(model, df_error = df_error, ci = ci, alternative = alternative, - verbose = verbose + verbose = FALSE # we get messages for contrasts before ) # add power, if possible @@ -457,7 +457,7 @@ model_parameters.maov <- model_parameters.aov # set error-df, when provided. if (!is.null(df_error) && is.data.frame(model) && !any(c("DenDF", "den Df", "denDF", "df_error") %in% colnames(model))) { if (length(df_error) > nrow(model)) { - stop("Number of degrees of freedom in argument 'df_error' is larger than number of parameters.") + stop(insight::format_message("Number of degrees of freedom in argument 'df_error' is larger than number of parameters."), call. = FALSE) } model$df_error <- df_error } @@ -483,6 +483,8 @@ model_parameters.maov <- model_parameters.aov alternative = alternative, verbose = verbose) parameters <- .add_effectsize_to_parameters(fx, parameters) + # avoid multiple messages + verbose <- FALSE } # Eta squared @@ -493,6 +495,8 @@ model_parameters.maov <- model_parameters.aov alternative = alternative, verbose = verbose) parameters <- .add_effectsize_to_parameters(fx, parameters) + # avoid multiple messages + verbose <- FALSE } # Epsilon squared @@ -503,6 +507,8 @@ model_parameters.maov <- model_parameters.aov alternative = alternative, verbose = verbose) parameters <- .add_effectsize_to_parameters(fx, parameters) + # avoid multiple messages + verbose <- FALSE } parameters From 97015bc48396eabe06753d826f208b85649eb59b Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 7 Jul 2022 10:51:47 +0200 Subject: [PATCH 19/21] avoid recycling --- R/pool_parameters.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/pool_parameters.R b/R/pool_parameters.R index d76dd95ec..02b500955 100644 --- a/R/pool_parameters.R +++ b/R/pool_parameters.R @@ -123,6 +123,10 @@ pool_parameters <- function(x, df_column <- colnames(i)[grepl("(\\bdf\\b|\\bdf_error\\b)", colnames(i))][1] if (length(df_column)) { pooled_df <- .barnad_rubin(m = nrow(i), b = stats::var(i$Coefficient), t = tmp, dfcom = unique(i[[df_column]])) + # sanity check length + if (length(pooled_df) > 1 && length(pooled_se) == 1) { + pooled_df <- round(mean(pooled_df, na.rm = TRUE)) + } } else { pooled_df <- Inf } From afbd53c38c564ea391a8c582374b9e1814defe53 Mon Sep 17 00:00:00 2001 From: Etienne Bacher <52219252+etiennebacher@users.noreply.github.com> Date: Mon, 11 Jul 2022 13:49:56 +0200 Subject: [PATCH 20/21] fix test for VGAM (#740) --- tests/testthat/test-model_parameters.vgam.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-model_parameters.vgam.R b/tests/testthat/test-model_parameters.vgam.R index df85f0bce..a79f91a9a 100644 --- a/tests/testthat/test-model_parameters.vgam.R +++ b/tests/testthat/test-model_parameters.vgam.R @@ -22,7 +22,7 @@ if (.runThisTest && requiet("testthat") && requiet("VGAM") && requiet("parameter params <- suppressWarnings(model_parameters(m1)) expect_equal(params$Coefficient, as.vector(m1@coefficients[params$Parameter]), tolerance = 1e-3) expect_equal(params$Parameter, c("(Intercept):1", "(Intercept):2", "exposure.time", "s(let)")) - expect_equal(params$df, c(NA, NA, NA, 2.77342), tolerance = 1e-3) + expect_equal(params$df, c(NA, NA, NA, 2.6501), tolerance = 1e-3) expect_equal(as.vector(na.omit(params$df)), as.vector(m1@nl.df), tolerance = 1e-3) }) From ad925c6998ae35fd91753e129ec196efe3d5abf3 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Jul 2022 12:36:32 +0200 Subject: [PATCH 21/21] version bump --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index dd3b06172..81aca474c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.18.1.7 +Version: 0.18.1.8 Authors@R: c(person(given = "Daniel", family = "Lüdecke",