Bootstrap Argument in parameters::parameters() Function Not Working…

… with svyglm Models (#919) * Bootstrap Argument in `parameters::parameters()` Function Not Working with svyglm Models #918 * desc, news * fix * fix * fix * add test * fix * fix * fix * fix, lintr * fix * add tests * skip on cran * lintr * lintr
easystats · Nov 21, 2023 · 719c412 · 719c412
1 parent fd326fb
commit 719c412
Show file tree

Hide file tree

Showing 25 changed files with 354 additions and 233 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.21.3.2
+Version: 0.21.3.3
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -146,6 +146,7 @@ Suggests:
     lme4,
     lmerTest,
     lmtest,
+    logistf,
     logspline,
     lqmm,
     M3C,

diff --git a/NEWS.md b/NEWS.md
@@ -6,6 +6,11 @@
   `marginaleffects::predictions()` now defaults to `FALSE`, in line with all
   the other `model_parameters()` methods.
 
+## Changes
+
+* `model_parameters()` for models of package *survey* now gives informative
+  messages when `bootstrap = TRUE` (which is currently not supported).
+
 # parameters 0.21.3
 
 ## Changes

diff --git a/R/1_model_parameters.R b/R/1_model_parameters.R
@@ -576,14 +576,14 @@ model_parameters.default <- function(model,
       ci_method <- "quantile"
     }
 
-    args <- list(
+    fun_args <- list(
       model,
       iterations = iterations,
       ci = ci,
       ci_method = ci_method
     )
-    args <- c(args, dots)
-    params <- do.call("bootstrap_parameters", args)
+    fun_args <- c(fun_args, dots)
+    params <- do.call("bootstrap_parameters", fun_args)
 
     # Processing, non-bootstrapped parameters
   } else {
@@ -592,7 +592,7 @@ model_parameters.default <- function(model,
       ci_method <- "wald"
     }
 
-    args <- list(
+    fun_args <- list(
       model,
       ci = ci,
       component = component,
@@ -607,8 +607,8 @@ model_parameters.default <- function(model,
       vcov = vcov,
       vcov_args = vcov_args
     )
-    args <- c(args, dots)
-    params <- do.call(".extract_parameters_generic", args)
+    fun_args <- c(fun_args, dots)
+    params <- do.call(".extract_parameters_generic", fun_args)
   }
 
 
@@ -686,12 +686,12 @@ model_parameters.glm <- function(model,
   # tell user that profiled CIs don't respect vcov-args
   if (identical(ci_method, "profile") && (!is.null(vcov) || !is.null(vcov_args)) && isTRUE(verbose)) {
     insight::format_alert(
-      "When `ci_method=\"profile\"`, `vcov` only modifies standard errors, test-statistic and p-values, but not confidence intervals.",
+      "When `ci_method=\"profile\"`, `vcov` only modifies standard errors, test-statistic and p-values, but not confidence intervals.", # nolint
       "Use `ci_method=\"wald\"` to return confidence intervals based on robust standard errors."
     )
   }
 
-  args <- list(
+  fun_args <- list(
     model = model,
     ci = ci,
     ci_method = ci_method,
@@ -708,8 +708,8 @@ model_parameters.glm <- function(model,
     vcov_args = vcov_args,
     verbose = verbose
   )
-  args <- c(args, dots)
-  out <- do.call(".model_parameters_generic", args)
+  fun_args <- c(fun_args, dots)
+  out <- do.call(".model_parameters_generic", fun_args)
 
   attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(model))
   out

diff --git a/R/3_p_value.R b/R/3_p_value.R
@@ -105,13 +105,13 @@ p_value.default <- function(model,
     if (inherits(vcov, "data.frame") || "SE" %in% colnames(vcov)) {
       se <- vcov
     } else {
-      args <- list(model,
+      fun_args <- list(model,
         vcov_args = vcov_args,
         vcov = vcov,
         verbose = verbose
       )
-      args <- c(args, dots)
-      se <- do.call("standard_error", args)
+      fun_args <- c(fun_args, dots)
+      se <- do.call("standard_error", fun_args)
     }
 
     dof <- degrees_of_freedom(model, method = "wald", verbose = FALSE)

diff --git a/R/4_standard_error.R b/R/4_standard_error.R
@@ -88,8 +88,8 @@ standard_error.default <- function(model,
 
   # vcov: function which returns a matrix
   if (is.function(vcov)) {
-    args <- c(list(model), vcov_args, dots)
-    se <- .safe(sqrt(diag(do.call("vcov", args))))
+    fun_args <- c(list(model), vcov_args, dots)
+    se <- .safe(sqrt(diag(do.call("vcov", fun_args))))
   }
 
   # vcov: character (with backward compatibility for `robust = TRUE`)

diff --git a/R/ci_profile_boot.R b/R/ci_profile_boot.R
@@ -84,14 +84,14 @@
   dot_args <- .check_profile_uniroot_args(...)
 
   if (is.null(profiled)) {
-    args <- list(x, method = "profile", level = ci, dot_args)
-    out <- as.data.frame(do.call(stats::confint, args))
+    fun_args <- list(x, method = "profile", level = ci, dot_args)
+    out <- as.data.frame(do.call(stats::confint, fun_args))
   } else {
-    args <- list(profiled, level = ci, dot_args)
-    out <- .safe(as.data.frame(do.call(stats::confint, args)))
+    fun_args <- list(profiled, level = ci, dot_args)
+    out <- .safe(as.data.frame(do.call(stats::confint, fun_args)))
     if (is.null(out)) {
-      args <- list(x, method = "profile", level = ci, dot_args)
-      out <- as.data.frame(do.call(stats::confint, args))
+      fun_args <- list(x, method = "profile", level = ci, dot_args)
+      out <- as.data.frame(do.call(stats::confint, fun_args))
     }
   }
   .process_glmmTMB_CI(x, out, ci, component)
@@ -103,8 +103,8 @@
 .ci_uniroot_glmmTMB <- function(x, ci, component, ...) {
   # make sure "..." doesn't pass invalid arguments to package TMB
   dot_args <- .check_profile_uniroot_args(...)
-  args <- list(x, level = ci, method = "uniroot", dot_args)
-  out <- as.data.frame(do.call(stats::confint, args))
+  fun_args <- list(x, level = ci, method = "uniroot", dot_args)
+  out <- as.data.frame(do.call(stats::confint, fun_args))
   .process_glmmTMB_CI(x, out, ci, component)
 }
 

diff --git a/R/dominance_analysis.R b/R/dominance_analysis.R
@@ -347,11 +347,10 @@ dominance_analysis <- function(model, sets = NULL, all = NULL,
 
   # quote arguments for domin
   for (arg in quote_args) {
-    if (!(arg %in% names(args))) {
-      insight::format_error(arg, " in `quote_args` not among arguments in model.")
+    if (arg %in% names(args)) {
+      args[[arg]] <- str2lang(paste0("quote(", deparse(args[[arg]]), ")", collapse = ""))
     } else {
-      args[[arg]] <-
-        str2lang(paste0("quote(", deparse(args[[arg]]), ")", collapse = ""))
+      insight::format_error(arg, " in `quote_args` not among arguments in model.")
     }
   }