Support for svyolr (#1173)

* Support for svyolr

* tests

* Update DESCRIPTION

* typo

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.28.2.5
+Version: 0.28.2.7
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

NAMESPACE

@@ -243,11 +243,11 @@ S3method(model_parameters,draws)
 S3method(model_parameters,emmGrid)
 S3method(model_parameters,emm_list)
 S3method(model_parameters,epi.2by2)
-S3method(model_parameters,externVar)
-S3method(model_parameters,externX)
 S3method(model_parameters,estimate_contrasts)
 S3method(model_parameters,estimate_means)
 S3method(model_parameters,estimate_slopes)
+S3method(model_parameters,externVar)
+S3method(model_parameters,externX)
 S3method(model_parameters,fa)
 S3method(model_parameters,fa.ci)
 S3method(model_parameters,feglm)
@@ -360,6 +360,7 @@ S3method(model_parameters,summary_emm)
 S3method(model_parameters,survfit)
 S3method(model_parameters,svy2lme)
 S3method(model_parameters,svyglm)
+S3method(model_parameters,svyolr)
 S3method(model_parameters,svytable)
 S3method(model_parameters,systemfit)
 S3method(model_parameters,t1way)
@@ -803,11 +804,11 @@ S3method(standard_error,draws)
 S3method(standard_error,effectsize_table)
 S3method(standard_error,emmGrid)
 S3method(standard_error,emm_list)
-S3method(standard_error,externVar)
-S3method(standard_error,externX)
 S3method(standard_error,estimate_contrasts)
 S3method(standard_error,estimate_means)
 S3method(standard_error,estimate_slopes)
+S3method(standard_error,externVar)
+S3method(standard_error,externX)
 S3method(standard_error,factor)
 S3method(standard_error,feglm)
 S3method(standard_error,fitdistr)

R/1_model_parameters.R

@@ -396,15 +396,13 @@ model_parameters <- function(model, ...) {
 
 # DF naming convention --------------------
 
-
 # DF column naming
 # F has df, df_error
 # t has df_error
 # z has df_error = Inf
 # Chisq has df
 # https://github.com/easystats/parameters/issues/455
 
-
 # Options -------------------------------------
 
 # Add new options to the docs in "print.parameters_model"
@@ -417,7 +415,6 @@ model_parameters <- function(model, ...) {
 # getOption("parameters_interaction"): separator char for interactions
 # getOption("parameters_select"): default for the `select` argument
 
-
 #' @rdname model_parameters
 #' @export
 parameters <- model_parameters
@@ -578,21 +575,23 @@ parameters <- model_parameters
 #' }
 #' @return A data frame of indices related to the model's parameters.
 #' @export
-model_parameters.default <- function(model,
-                                     ci = 0.95,
-                                     ci_method = NULL,
-                                     bootstrap = FALSE,
-                                     iterations = 1000,
-                                     standardize = NULL,
-                                     exponentiate = FALSE,
-                                     p_adjust = NULL,
-                                     vcov = NULL,
-                                     vcov_args = NULL,
-                                     include_info = getOption("parameters_info", FALSE),
-                                     keep = NULL,
-                                     drop = NULL,
-                                     verbose = TRUE,
-                                     ...) {
+model_parameters.default <- function(
+  model,
+  ci = 0.95,
+  ci_method = NULL,
+  bootstrap = FALSE,
+  iterations = 1000,
+  standardize = NULL,
+  exponentiate = FALSE,
+  p_adjust = NULL,
+  vcov = NULL,
+  vcov_args = NULL,
+  include_info = getOption("parameters_info", FALSE),
+  keep = NULL,
+  drop = NULL,
+  verbose = TRUE,
+  ...
+) {
   # validation check for inputs
   .is_model_valid(model)
 
@@ -642,13 +641,11 @@ model_parameters.default <- function(model,
       attr(out, "error")
     )
   } else if (is.null(out)) {
-    insight::format_error(
-      paste0(
-        "Sorry, `model_parameters()` does not currently work for objects of class `",
-        class(model)[1],
-        "`."
-      )
-    )
+    insight::format_error(paste0(
+      "Sorry, `model_parameters()` does not currently work for objects of class `",
+      class(model)[1],
+      "`."
+    ))
   }
 }
 
@@ -657,24 +654,26 @@ model_parameters.default <- function(model,
 # including a bunch of attributes required for further processing
 # (like printing etc.)
 
-.model_parameters_generic <- function(model,
-                                      ci = 0.95,
-                                      bootstrap = FALSE,
-                                      iterations = 1000,
-                                      merge_by = "Parameter",
-                                      standardize = NULL,
-                                      exponentiate = FALSE,
-                                      effects = "fixed",
-                                      component = "conditional",
-                                      ci_method = NULL,
-                                      p_adjust = NULL,
-                                      include_info = FALSE,
-                                      keep_parameters = NULL,
-                                      drop_parameters = NULL,
-                                      vcov = NULL,
-                                      vcov_args = NULL,
-                                      verbose = TRUE,
-                                      ...) {
+.model_parameters_generic <- function(
+  model,
+  ci = 0.95,
+  bootstrap = FALSE,
+  iterations = 1000,
+  merge_by = "Parameter",
+  standardize = NULL,
+  exponentiate = FALSE,
+  effects = "fixed",
+  component = "conditional",
+  ci_method = NULL,
+  p_adjust = NULL,
+  include_info = FALSE,
+  keep_parameters = NULL,
+  drop_parameters = NULL,
+  vcov = NULL,
+  vcov_args = NULL,
+  verbose = TRUE,
+  ...
+) {
   dots <- list(...)
 
   out <- tryCatch(
@@ -688,12 +687,7 @@ model_parameters.default <- function(model,
           ci_method <- "quantile"
         }
 
-        fun_args <- list(
-          model,
-          iterations = iterations,
-          ci = ci,
-          ci_method = ci_method
-        )
+        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)
 
@@ -723,13 +717,11 @@ model_parameters.default <- function(model,
         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
@@ -766,30 +758,31 @@ model_parameters.default <- function(model,
 
 #################### .glm ----------------------
 
-
 #' @export
-model_parameters.glm <- function(model,
-                                 ci = 0.95,
-                                 ci_method = NULL,
-                                 bootstrap = FALSE,
-                                 iterations = 1000,
-                                 standardize = NULL,
-                                 exponentiate = FALSE,
-                                 p_adjust = NULL,
-                                 vcov = NULL,
-                                 vcov_args = NULL,
-                                 include_info = getOption("parameters_info", FALSE),
-                                 keep = NULL,
-                                 drop = NULL,
-                                 verbose = TRUE,
-                                 ...) {
+model_parameters.glm <- function(
+  model,
+  ci = 0.95,
+  ci_method = NULL,
+  bootstrap = FALSE,
+  iterations = 1000,
+  standardize = NULL,
+  exponentiate = FALSE,
+  p_adjust = NULL,
+  vcov = NULL,
+  vcov_args = NULL,
+  include_info = getOption("parameters_info", FALSE),
+  keep = NULL,
+  drop = NULL,
+  verbose = TRUE,
+  ...
+) {
   dots <- list(...)
 
   # set default
   if (is.null(ci_method)) {
     if (isTRUE(bootstrap)) {
       ci_method <- "quantile"
-    } else if (!is.null(vcov) || !is.null(vcov_args)) {
+    } else if (!is.null(vcov) || !is.null(vcov_args) || inherits(model, "svyolr")) {
       ci_method <- "wald"
     } else {
       ci_method <- "profile"
@@ -805,7 +798,11 @@ 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)) {
+  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.", # nolint
       "Use `ci_method=\"wald\"` to return confidence intervals based on robust standard errors."

R/dof.R

@@ -80,7 +80,8 @@ dof <- degrees_of_freedom
   method <- tolower(method)
 
   # exceptions 1
-  if (inherits(model, c("polr", "glm", "svyglm"))) {
+  if (inherits(model, c("polr", "glm", "svyglm", "svyolr"))) {
+    # fmt: skip
     if (method %in% c(
       "analytical", "any", "fit", "profile", "residual",
       "wald", "nokr", "likelihood", "normal"
@@ -96,11 +97,17 @@ dof <- degrees_of_freedom
 
   # exceptions 2
   if (inherits(model, c("phylolm", "phyloglm"))) {
-    if (method %in% c("analytical", "any", "fit", "residual", "wald", "nokr", "normal", "boot")) {
+    if (
+      method %in%
+        c("analytical", "any", "fit", "residual", "wald", "nokr", "normal", "boot")
+    ) {
       return(TRUE)
     } else {
       if (verbose) {
-        insight::format_alert(sprintf("`%s` must be one of \"wald\", \"normal\" or \"boot\". Using \"wald\" now.", type)) # nolint
+        insight::format_alert(sprintf(
+          "`%s` must be one of \"wald\", \"normal\" or \"boot\". Using \"wald\" now.",
+          type
+        ))
       }
       return(FALSE)
     }
@@ -109,31 +116,52 @@ dof <- degrees_of_freedom
   info <- insight::model_info(model, verbose = FALSE)
   if (!is.null(info) && isFALSE(info$is_mixed) && method == "boot") {
     if (verbose) {
-      insight::format_alert(sprintf("`%s=boot` only works for mixed models of class `merMod`. To bootstrap this model, use `bootstrap=TRUE, ci_method=\"bcai\"`.", type)) # nolint
+      insight::format_alert(sprintf(
+        "`%s=boot` only works for mixed models of class `merMod`. To bootstrap this model, use `bootstrap=TRUE, ci_method=\"bcai\"`.",
+        type
+      ))
     }
     return(TRUE)
   }
 
+  # fmt: skip
   if (is.null(info) || !info$is_mixed) {
-    if (!(method %in% c("analytical", "any", "fit", "betwithin", "nokr", "wald", "ml1", "profile", "boot", "uniroot", "residual", "normal"))) { # nolint
+    if (!(method %in% c(
+      "analytical", "any", "fit", "betwithin", "nokr", "wald", "ml1",
+      "profile", "boot", "uniroot", "residual", "normal"
+    ))) {
       if (verbose) {
-        insight::format_alert(sprintf("`%s` must be one of \"residual\", \"wald\", \"normal\", \"profile\", \"boot\", \"uniroot\", \"betwithin\" or \"ml1\". Using \"wald\" now.", type)) # nolint
+        insight::format_alert(sprintf(
+          "`%s` must be one of \"residual\", \"wald\", \"normal\", \"profile\", \"boot\", \"uniroot\", \"betwithin\" or \"ml1\". Using \"wald\" now.",
+          type
+        ))
       }
       return(FALSE)
     }
     return(TRUE)
   }
 
-  if (!(method %in% c("analytical", "any", "fit", "satterthwaite", "betwithin", "kenward", "kr", "nokr", "wald", "ml1", "profile", "boot", "uniroot", "residual", "normal"))) { # nolint
+  # fmt: skip
+  if (!(method %in% c(
+    "analytical", "any", "fit", "satterthwaite", "betwithin", "kenward",
+    "kr", "nokr", "wald", "ml1", "profile", "boot", "uniroot", "residual",
+    "normal"
+  ))) {
     if (verbose) {
-      insight::format_alert(sprintf("`%s` must be one of \"residual\", \"wald\", \"normal\", \"profile\", \"boot\", \"uniroot\", \"kenward\", \"satterthwaite\", \"betwithin\" or \"ml1\". Using \"wald\" now.", type)) # nolint
+      insight::format_alert(sprintf(
+        "`%s` must be one of \"residual\", \"wald\", \"normal\", \"profile\", \"boot\", \"uniroot\", \"kenward\", \"satterthwaite\", \"betwithin\" or \"ml1\". Using \"wald\" now.",
+        type
+      ))
     }
     return(FALSE)
-  }
+}
 
   if (!info$is_linear && method %in% c("satterthwaite", "kenward", "kr")) {
     if (verbose) {
-      insight::format_alert(sprintf("`%s`-degrees of freedoms are only available for linear mixed models.", method))
+      insight::format_alert(sprintf(
+        "`%s`-degrees of freedoms are only available for linear mixed models.",
+        method
+      ))
     }
     return(FALSE)
   }