Replace degrees_of_freedom() with get_df() (#997)

* Replace `degrees_of_freedom()` with `get_df()` * update p_value and ci * equi_test, extract_params * fix * fix * fix * fix examples * reduce warnings * fix * try... * fix * add test * styler * snapshot * update snapshots * trigger CI * trigger CI * update snapshot
easystats · Jul 23, 2024 · 6fd69e7 · 6fd69e7
1 parent cf46aff
commit 6fd69e7
Show file tree

Hide file tree

Showing 24 changed files with 176 additions and 142 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.22.1.1
+Version: 0.22.1.4
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -134,6 +134,7 @@ Suggests:
     ggplot2,
     GLMMadaptive,
     glmmTMB,
+    glmtoolbox,
     GPArotation,
     gt,
     haven,
@@ -218,3 +219,4 @@ Config/testthat/edition: 3
 Config/testthat/parallel: true
 Config/Needs/website: easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
+Remotes: easystats/insight
diff --git a/R/2_ci.R b/R/2_ci.R
@@ -7,10 +7,9 @@
 #' @param ci Confidence Interval (CI) level. Default to `0.95` (`95%`).
 #' @param dof Number of degrees of freedom to be used when calculating
 #'   confidence intervals. If `NULL` (default), the degrees of freedom are
-#'   retrieved by calling [`degrees_of_freedom()`] with
-#'   approximation method defined in `method`. If not `NULL`, use this argument
-#'   to override the default degrees of freedom used to compute confidence
-#'   intervals.
+#'   retrieved by calling [`insight::get_df()`] with approximation method
+#'   defined in `method`. If not `NULL`, use this argument to override the
+#'   default degrees of freedom used to compute confidence intervals.
 #' @param method Method for computing degrees of freedom for
 #'   confidence intervals (CI) and the related p-values. Allowed are following
 #'   options (which vary depending on the model class): `"residual"`,

diff --git a/R/3_p_value.R b/R/3_p_value.R
@@ -76,7 +76,7 @@ p_value.default <- function(model,
 
   if (method %in% c("residual", "wald", "normal", "satterthwaite", "kenward", "kr")) {
     if (is.null(dof)) {
-      dof <- degrees_of_freedom(model, method = method, verbose = FALSE)
+      dof <- insight::get_df(x = model, type = method, verbose = FALSE)
     }
     return(.p_value_dof(
       model,
@@ -111,7 +111,7 @@ p_value.default <- function(model,
       se <- do.call("standard_error", fun_args)
     }
 
-    dof <- degrees_of_freedom(model, method = "wald", verbose = FALSE)
+    dof <- insight::get_df(x = model, type = "wald", verbose = FALSE)
     se <- merge(se, co, sort = FALSE)
     se$Statistic <- se$Estimate / se$SE
     se$p <- 2 * stats::pt(abs(se$Statistic), df = dof, lower.tail = FALSE)

diff --git a/R/4_standard_error.R b/R/4_standard_error.R
@@ -18,11 +18,12 @@
 #'  * A string which indicates the kind of uncertainty estimates to return.
 #'    - Heteroskedasticity-consistent: `"vcovHC"`, `"HC"`, `"HC0"`, `"HC1"`,
 #'      `"HC2"`, `"HC3"`, `"HC4"`, `"HC4m"`, `"HC5"`. See `?sandwich::vcovHC`.
-#'    - Cluster-robust: `"vcovCR"`, `"CR0"`, `"CR1"`, `"CR1p"`, `"CR1S"`, `"CR2"`,
-#'      `"CR3"`. See `?clubSandwich::vcovCR`.
-#'    - Bootstrap: `"vcovBS"`, `"xy"`, `"residual"`, `"wild"`, `"mammen"`, `"webb"`.
-#'      See `?sandwich::vcovBS`.
-#'    - Other `sandwich` package functions: `"vcovHAC"`, `"vcovPC"`, `"vcovCL"`, `"vcovPL"`.
+#'    - Cluster-robust: `"vcovCR"`, `"CR0"`, `"CR1"`, `"CR1p"`, `"CR1S"`,
+#'      `"CR2"`, `"CR3"`. See `?clubSandwich::vcovCR`.
+#'    - Bootstrap: `"vcovBS"`, `"xy"`, `"residual"`, `"wild"`, `"mammen"`,
+#'      `"webb"`. See `?sandwich::vcovBS`.
+#'    - Other `sandwich` package functions: `"vcovHAC"`, `"vcovPC"`, `"vcovCL"`,
+#'      `"vcovPL"`.
 #' @param vcov_args List of arguments to be passed to the function identified by
 #'   the `vcov` argument. This function is typically supplied by the **sandwich**
 #'   or **clubSandwich** packages. Please refer to their documentation (e.g.,
@@ -46,18 +47,18 @@
 #'   standard errors. Depending on the model, may also include columns for model
 #'   components etc.
 #'
-#' @examples
+#' @examplesIf require("sandwich") && require("clubSandwich")
 #' model <- lm(Petal.Length ~ Sepal.Length * Species, data = iris)
 #' standard_error(model)
 #'
-#' if (require("sandwich") && require("clubSandwich")) {
-#'   standard_error(model, vcov = "HC3")
+#' # robust standard errors
+#' standard_error(model, vcov = "HC3")
 #'
-#'   standard_error(model,
-#'     vcov = "vcovCL",
-#'     vcov_args = list(cluster = iris$Species)
-#'   )
-#' }
+#' # cluster-robust standard errors
+#' standard_error(model,
+#'   vcov = "vcovCL",
+#'   vcov_args = list(cluster = iris$Species)
+#' )
 #' @export
 standard_error <- function(model, ...) {
   UseMethod("standard_error")
@@ -162,27 +163,25 @@ standard_error.default <- function(model,
   cs <- .safe(suppressWarnings(stats::coef(summary(model))))
   se <- NULL
 
-  if (!is.null(se)) {
-    if (is.list(cs) && !is.null(component)) {
-      cs <- cs[[component]]
+  if (is.list(cs) && !is.null(component)) {
+    cs <- cs[[component]]
+  }
+  if (!is.null(cs)) {
+    # do we have a se column?
+    se_col <- which(colnames(cs) == "Std. Error")
+    # if not, default to 2
+    if (length(se_col) == 0) {
+      se_col <- 2
     }
-    if (!is.null(cs)) {
-      # do we have a se column?
-      se_col <- which(colnames(cs) == "Std. Error")
-      # if not, default to 2
-      if (length(se_col) == 0) {
-        se_col <- 2
-      }
-      se <- as.vector(cs[, se_col])
-      if (is.null(names(se))) {
-        coef_names <- rownames(cs)
-        if (length(coef_names) == length(se)) {
-          names(se) <- coef_names
-        }
+    se <- as.vector(cs[, se_col])
+    if (is.null(names(se))) {
+      coef_names <- rownames(cs)
+      if (length(coef_names) == length(se)) {
+        names(se) <- coef_names
       }
     }
-    names(se) <- .remove_backticks_from_string(names(se))
   }
+  names(se) <- .remove_backticks_from_string(names(se))
   se
 }
 

diff --git a/R/ci_generic.R b/R/ci_generic.R
@@ -144,7 +144,7 @@
   # check if we have a valid dof vector
   if (is.null(dof)) {
     # residual df
-    dof <- degrees_of_freedom(model, method = method, verbose = FALSE)
+    dof <- insight::get_df(x = model, type = method, verbose = FALSE)
     # make sure we have a value for degrees of freedom
     if (is.null(dof) || length(dof) == 0 || .is_chi2_model(model, dof)) {
       dof <- Inf

diff --git a/R/equivalence_test.R b/R/equivalence_test.R
@@ -674,7 +674,7 @@ equivalence_test.ggeffects <- function(x,
       params <- insight::get_parameters(model)
 
       # degrees of freedom
-      dof <- degrees_of_freedom(model, method = "any")
+      dof <- insight::get_df(x = model, type = "wald")
 
       # mu
       params$mu <- params$Estimate * -1

diff --git a/R/extract_parameters.R b/R/extract_parameters.R
@@ -186,9 +186,9 @@
   # ==== degrees of freedom
 
   if (is.null(ci_method)) {
-    df_error <- degrees_of_freedom(model, method = "any", verbose = FALSE)
+    df_error <- insight::get_df(x = model, type = "wald", verbose = FALSE)
   } else {
-    df_error <- degrees_of_freedom(model, method = ci_method, verbose = FALSE)
+    df_error <- insight::get_df(x = model, type = ci_method, verbose = FALSE)
   }
   if (!is.null(df_error) && (length(df_error) == 1 || length(df_error) == nrow(parameters))) {
     if (length(df_error) == 1) {
@@ -451,7 +451,7 @@
 
   # Degrees of freedom
   if (.dof_method_ok(model, ci_method)) {
-    dof <- degrees_of_freedom(model, method = ci_method, verbose = FALSE)
+    dof <- insight::get_df(x = model, type = ci_method, verbose = FALSE)
   } else {
     dof <- Inf
   }
@@ -565,7 +565,7 @@
     if (!ci_method %in% special_ci_methods) {
       df_error <- data.frame(
         Parameter = parameters$Parameter,
-        df_error = degrees_of_freedom(model, method = "any"),
+        df_error = insight::get_df(x = model, type = "wald"),
         stringsAsFactors = FALSE
       )
     }

diff --git a/R/methods_flexsurvreg.R b/R/methods_flexsurvreg.R
@@ -17,7 +17,7 @@ p_value.flexsurvreg <- function(model, ...) {
   params <- insight::get_parameters(model)
   est <- params$Estimate
   se <- standard_error(model)$SE
-  p <- 2 * stats::pt(abs(est / se), df = degrees_of_freedom(model, method = "any"), lower.tail = FALSE)
+  p <- 2 * stats::pt(abs(est / se), df = insight::get_df(x = model, type = "wald"), lower.tail = FALSE)
   .data_frame(
     Parameter = params$Parameter,
     p = as.vector(p)

diff --git a/R/methods_gee.R b/R/methods_gee.R
@@ -26,13 +26,13 @@ p_value.gee <- function(model, method = NULL, ...) {
   if (isTRUE(list(...)$robust) || "vcov" %in% names(list(...))) {
     p <- 2 * stats::pt(
       abs(cs[, "Estimate"] / cs[, "Robust S.E."]),
-      df = degrees_of_freedom(model, method = method),
+      df = insight::get_df(x = model, type = method),
       lower.tail = FALSE
     )
   } else {
     p <- 2 * stats::pt(
       abs(cs[, "Estimate"] / cs[, "Naive S.E."]),
-      df = degrees_of_freedom(model, method = method),
+      df = insight::get_df(x = model, type = method),
       lower.tail = FALSE
     )
   }

diff --git a/R/methods_glmgee.R b/R/methods_glmgee.R
@@ -26,9 +26,13 @@ p_value.glmgee <- function(model,
   est <- insight::get_parameters(model, component = "conditional")
   se <- standard_error(model, vcov = vcov, verbose = FALSE)
 
+  if (is.null(method)) {
+    method <- "wald"
+  }
+
   p <- 2 * stats::pt(
     abs(est$Estimate / se$SE),
-    df = degrees_of_freedom(model, method = method),
+    df = insight::get_df(x = model, type = method),
     lower.tail = FALSE
   )
 

diff --git a/R/methods_lm.R b/R/methods_lm.R
@@ -45,7 +45,7 @@ p_value.summary.lm <- function(model, ...) {
 
 #' @export
 ci.summary.lm <- function(x, ci = 0.95, method = "residual", ...) {
-  .ci_generic(model = x, ci = ci, method = method, dof = degrees_of_freedom(x), ...)
+  .ci_generic(model = x, ci = ci, method = method, dof = insight::get_df(x), ...)
 }
 
 

diff --git a/R/methods_mice.R b/R/methods_mice.R
@@ -140,41 +140,33 @@ model_parameters.mipo <- function(model,
 #'   similar to `summary(mice::pool())`, i.e. it generates the pooled summary
 #'   of multiple imputed repeated regression analyses.
 #'
-#' @examples
+#' @examplesIf require("mice", quietly = TRUE) && require("gee", quietly = TRUE)
 #' library(parameters)
-#' if (require("mice", quietly = TRUE)) {
-#'   data(nhanes2)
-#'   imp <- mice(nhanes2)
-#'   fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl))
-#'   model_parameters(fit)
-#' }
+#' data(nhanes2, package = "mice")
+#' imp <- mice::mice(nhanes2)
+#' fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl))
+#' model_parameters(fit)
 #' \donttest{
 #' # model_parameters() also works for models that have no "tidy"-method in mice
-#' if (require("mice", quietly = TRUE) && require("gee", quietly = TRUE)) {
-#'   data(warpbreaks)
-#'   set.seed(1234)
-#'   warpbreaks$tension[sample(1:nrow(warpbreaks), size = 10)] <- NA
-#'   imp <- mice(warpbreaks)
-#'   fit <- with(data = imp, expr = gee(breaks ~ tension, id = wool))
+#' data(warpbreaks)
+#' set.seed(1234)
+#' warpbreaks$tension[sample(1:nrow(warpbreaks), size = 10)] <- NA
+#' imp <- mice::mice(warpbreaks)
+#' fit <- with(data = imp, expr = gee::gee(breaks ~ tension, id = wool))
 #'
-#'   # does not work:
-#'   # summary(pool(fit))
+#' # does not work:
+#' # summary(mice::pool(fit))
 #'
-#'   model_parameters(fit)
-#' }
+#' model_parameters(fit)
 #' }
 #'
-#'
-#'
 #' # and it works with pooled results
-#' if (require("mice")) {
-#'   data("nhanes2")
-#'   imp <- mice(nhanes2)
-#'   fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl))
-#'   pooled <- pool(fit)
+#' data("nhanes2", package = "mice")
+#' imp <- mice::mice(nhanes2)
+#' fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl))
+#' pooled <- mice::pool(fit)
 #'
-#'   model_parameters(pooled)
-#' }
+#' model_parameters(pooled)
 #' @export
 model_parameters.mira <- function(model,
                                   ci = 0.95,

diff --git a/man/ci.default.Rd b/man/ci.default.Rd
diff --git a/man/model_parameters.default.Rd b/man/model_parameters.default.Rd
diff --git a/man/model_parameters.merMod.Rd b/man/model_parameters.merMod.Rd