parameters.fixest: Uninformative error (#1055)

* `parameters.fixest`: Uninformative error
Fixes #1054

* fix standard_error.fixest, add test

* Update DESCRIPTION

* styler

* update snapshots

* update vignette

* styler

* lintr

* lintr

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.24.0.4
+Version: 0.24.0.5
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -224,4 +224,4 @@ Config/testthat/edition: 3
 Config/testthat/parallel: true
 Config/Needs/website: easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
-Remotes: easystats/datawizard, easystats/performance
+Remotes: easystats/insight, easystats/datawizard, easystats/performance

NEWS.md

@@ -1,5 +1,10 @@
 # parameters 0.24.1
 
+## Changes
+
+* `model_parameters()` now gives informative error messages for more model
+  classes than before when the function fails to extract model parameters.
+
 ## Bug fixes
 
 * Fixed issue when printing `model_parameters()` with models from `mgcv::gam()`.

R/1_model_parameters.R

@@ -605,32 +605,31 @@ model_parameters.default <- function(model,
   )
 
   # extract model parameters table, as data frame
-  out <- tryCatch(
-    .model_parameters_generic(
-      model = model,
-      ci = ci,
-      ci_method = ci_method,
-      bootstrap = bootstrap,
-      iterations = iterations,
-      merge_by = "Parameter",
-      standardize = standardize,
-      exponentiate = exponentiate,
-      p_adjust = p_adjust,
-      include_info = include_info,
-      keep_parameters = keep,
-      drop_parameters = drop,
-      vcov = vcov,
-      vcov_args = vcov_args,
-      verbose = verbose,
-      ...
-    ),
-    error = function(e) {
-      fail <- NA
-      attr(fail, "error") <- gsub("  ", " ", gsub("\\n", "", e$message), fixed = TRUE)
-      fail
-    }
+  out <- .model_parameters_generic(
+    model = model,
+    ci = ci,
+    ci_method = ci_method,
+    bootstrap = bootstrap,
+    iterations = iterations,
+    merge_by = "Parameter",
+    standardize = standardize,
+    exponentiate = exponentiate,
+    p_adjust = p_adjust,
+    include_info = include_info,
+    keep_parameters = keep,
+    drop_parameters = drop,
+    vcov = vcov,
+    vcov_args = vcov_args,
+    verbose = verbose,
+    ...
   )
 
+  attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(model))
+  out
+}
+
+
+.fail_error_message <- function(out, model) {
   # tell user if something went wrong...
   if (length(out) == 1 && isTRUE(is.na(out))) {
     insight::format_error(
@@ -650,14 +649,9 @@ model_parameters.default <- function(model,
       )
     )
   }
-
-  attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(model))
-  out
 }
 
 
-
-
 # helper function for the composition of the parameters table,
 # including a bunch of attributes required for further processing
 # (like printing etc.)
