remove degrees_of_freedom methods

easystats · Jul 23, 2024 · 9edba31 · 9edba31
1 parent 6fd69e7
commit 9edba31
Show file tree

Hide file tree

Showing 43 changed files with 85 additions and 834 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -118,62 +118,6 @@ S3method(convert_efa_to_cfa,fa)
 S3method(convert_efa_to_cfa,fa.ci)
 S3method(convert_efa_to_cfa,parameters_efa)
 S3method(convert_efa_to_cfa,parameters_pca)
-S3method(degrees_of_freedom,BBmm)
-S3method(degrees_of_freedom,BBreg)
-S3method(degrees_of_freedom,betamfx)
-S3method(degrees_of_freedom,betaor)
-S3method(degrees_of_freedom,bfsl)
-S3method(degrees_of_freedom,bigglm)
-S3method(degrees_of_freedom,biglm)
-S3method(degrees_of_freedom,cgam)
-S3method(degrees_of_freedom,cgamm)
-S3method(degrees_of_freedom,coeftest)
-S3method(degrees_of_freedom,complmrob)
-S3method(degrees_of_freedom,default)
-S3method(degrees_of_freedom,emmGrid)
-S3method(degrees_of_freedom,emm_list)
-S3method(degrees_of_freedom,fixest)
-S3method(degrees_of_freedom,fixest_multi)
-S3method(degrees_of_freedom,garch)
-S3method(degrees_of_freedom,glht)
-S3method(degrees_of_freedom,gls)
-S3method(degrees_of_freedom,hglm)
-S3method(degrees_of_freedom,ivFixed)
-S3method(degrees_of_freedom,ivprobit)
-S3method(degrees_of_freedom,logitmfx)
-S3method(degrees_of_freedom,logitor)
-S3method(degrees_of_freedom,lqm)
-S3method(degrees_of_freedom,lqmm)
-S3method(degrees_of_freedom,mediate)
-S3method(degrees_of_freedom,merModList)
-S3method(degrees_of_freedom,mhurdle)
-S3method(degrees_of_freedom,mipo)
-S3method(degrees_of_freedom,mira)
-S3method(degrees_of_freedom,mmrm)
-S3method(degrees_of_freedom,mmrm_fit)
-S3method(degrees_of_freedom,mmrm_tmb)
-S3method(degrees_of_freedom,model_fit)
-S3method(degrees_of_freedom,multinom)
-S3method(degrees_of_freedom,negbinirr)
-S3method(degrees_of_freedom,negbinmfx)
-S3method(degrees_of_freedom,nestedLogit)
-S3method(degrees_of_freedom,nlrq)
-S3method(degrees_of_freedom,nnet)
-S3method(degrees_of_freedom,plm)
-S3method(degrees_of_freedom,poissonirr)
-S3method(degrees_of_freedom,poissonmfx)
-S3method(degrees_of_freedom,probitmfx)
-S3method(degrees_of_freedom,rlm)
-S3method(degrees_of_freedom,rq)
-S3method(degrees_of_freedom,rqs)
-S3method(degrees_of_freedom,rqss)
-S3method(degrees_of_freedom,selection)
-S3method(degrees_of_freedom,serp)
-S3method(degrees_of_freedom,summary.lm)
-S3method(degrees_of_freedom,svy2lme)
-S3method(degrees_of_freedom,systemfit)
-S3method(degrees_of_freedom,truncreg)
-S3method(degrees_of_freedom,vgam)
 S3method(display,compare_parameters)
 S3method(display,equivalence_test_lm)
 S3method(display,parameters_brms_meta)

diff --git a/R/compare_parameters.R b/R/compare_parameters.R
@@ -310,3 +310,19 @@ compare_models <- compare_parameters
 
   x
 }
+
+
+.is_bayesian_model <- function(x, exclude = NULL) {
+  bayes_classes <- c(
+    "brmsfit", "stanfit", "MCMCglmm", "stanreg",
+    "stanmvreg", "bmerMod", "BFBayesFactor", "bamlss",
+    "bayesx", "mcmc", "bcplm", "bayesQR", "BGGM",
+    "meta_random", "meta_fixed", "meta_bma", "blavaan",
+    "blrm", "blmerMod"
+  )
+  # if exclude is not NULL, remove elements in exclude from bayes_class
+  if (!is.null(exclude)) {
+    bayes_classes <- bayes_classes[!bayes_classes %in% exclude]
+  }
+  inherits(x, bayes_classes)
+}
diff --git a/R/dof.R b/R/dof.R
@@ -47,17 +47,15 @@
 #' `"satterthwaite"`, each model parameter can have a different degree of
 #' freedom.
 #'
-#' @examples
+#' @examplesIf require("lme4", quietly = TRUE)
 #' model <- lm(Sepal.Length ~ Petal.Length * Species, data = iris)
 #' dof(model)
 #'
 #' model <- glm(vs ~ mpg * cyl, data = mtcars, family = "binomial")
 #' dof(model)
 #' \donttest{
