replace with validate_argument

Author: strengejacke

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

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") {

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

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"

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(

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

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)

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)
-}