@@ -682,79 +676,91 @@ model_parameters.default <- function(model,
                                       ...) {
   dots <- list(...)
 
-  # ==== 1. first step, extracting (bootstrapped) model parameters -------
-
-  # Processing, bootstrapped parameters
-  if (bootstrap) {
-    # set default method for bootstrapped CI
-    if (is.null(ci_method) || missing(ci_method)) {
-      ci_method <- "quantile"
-    }
-
-    fun_args <- list(
-      model,
-      iterations = iterations,
-      ci = ci,
-      ci_method = ci_method
-    )
-    fun_args <- c(fun_args, dots)
-    params <- do.call("bootstrap_parameters", fun_args)
+  out <- tryCatch(
+    {
+      # ==== 1. first step, extracting (bootstrapped) model parameters -------
+
+      # Processing, bootstrapped parameters
+      if (bootstrap) {
+        # set default method for bootstrapped CI
+        if (is.null(ci_method) || missing(ci_method)) {
+          ci_method <- "quantile"
+        }
+
+        fun_args <- list(
+          model,
+          iterations = iterations,
+          ci = ci,
+          ci_method = ci_method
+        )
+        fun_args <- c(fun_args, dots)
+        params <- do.call("bootstrap_parameters", fun_args)
+
+        # Processing, non-bootstrapped parameters
+      } else {
+        # set default method for CI
+        if (is.null(ci_method) || missing(ci_method)) {
+          ci_method <- "wald"
+        }
+
+        fun_args <- list(
+          model,
+          ci = ci,
+          component = component,
+          merge_by = merge_by,
+          standardize = standardize,
+          effects = effects,
+          ci_method = ci_method,
+          p_adjust = p_adjust,
+          keep_parameters = keep_parameters,
+          drop_parameters = drop_parameters,
+          verbose = verbose,
+          vcov = vcov,
+          vcov_args = vcov_args
+        )
+        fun_args <- c(fun_args, dots)
+        params <- do.call(".extract_parameters_generic", fun_args)
+      }
+
+
+      # ==== 2. second step, exponentiate -------
+
+      # exponentiate coefficients and SE/CI, if requested
+      params <- .exponentiate_parameters(params, model, exponentiate)
+
+
+      # ==== 3. third step, add information as attributes -------
+
+      # add further information as attributes
+      params <- .add_model_parameters_attributes(
+        params,
+        model,
+        ci,
+        exponentiate,
+        bootstrap,
+        iterations,
+        ci_method = ci_method,
+        p_adjust = p_adjust,
+        include_info = include_info,
+        verbose = verbose,
+        ...
+      )
 
-    # Processing, non-bootstrapped parameters
-  } else {
-    # set default method for CI
-    if (is.null(ci_method) || missing(ci_method)) {
-      ci_method <- "wald"
+      class(params) <- c("parameters_model", "see_parameters_model", class(params))
+      params
+    },
+    error = function(e) {
+      fail <- NA
+      attr(fail, "error") <- gsub("  ", " ", gsub("\\n", "", e$message), fixed = TRUE)
+      fail
     }
-
-    fun_args <- list(
-      model,
-      ci = ci,
-      component = component,
-      merge_by = merge_by,
-      standardize = standardize,
-      effects = effects,
-      ci_method = ci_method,
-      p_adjust = p_adjust,
-      keep_parameters = keep_parameters,
-      drop_parameters = drop_parameters,
-      verbose = verbose,
-      vcov = vcov,
-      vcov_args = vcov_args
-    )
-    fun_args <- c(fun_args, dots)
-    params <- do.call(".extract_parameters_generic", fun_args)
-  }
-
-
-  # ==== 2. second step, exponentiate -------
-
-  # exponentiate coefficients and SE/CI, if requested
-  params <- .exponentiate_parameters(params, model, exponentiate)
-
-
-  # ==== 3. third step, add information as attributes -------
-
-  # add further information as attributes
-  params <- .add_model_parameters_attributes(
-    params,
-    model,
-    ci,
-    exponentiate,
-    bootstrap,
-    iterations,
-    ci_method = ci_method,
-    p_adjust = p_adjust,
-    include_info = include_info,
-    verbose = verbose,
-    ...
   )
 
-  class(params) <- c("parameters_model", "see_parameters_model", class(params))
-  params
-}
-
+  # check if everything is ok
+  .fail_error_message(out, model)
 
+  out
+}
 
 
 #################### .glm ----------------------

R/4_standard_error.R

@@ -70,7 +70,6 @@ standard_error <- function(model, ...) {
 }
 
 
-
 # Default methods ---------------------------------------------------------
 
 #' @rdname standard_error
@@ -160,8 +159,6 @@ standard_error.default <- function(model,
 }
 
 
-
-
 # helper -----------------------------------------------------------------
 
 
@@ -192,15 +189,12 @@ standard_error.default <- function(model,
 }
 
 
-
 .check_vcov_args <- function(robust, ...) {
   dots <- list(...)
   isTRUE(isTRUE(robust) || isTRUE(dots$robust) || ("vcov" %in% names(dots) && !is.null(dots[["vcov"]])))
 }
 
 
-
-
 # .ranef_se <- function(x) {
 # insight::check_if_installed("lme4")
 #

R/5_simulate_model.R

@@ -56,7 +56,6 @@ simulate_model <- function(model, iterations = 1000, ...) {
 }
 
 
-
 # Models with single component only -----------------------------------------
 
 #' @rdname simulate_model
@@ -224,10 +223,6 @@ simulate_model.brmultinom <- simulate_model.default
 simulate_model.bracl <- simulate_model.default
 
 
-
-
-
-
 # helper -----------------------------------------
 
 

R/bootstrap_model.R

@@ -57,10 +57,6 @@ bootstrap_model <- function(model,
 }
 
 
-
-
-
-
 #' @rdname bootstrap_model
 #' @export
 bootstrap_model.default <- function(model,

R/ci_kenward.R

@@ -20,7 +20,6 @@ ci_kenward <- function(model, ci = 0.95) {
 }
 
 
-
 .ci_kenward_dof <- function(model, ci = 0.95, df_kr) {
   out <- lapply(ci, function(i) {
     .ci_dof(

R/ci_profile_boot.R

@@ -32,7 +32,6 @@
 }
 
 
-
 # we need this function for models where confint and get_parameters return
 # different length (e.g. as for "polr" models)
 .ci_profiled2 <- function(model, ci) {
@@ -98,7 +97,6 @@
 }
 
 
-
 #' @keywords internal
 .ci_uniroot_glmmTMB <- function(x, ci, component, ...) {
   # make sure "..." doesn't pass invalid arguments to package TMB
@@ -157,7 +155,6 @@
 }
 
 
-
 #' @keywords internal
 .ci_boot_merMod <- function(x, ci, iterations = 500, effects = "fixed", ...) {
   insight::check_if_installed("lme4")

R/cluster_analysis.R

@@ -197,7 +197,6 @@ cluster_analysis <- function(x,
   }
 
 
-
   # Apply clustering --------------------------------------------------------
 
 
@@ -286,7 +285,6 @@ cluster_analysis <- function(x,
 }
 
 
-
 # Clustering Methods --------------------------------------------------------
 
 #' @keywords internal
@@ -406,7 +404,6 @@ cluster_analysis <- function(x,
 }
 
 
-
 # Methods ----------------------------------------------------------------
 
 #' @export

R/cluster_discrimination.R

@@ -34,7 +34,6 @@ cluster_discrimination.cluster_analysis <- function(x, cluster_groups = NULL, ..
 }
 
 
-
 #' @export
 cluster_discrimination.default <- function(x, cluster_groups = NULL, ...) {
   if (is.null(cluster_groups)) {