-#' if (require("lme4", quietly = TRUE)) {
-#'   model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)
-#'   dof(model)
-#' }
+#' model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)
+#' dof(model)
 #'
 #' if (require("rstanarm", quietly = TRUE)) {
 #'   model <- stan_glm(
@@ -70,195 +68,15 @@
 #' }
 #' }
 #' @export
-degrees_of_freedom <- function(model, ...) {
-  UseMethod("degrees_of_freedom")
-}
-
-
-
-
-#' @rdname degrees_of_freedom
-#' @export
-degrees_of_freedom.default <- function(model, method = "analytical", ...) {
-  # check for valid input
-  .is_model_valid(model)
-
-  if (is.null(method)) {
-    method <- "wald"
-  }
-  method <- tolower(method)
-
-  method <- match.arg(method, choices = c(
-    "analytical", "any", "fit", "ml1", "betwithin", "satterthwaite", "kenward",
-    "nokr", "wald", "kr", "profile", "boot", "uniroot", "residual", "normal",
-    "likelihood"
-  ))
-
-  if (!.dof_method_ok(model, method, ...) || method %in% c("profile", "likelihood", "boot", "uniroot")) {
-    method <- "any"
-  }
-
-  stat <- insight::find_statistic(model)
-
-  # for z-statistic, always return Inf
-  if (!is.null(stat) && stat == "z-statistic" && !(method %in% c("ml1", "betwithin"))) {
-    if (method == "residual") {
-      return(.degrees_of_freedom_residual(model, verbose = FALSE))
-    } else {
-      return(Inf)
-    }
-  }
-
-  # Chi2-distributions usually have 1 df
-  if (!is.null(stat) && stat == "chi-squared statistic") {
-    if (method == "residual") {
-      return(.degrees_of_freedom_residual(model, verbose = FALSE))
-    } else {
-      return(1)
-    }
-  }
-
-  if (method == "any") { # nolint
-    dof <- .degrees_of_freedom_residual(model, verbose = FALSE)
-    if (is.null(dof) || all(is.infinite(dof)) || anyNA(dof)) {
-      dof <- .degrees_of_freedom_analytical(model, kenward = FALSE)
-    }
-  } else if (method == "ml1") {
-    dof <- dof_ml1(model)
-  } else if (method == "wald") {
-    dof <- .degrees_of_freedom_residual(model, verbose = FALSE)
-  } else if (method == "normal") {
-    dof <- Inf
-  } else if (method == "satterthwaite") {
-    dof <- dof_satterthwaite(model)
-  } else if (method == "betwithin") {
-    dof <- dof_betwithin(model)
-  } else if (method %in% c("kenward", "kr")) {
-    dof <- dof_kenward(model)
-  } else if (method == "analytical") {
-    dof <- .degrees_of_freedom_analytical(model, kenward = TRUE)
-  } else if (method == "nokr") {
-    dof <- .degrees_of_freedom_analytical(model, kenward = FALSE)
-  } else {
-    dof <- .degrees_of_freedom_residual(model)
-  }
-
-  if (!is.null(dof) && length(dof) > 0 && all(dof == 0)) {
-    insight::format_warning("Model has zero degrees of freedom!")
-  }
-
-  dof
+degrees_of_freedom <- function(model, method = "analytical", ...) {
+  insight::get_df(x = model, type = method, ...)
 }
 
 #' @rdname degrees_of_freedom
 #' @export
 dof <- degrees_of_freedom
 
 
-
-
-
-# Analytical approach ------------------------------
-
-
-#' @keywords internal
-.degrees_of_freedom_analytical <- function(model, kenward = TRUE) {
-  nparam <- n_parameters(model)
-  n <- insight::n_obs(model)
-
-  if (is.null(n)) {
-    n <- Inf
-  }
-
-  if (isTRUE(kenward) && inherits(model, "lmerMod")) {
-    dof <- as.numeric(dof_kenward(model))
-  } else {
-    dof <- rep(n - nparam, nparam)
-  }
-
-  dof
-}
-
-
-
-
-
-# Model approach (Residual df) ------------------------------
-
-
-#' @keywords internal
-.degrees_of_freedom_residual <- function(model, verbose = TRUE) {
-  if (.is_bayesian_model(model, exclude = c("bmerMod", "bayesx", "blmerMod", "bglmerMod"))) {
-    model <- bayestestR::bayesian_as_frequentist(model)
-  }
-
-  # 1st try
-  dof <- try(stats::df.residual(model), silent = TRUE)
-
-  # 2nd try
-  if (inherits(dof, "try-error") || is.null(dof) || all(is.na(dof))) {
-    junk <- utils::capture.output(dof = try(summary(model)$df[2], silent = TRUE))
-  }
-
-  # 3rd try, nlme
-  if (inherits(dof, "try-error") || is.null(dof) || all(is.na(dof))) {
-    dof <- try(unname(model$fixDF$X), silent = TRUE)
-  }
-
-  # last try
-  if (inherits(dof, "try-error") || is.null(dof) || all(is.na(dof))) {
-    dof <- Inf
-    if (verbose) {
-      insight::format_alert("Could not extract degrees of freedom.")
-    }
-  }
-
-
-  # special cases
-  # if (inherits(model, "gam")) {
-  #   dof <- .dof_fit_gam(model, dof)
-  # }
-
-  dof
-}
-
-
-
-
-# residual df - for models with residual df, but no "df.residual()" method --------------
-
-
-#' @keywords internal
-.degrees_of_freedom_no_dfresid_method <- function(model, method = NULL) {
-  if (identical(method, "normal")) {
-    return(Inf)
-  } else if (!is.null(method) && method %in% c("ml1", "satterthwaite", "betwithin")) {
-    degrees_of_freedom.default(model, method = method)
-  } else {
-    .degrees_of_freedom_analytical(model, kenward = FALSE)
-  }
-}
-
-
-
-
-
-
-# helper --------------
-
-.dof_fit_gam <- function(model, dof) {
-  params <- insight::find_parameters(model)
-  if (!is.null(params$conditional)) {
-    dof <- rep(dof, length(params$conditional))
-  }
-  if (!is.null(params$smooth_terms)) {
-    s <- summary(model)
-    dof <- c(dof, s$s.table[, "Ref.df"])
-  }
-  dof
-}
-
-
 # Helper, check args ------------------------------
 
 .dof_method_ok <- function(model, method, type = "df_method", verbose = TRUE, ...) {
@@ -329,23 +147,3 @@ dof <- degrees_of_freedom
 
   return(TRUE)
 }
-
-
-
-
-# helper
-
-.is_bayesian_model <- function(x, exclude = NULL) {
-  bayes_classes <- c(
-    "brmsfit", "stanfit", "MCMCglmm", "stanreg",
-    "stanmvreg", "bmerMod", "BFBayesFactor", "bamlss",
-    "bayesx", "mcmc", "bcplm", "bayesQR", "BGGM",
-    "meta_random", "meta_fixed", "meta_bma", "blavaan",
-    "blrm", "blmerMod"
-  )
-  # if exclude is not NULL, remove elements in exclude from bayes_class
-  if (!is.null(exclude)) {
-    bayes_classes <- bayes_classes[!bayes_classes %in% exclude]
-  }
-  inherits(x, bayes_classes)
-}
diff --git a/R/extract_parameters.R b/R/extract_parameters.R
@@ -318,7 +318,7 @@
     sig <- .safe(suppressWarnings(insight::get_sigma(model, ci = NULL, verbose = FALSE)))
     attr(params, "sigma") <- as.numeric(sig)
 
-    resdf <- .safe(suppressWarnings(insight::get_df(model, type = "residual")))
+    resdf <- .safe(suppressWarnings(insight::get_df(x = model, type = "residual")))
     attr(params, "residual_df") <- as.numeric(resdf)
   }
   params

