From 2c9032c8f4e29fc676d5e8a18f284647ed66537b Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 18 Oct 2024 16:27:08 +0200 Subject: [PATCH 1/6] Use more informative check_arg --- R/2_ci.R | 2 +- R/bootstrap_model.R | 6 ++-- R/ci_generic.R | 12 +++++--- R/extract_random_variances.R | 2 +- R/methods_glmmTMB.R | 16 +++++----- R/methods_lme4.R | 14 ++++----- R/utils.R | 60 ++++++++++++++++++++++++++++++++++++ man/parameters-package.Rd | 2 +- man/simulate_model.Rd | 2 +- 9 files changed, 89 insertions(+), 27 deletions(-) diff --git a/R/2_ci.R b/R/2_ci.R index c010dcf37..da9cda820 100644 --- a/R/2_ci.R +++ b/R/2_ci.R @@ -73,7 +73,7 @@ ci.glm <- function(x, vcov_args = NULL, verbose = TRUE, ...) { - method <- match.arg(method, choices = c("profile", "wald", "normal", "residual")) + method <- .check_arg(method, c("profile", "wald", "normal", "residual")) # No robust vcov for profile method if (method == "profile") { diff --git a/R/bootstrap_model.R b/R/bootstrap_model.R index cdfc66109..e4d472a92 100644 --- a/R/bootstrap_model.R +++ b/R/bootstrap_model.R @@ -75,7 +75,7 @@ bootstrap_model.default <- function(model, insight::check_if_installed("boot") - type <- match.arg(type, choices = c("ordinary", "parametric", "balanced", "permutation", "antithetic")) + type <- .check_arg(type, c("ordinary", "parametric", "balanced", "permutation", "antithetic")) parallel <- match.arg(parallel) model_data <- data <- insight::get_data(model, verbose = FALSE) # nolint @@ -156,7 +156,7 @@ bootstrap_model.merMod <- function(model, ...) { insight::check_if_installed("lme4") - type <- match.arg(type, choices = c("parametric", "semiparametric")) + type <- .check_arg(type, c("parametric", "semiparametric")) parallel <- match.arg(parallel) boot_function <- function(model) { @@ -228,7 +228,7 @@ bootstrap_model.nestedLogit <- function(model, ...) { insight::check_if_installed("boot") - type <- match.arg(type, choices = c("ordinary", "balanced", "permutation", "antithetic")) + type <- .check_arg(type, c("ordinary", "balanced", "permutation", "antithetic")) parallel <- match.arg(parallel) model_data <- data <- insight::get_data(model, verbose = FALSE) # nolint diff --git a/R/ci_generic.R b/R/ci_generic.R index 1bfad93e3..248ac934e 100644 --- a/R/ci_generic.R +++ b/R/ci_generic.R @@ -17,11 +17,13 @@ if (is.null(method)) { method <- "wald" } - method <- match.arg(tolower(method), choices = c( - "wald", "ml1", "betwithin", "kr", - "satterthwaite", "kenward", "boot", - "profile", "residual", "normal" - )) + method <- tolower(method) + method <- .check_arg( + method, + c("wald", "ml1", "betwithin", "kr", "satterthwaite", "kenward", "boot", + "profile", "residual", "normal" + ) + ) effects <- match.arg(effects) component <- match.arg(component) diff --git a/R/extract_random_variances.R b/R/extract_random_variances.R index 9b042a79e..80ecc07a8 100644 --- a/R/extract_random_variances.R +++ b/R/extract_random_variances.R @@ -45,7 +45,7 @@ ci_random = NULL, verbose = FALSE, ...) { - component <- match.arg(component, choices = c("all", "conditional", "zero_inflated", "zi", "dispersion")) + component <- .check_arg(component, c("all", "conditional", "zero_inflated", "zi", "dispersion")) out <- suppressWarnings( .extract_random_variances_helper( diff --git a/R/methods_glmmTMB.R b/R/methods_glmmTMB.R index 26ad72dd1..2de626c2e 100644 --- a/R/methods_glmmTMB.R +++ b/R/methods_glmmTMB.R @@ -47,8 +47,8 @@ model_parameters.glmmTMB <- function(model, ci_method <- .check_df_method(ci_method) # which components to return? - effects <- match.arg(effects, choices = c("fixed", "random", "all")) - component <- match.arg(component, choices = c("all", "conditional", "zi", "zero_inflated", "dispersion")) + effects <- .check_arg(effects, c("fixed", "random", "all")) + component <- .check_arg(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) # standardize only works for fixed effects... if (!is.null(standardize) && standardize != "refit") { @@ -268,8 +268,8 @@ ci.glmmTMB <- function(x, verbose = TRUE, ...) { method <- tolower(method) - method <- match.arg(method, choices = c("wald", "normal", "ml1", "betwithin", "profile", "uniroot", "robust")) - component <- match.arg(component, choices = c("all", "conditional", "zi", "zero_inflated", "dispersion")) + method <- .check_arg(method, c("wald", "normal", "ml1", "betwithin", "profile", "uniroot", "robust")) + component <- .check_arg(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) if (is.null(.check_component(x, component, verbose = verbose))) { return(NULL) @@ -315,8 +315,8 @@ standard_error.glmmTMB <- function(model, component = "all", verbose = TRUE, ...) { - component <- match.arg(component, choices = c("all", "conditional", "zi", "zero_inflated", "dispersion")) - effects <- match.arg(effects, choices = c("fixed", "random")) + component <- .check_arg(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) + effects <- .check_arg(effects, c("fixed", "random")) dot_args <- .check_dots( dots = list(...), @@ -374,10 +374,10 @@ standard_error.glmmTMB <- function(model, #' @export simulate_model.glmmTMB <- function(model, iterations = 1000, - component = c("all", "conditional", "zi", "zero_inflated", "dispersion"), + component = "all", verbose = FALSE, ...) { - component <- match.arg(component) + component <- .check_arg(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) info <- insight::model_info(model, verbose = FALSE) ## TODO remove is.list() when insight 0.8.3 on CRAN diff --git a/R/methods_lme4.R b/R/methods_lme4.R index 4d55dac15..493c8cbc7 100644 --- a/R/methods_lme4.R +++ b/R/methods_lme4.R @@ -193,14 +193,14 @@ model_parameters.merMod <- function(model, ci_method <- tolower(ci_method) if (isTRUE(bootstrap)) { - ci_method <- match.arg( + ci_method <- .check_arg( ci_method, - choices = c("hdi", "quantile", "ci", "eti", "si", "bci", "bcai") + c("hdi", "quantile", "ci", "eti", "si", "bci", "bcai") ) } else { - ci_method <- match.arg( + ci_method <- .check_arg( ci_method, - choices = c( + c( "wald", "normal", "residual", "ml1", "betwithin", "satterthwaite", "kenward", "kr", "boot", "profile", "uniroot" ) @@ -208,7 +208,7 @@ model_parameters.merMod <- function(model, } # which component to return? - effects <- match.arg(effects, choices = c("fixed", "random", "all")) + effects <- .check_arg(effects, c("fixed", "random", "all")) params <- params_random <- params_variance <- NULL # post hoc standardize only works for fixed effects... @@ -343,7 +343,7 @@ ci.merMod <- function(x, iterations = 500, ...) { method <- tolower(method) - method <- match.arg(method, choices = c( + method <- .check_arg(method, c( "wald", "ml1", "betwithin", "kr", "satterthwaite", "kenward", "boot", "profile", "residual", "normal" @@ -379,7 +379,7 @@ standard_error.merMod <- function(model, vcov_args = NULL, ...) { dots <- list(...) - effects <- match.arg(effects, choices = c("fixed", "random")) + effects <- .check_arg(effects, c("fixed", "random")) if (effects == "random") { out <- .standard_errors_random(model) diff --git a/R/utils.R b/R/utils.R index 4725b710e..8f5eaeadf 100644 --- a/R/utils.R +++ b/R/utils.R @@ -220,6 +220,7 @@ ifnotfound } + .deprecated_warning <- function(old, new, verbose = TRUE) { if (verbose) { insight::format_warning(paste0( @@ -230,3 +231,62 @@ )) } } + + +# this is a wrapper around `match.arg()`, but provided clearer information on fail +.check_arg <- function(argument, options) { + argument_name <- deparse(substitute(argument)) + argument <- .safe(match.arg(argument, options)) + if (is.null(argument)) { + suggestion <- .misspelled_string(options, argument_name) + msg <- sprintf("Invalid option for argument `%s`.", argument_name) + if (is.null(suggestion) || !length(suggestion) || !nzchar(suggestion)) { + msg <- paste(msg, "Please use one of the following options:") + } else { + msg <- paste(msg, suggestion, "Else, use one of the following options:") + } + msg <- paste(msg, datawizard::text_concatenate(options, last = " or ", enclose = "\"")) + insight::format_error(msg) + } + argument +} + + +.misspelled_string <- function(source, searchterm, default_message = NULL) { + if (is.null(searchterm) || length(searchterm) < 1) { + return(default_message) + } + # used for many matches + more_found <- "" + # init default + msg <- "" + # remove matching strings + same <- intersect(source, searchterm) + searchterm <- setdiff(searchterm, same) + source <- setdiff(source, same) + # guess the misspelled string + possible_strings <- unlist(lapply(searchterm, function(s) { + source[.fuzzy_grep(source, s)] # nolint + }), use.names = FALSE) + if (length(possible_strings)) { + msg <- "Did you mean " + if (length(possible_strings) > 1) { + # make sure we don't print dozens of alternatives for larger data frames + if (length(possible_strings) > 5) { + more_found <- sprintf( + " We even found %i more possible matches, not shown here.", + length(possible_strings) - 5 + ) + possible_strings <- possible_strings[1:5] + } + msg <- paste0(msg, "one of ", datawizard::text_concatenate(possible_strings, last = " or ", enclose = "\"")) + } else { + msg <- paste0(msg, "\"", possible_strings, "\"") + } + msg <- paste0(msg, "?", more_found) + } else { + msg <- default_message + } + # no double white space + insight::trim_ws(msg) +} diff --git a/man/parameters-package.Rd b/man/parameters-package.Rd index b4e466b2c..fcdd44bf0 100644 --- a/man/parameters-package.Rd +++ b/man/parameters-package.Rd @@ -49,7 +49,7 @@ Other contributors: \item Vincent Arel-Bundock \email{vincent.arel-bundock@umontreal.ca} (\href{https://orcid.org/0000-0003-2042-7063}{ORCID}) [contributor] \item Jeffrey Girard \email{me@jmgirard.com} (\href{https://orcid.org/0000-0002-7359-3746}{ORCID}) [contributor] \item Christina Maimone \email{christina.maimone@northwestern.edu} [reviewer] - \item Niels Ohlsen (@Niels_Bremen) [reviewer] + \item Niels Ohlsen [reviewer] \item Douglas Ezra Morrison \email{dmorrison01@ucla.edu} (\href{https://orcid.org/0000-0002-7195-830X}{ORCID}) [contributor] \item Joseph Luchman \email{jluchman@gmail.com} (\href{https://orcid.org/0000-0002-8886-9717}{ORCID}) [contributor] } diff --git a/man/simulate_model.Rd b/man/simulate_model.Rd index e0a6a25a3..239417538 100644 --- a/man/simulate_model.Rd +++ b/man/simulate_model.Rd @@ -10,7 +10,7 @@ simulate_model(model, iterations = 1000, ...) \method{simulate_model}{glmmTMB}( model, iterations = 1000, - component = c("all", "conditional", "zi", "zero_inflated", "dispersion"), + component = "all", verbose = FALSE, ... ) From 732f9099fc296a5f8f077e9b884ec92c3d6a9b5e Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 18 Oct 2024 17:00:26 +0200 Subject: [PATCH 2/6] fix --- R/utils.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/R/utils.R b/R/utils.R index 8f5eaeadf..2f6ed1f67 100644 --- a/R/utils.R +++ b/R/utils.R @@ -290,3 +290,15 @@ # no double white space insight::trim_ws(msg) } + + +.fuzzy_grep <- function (x, pattern, precision = NULL) { + if (is.null(precision)) { + precision <- round(nchar(pattern) / 3) + } + if (precision > nchar(pattern)) { + return(NULL) + } + p <- sprintf("(%s){~%i}", pattern, precision) + grep(pattern = p, x = x, ignore.case = FALSE) +} From 3738931539daf964817963de073382426dcb85b5 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 18 Oct 2024 22:21:20 +0200 Subject: [PATCH 3/6] Update R/utils.R Co-authored-by: Brenton M. Wiernik --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index 2f6ed1f67..5f499dc58 100644 --- a/R/utils.R +++ b/R/utils.R @@ -243,7 +243,7 @@ if (is.null(suggestion) || !length(suggestion) || !nzchar(suggestion)) { msg <- paste(msg, "Please use one of the following options:") } else { - msg <- paste(msg, suggestion, "Else, use one of the following options:") + msg <- paste(msg, suggestion, "Otherwise, use one of the following options:") } msg <- paste(msg, datawizard::text_concatenate(options, last = " or ", enclose = "\"")) insight::format_error(msg) From dc7de24ebee58f3eb940a1e961b1f8300b4d4754 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 19 Oct 2024 10:42:59 +0200 Subject: [PATCH 4/6] replace with validate_argument --- DESCRIPTION | 1 + R/2_ci.R | 2 +- R/bootstrap_model.R | 6 +-- R/ci_generic.R | 2 +- R/extract_random_variances.R | 2 +- R/methods_glmmTMB.R | 14 +++---- R/methods_lme4.R | 10 ++--- R/utils.R | 71 ------------------------------------ 8 files changed, 19 insertions(+), 89 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 474f26cb3..945741cc6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -223,3 +223,4 @@ Config/testthat/edition: 3 Config/testthat/parallel: true Config/Needs/website: easystats/easystatstemplate Config/rcmdcheck/ignore-inconsequential-notes: true +Remotes: easystats/insight#938 diff --git a/R/2_ci.R b/R/2_ci.R index da9cda820..9a6da89f1 100644 --- a/R/2_ci.R +++ b/R/2_ci.R @@ -73,7 +73,7 @@ ci.glm <- function(x, vcov_args = NULL, verbose = TRUE, ...) { - method <- .check_arg(method, c("profile", "wald", "normal", "residual")) + method <- insight::validate_argument(method, c("profile", "wald", "normal", "residual")) # No robust vcov for profile method if (method == "profile") { diff --git a/R/bootstrap_model.R b/R/bootstrap_model.R index e4d472a92..71d0d11a6 100644 --- a/R/bootstrap_model.R +++ b/R/bootstrap_model.R @@ -75,7 +75,7 @@ bootstrap_model.default <- function(model, insight::check_if_installed("boot") - type <- .check_arg(type, c("ordinary", "parametric", "balanced", "permutation", "antithetic")) + type <- insight::validate_argument(type, c("ordinary", "parametric", "balanced", "permutation", "antithetic")) parallel <- match.arg(parallel) model_data <- data <- insight::get_data(model, verbose = FALSE) # nolint @@ -156,7 +156,7 @@ bootstrap_model.merMod <- function(model, ...) { insight::check_if_installed("lme4") - type <- .check_arg(type, c("parametric", "semiparametric")) + type <- insight::validate_argument(type, c("parametric", "semiparametric")) parallel <- match.arg(parallel) boot_function <- function(model) { @@ -228,7 +228,7 @@ bootstrap_model.nestedLogit <- function(model, ...) { insight::check_if_installed("boot") - type <- .check_arg(type, c("ordinary", "balanced", "permutation", "antithetic")) + type <- insight::validate_argument(type, c("ordinary", "balanced", "permutation", "antithetic")) parallel <- match.arg(parallel) model_data <- data <- insight::get_data(model, verbose = FALSE) # nolint diff --git a/R/ci_generic.R b/R/ci_generic.R index 248ac934e..19b5c9960 100644 --- a/R/ci_generic.R +++ b/R/ci_generic.R @@ -18,7 +18,7 @@ method <- "wald" } method <- tolower(method) - method <- .check_arg( + method <- insight::validate_argument( method, c("wald", "ml1", "betwithin", "kr", "satterthwaite", "kenward", "boot", "profile", "residual", "normal" diff --git a/R/extract_random_variances.R b/R/extract_random_variances.R index 80ecc07a8..c5f269cfe 100644 --- a/R/extract_random_variances.R +++ b/R/extract_random_variances.R @@ -45,7 +45,7 @@ ci_random = NULL, verbose = FALSE, ...) { - component <- .check_arg(component, c("all", "conditional", "zero_inflated", "zi", "dispersion")) + component <- insight::validate_argument(component, c("all", "conditional", "zero_inflated", "zi", "dispersion")) out <- suppressWarnings( .extract_random_variances_helper( diff --git a/R/methods_glmmTMB.R b/R/methods_glmmTMB.R index 2de626c2e..fde221f10 100644 --- a/R/methods_glmmTMB.R +++ b/R/methods_glmmTMB.R @@ -47,8 +47,8 @@ model_parameters.glmmTMB <- function(model, ci_method <- .check_df_method(ci_method) # which components to return? - effects <- .check_arg(effects, c("fixed", "random", "all")) - component <- .check_arg(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) + effects <- insight::validate_argument(effects, c("fixed", "random", "all")) + component <- insight::validate_argument(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) # standardize only works for fixed effects... if (!is.null(standardize) && standardize != "refit") { @@ -268,8 +268,8 @@ ci.glmmTMB <- function(x, verbose = TRUE, ...) { method <- tolower(method) - method <- .check_arg(method, c("wald", "normal", "ml1", "betwithin", "profile", "uniroot", "robust")) - component <- .check_arg(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) + method <- insight::validate_argument(method, c("wald", "normal", "ml1", "betwithin", "profile", "uniroot", "robust")) + component <- insight::validate_argument(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) if (is.null(.check_component(x, component, verbose = verbose))) { return(NULL) @@ -315,8 +315,8 @@ standard_error.glmmTMB <- function(model, component = "all", verbose = TRUE, ...) { - component <- .check_arg(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) - effects <- .check_arg(effects, c("fixed", "random")) + component <- insight::validate_argument(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) + effects <- insight::validate_argument(effects, c("fixed", "random")) dot_args <- .check_dots( dots = list(...), @@ -377,7 +377,7 @@ simulate_model.glmmTMB <- function(model, component = "all", verbose = FALSE, ...) { - component <- .check_arg(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) + component <- insight::validate_argument(component, c("all", "conditional", "zi", "zero_inflated", "dispersion")) info <- insight::model_info(model, verbose = FALSE) ## TODO remove is.list() when insight 0.8.3 on CRAN diff --git a/R/methods_lme4.R b/R/methods_lme4.R index 493c8cbc7..cc08a27e5 100644 --- a/R/methods_lme4.R +++ b/R/methods_lme4.R @@ -193,12 +193,12 @@ model_parameters.merMod <- function(model, ci_method <- tolower(ci_method) if (isTRUE(bootstrap)) { - ci_method <- .check_arg( + ci_method <- insight::validate_argument( ci_method, c("hdi", "quantile", "ci", "eti", "si", "bci", "bcai") ) } else { - ci_method <- .check_arg( + ci_method <- insight::validate_argument( ci_method, c( "wald", "normal", "residual", "ml1", "betwithin", "satterthwaite", @@ -208,7 +208,7 @@ model_parameters.merMod <- function(model, } # which component to return? - effects <- .check_arg(effects, c("fixed", "random", "all")) + effects <- insight::validate_argument(effects, c("fixed", "random", "all")) params <- params_random <- params_variance <- NULL # post hoc standardize only works for fixed effects... @@ -343,7 +343,7 @@ ci.merMod <- function(x, iterations = 500, ...) { method <- tolower(method) - method <- .check_arg(method, c( + method <- insight::validate_argument(method, c( "wald", "ml1", "betwithin", "kr", "satterthwaite", "kenward", "boot", "profile", "residual", "normal" @@ -379,7 +379,7 @@ standard_error.merMod <- function(model, vcov_args = NULL, ...) { dots <- list(...) - effects <- .check_arg(effects, c("fixed", "random")) + effects <- insight::validate_argument(effects, c("fixed", "random")) if (effects == "random") { out <- .standard_errors_random(model) diff --git a/R/utils.R b/R/utils.R index 5f499dc58..cb58d4e3e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -231,74 +231,3 @@ )) } } - - -# this is a wrapper around `match.arg()`, but provided clearer information on fail -.check_arg <- function(argument, options) { - argument_name <- deparse(substitute(argument)) - argument <- .safe(match.arg(argument, options)) - if (is.null(argument)) { - suggestion <- .misspelled_string(options, argument_name) - msg <- sprintf("Invalid option for argument `%s`.", argument_name) - if (is.null(suggestion) || !length(suggestion) || !nzchar(suggestion)) { - msg <- paste(msg, "Please use one of the following options:") - } else { - msg <- paste(msg, suggestion, "Otherwise, use one of the following options:") - } - msg <- paste(msg, datawizard::text_concatenate(options, last = " or ", enclose = "\"")) - insight::format_error(msg) - } - argument -} - - -.misspelled_string <- function(source, searchterm, default_message = NULL) { - if (is.null(searchterm) || length(searchterm) < 1) { - return(default_message) - } - # used for many matches - more_found <- "" - # init default - msg <- "" - # remove matching strings - same <- intersect(source, searchterm) - searchterm <- setdiff(searchterm, same) - source <- setdiff(source, same) - # guess the misspelled string - possible_strings <- unlist(lapply(searchterm, function(s) { - source[.fuzzy_grep(source, s)] # nolint - }), use.names = FALSE) - if (length(possible_strings)) { - msg <- "Did you mean " - if (length(possible_strings) > 1) { - # make sure we don't print dozens of alternatives for larger data frames - if (length(possible_strings) > 5) { - more_found <- sprintf( - " We even found %i more possible matches, not shown here.", - length(possible_strings) - 5 - ) - possible_strings <- possible_strings[1:5] - } - msg <- paste0(msg, "one of ", datawizard::text_concatenate(possible_strings, last = " or ", enclose = "\"")) - } else { - msg <- paste0(msg, "\"", possible_strings, "\"") - } - msg <- paste0(msg, "?", more_found) - } else { - msg <- default_message - } - # no double white space - insight::trim_ws(msg) -} - - -.fuzzy_grep <- function (x, pattern, precision = NULL) { - if (is.null(precision)) { - precision <- round(nchar(pattern) / 3) - } - if (precision > nchar(pattern)) { - return(NULL) - } - p <- sprintf("(%s){~%i}", pattern, precision) - grep(pattern = p, x = x, ignore.case = FALSE) -} From 45854026baac796a5092f61b6c06b7d5a1678c34 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 19 Oct 2024 10:43:26 +0200 Subject: [PATCH 5/6] desc --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 945741cc6..4b666a964 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.23.0 +Version: 0.23.0.1 Authors@R: c(person(given = "Daniel", family = "Lüdecke", From 241db43ad64716c56e2dffe910c7289919e8e8a1 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 19 Oct 2024 13:24:11 +0200 Subject: [PATCH 6/6] lintr, styler --- R/ci_generic.R | 3 ++- R/extract_random_variances.R | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/ci_generic.R b/R/ci_generic.R index 19b5c9960..1b7b49f82 100644 --- a/R/ci_generic.R +++ b/R/ci_generic.R @@ -20,7 +20,8 @@ method <- tolower(method) method <- insight::validate_argument( method, - c("wald", "ml1", "betwithin", "kr", "satterthwaite", "kenward", "boot", + c( + "wald", "ml1", "betwithin", "kr", "satterthwaite", "kenward", "boot", "profile", "residual", "normal" ) ) diff --git a/R/extract_random_variances.R b/R/extract_random_variances.R index c5f269cfe..368779fe8 100644 --- a/R/extract_random_variances.R +++ b/R/extract_random_variances.R @@ -28,7 +28,7 @@ # check for errors if (is.null(out) && isTRUE(verbose)) { - insight::format_warning("Something went wrong when calculating random effects parameters. Only showing model's fixed effects now. You may use `effects=\"fixed\"` to speed up the call to `model_parameters()`.") + insight::format_warning("Something went wrong when calculating random effects parameters. Only showing model's fixed effects now. You may use `effects=\"fixed\"` to speed up the call to `model_parameters()`.") # nolint } out @@ -208,7 +208,7 @@ ) # fix names for uncorrelated slope-intercepts - pattern <- paste0("(", paste0(insight::find_random(model, flatten = TRUE), collapse = "|"), ")\\.\\d+$") + pattern <- paste0("(", paste(insight::find_random(model, flatten = TRUE), collapse = "|"), ")\\.\\d+$") out$Group <- gsub(pattern, "\\1", out$Group) # remove non-used columns