Skip to content

Commit

Permalink
replace with validate_argument
Browse files Browse the repository at this point in the history
  • Loading branch information
strengejacke committed Oct 19, 2024
1 parent 3738931 commit dc7de24
Show file tree
Hide file tree
Showing 8 changed files with 19 additions and 89 deletions.
1 change: 1 addition & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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
2 changes: 1 addition & 1 deletion R/2_ci.R
Original file line number Diff line number Diff line change
Expand Up @@ -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") {
Expand Down
6 changes: 3 additions & 3 deletions R/bootstrap_model.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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) {
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion R/ci_generic.R
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
2 changes: 1 addition & 1 deletion R/extract_random_variances.R
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand Down
14 changes: 7 additions & 7 deletions R/methods_glmmTMB.R
Original file line number Diff line number Diff line change
Expand Up @@ -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") {
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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(...),
Expand Down Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions R/methods_lme4.R
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand All @@ -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...
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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)
Expand Down
71 changes: 0 additions & 71 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}

0 comments on commit dc7de24

Please sign in to comment.