diff --git a/R/methods_BBMM.R b/R/methods_BBMM.R
@@ -64,18 +64,3 @@ p_value.BBreg <- function(model, ...) {
     p = as.data.frame(summary(model)$coefficients)$p.value
   )
 }
-
-
-
-#' @export
-degrees_of_freedom.BBmm <- function(model, method = "residual", ...) {
-  if (method %in% c("residual", "wald")) {
-    return(model$df)
-  } else {
-    return(degrees_of_freedom.default(model = model, method = method, ...))
-  }
-}
-
-
-#' @export
-degrees_of_freedom.BBreg <- degrees_of_freedom.BBmm
diff --git a/R/methods_bfsl.R b/R/methods_bfsl.R
@@ -37,20 +37,3 @@ standard_error.bfsl <- function(model, ...) {
   )
   insight::text_remove_backticks(params, verbose = FALSE)
 }
-
-
-
-#' @export
-degrees_of_freedom.bfsl <- function(model, method = "residual", ...) {
-  if (is.null(method)) {
-    method <- "wald"
-  }
-
-  method <- match.arg(tolower(method), choices = c("analytical", "any", "fit", "wald", "residual", "normal"))
-
-  if (method %in% c("wald", "residual", "fit")) {
-    model$df.residual
-  } else {
-    degrees_of_freedom.default(model, method = method, ...)
-  }
-}
diff --git a/R/methods_biglm.R b/R/methods_biglm.R
@@ -8,12 +8,3 @@ standard_error.biglm <- function(model, ...) {
     SE = as.vector(cs[, 4])
   )
 }
-
-
-#' @export
-degrees_of_freedom.biglm <- function(model, method = NULL, ...) {
-  .degrees_of_freedom_no_dfresid_method(model, method)
-}
-
-#' @export
-degrees_of_freedom.bigglm <- degrees_of_freedom.biglm