add normal and wald types

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.18.4.4
+Version: 0.18.4.5
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",

NEWS.md

@@ -6,6 +6,9 @@
   refer to particular effectsizes (like Phi, Omega or Epsilon) include the related unicode-character instead of the written name. This only works on Windows for
   R >= 4.2, and on OS X or Linux for R >= 4.0.
 
+* `get_df()` gets more `type` options to return different type of degrees of
+  freedom (namely, `"wald"` and `"normal"`).
+
 ## Bug fixes
 
 * Fixed issue with column alignment in `export_table()` when the data frame 

R/get_df.R

@@ -5,11 +5,21 @@
 #'   from regression models.
 #'
 #' @param x A statistical model.
-#' @param type Can be `"residual"`, `"model"` or `"analytical"`. `"residual"`
-#' tries to extract residual degrees of freedoms. If residual degrees of freedom
-#' could not be extracted, returns analytical degrees of freedom, i.e. `n-k`
-#' (number of observations minus number of parameters). `"model"` returns
-#' model-based degrees of freedom, i.e. the number of (estimated) parameters.
+#' @param type Can be `"residual"`, `"wald"`, `"normal"`, `"analytical"`, or
+#'   `"model"`.
+#'
+#' - `"residual"` tries to extract residual degrees of freedoms. If residual
+#'   degrees of freedom could not be extracted, returns analytical degrees of
+#'   freedom, i.e. `n-k` (number of observations minus number of parameters).
+#' - `"wald"` for models with z-statistic, returns `"Inf"`. Else, tries to
+#'   extract residual degrees of freedoms. If residual degrees of freedom could
+#'   not be extracted, returns `"Inf"`.
+#' - `"analytical"` returns analytical degrees of freedom, i.e. `n-k`
+#'   (number of observations minus number of parameters).
+#' - `"normal"` always returns `"Inf"`.
+#' - `"model"` returns model-based degrees of freedom, i.e. the number of
+#'   (estimated) parameters.
+#'
 #' @param verbose Toggle warnings.
 #' @param ... Currently not used.
 #'
@@ -26,13 +36,23 @@ get_df <- function(x, ...) {
 #' @rdname get_df
 #' @export
 get_df.default <- function(x, type = "residual", verbose = TRUE, ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model", "analytical"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "analytical", "wald", "normal"))
 
-  if (type == "residual") {
+  if (type == "normal") {
+    return(Inf)
+  } else if (type == "residual") {
     dof <- .degrees_of_freedom_residual(x, verbose = verbose)
     if (is.null(dof) || all(is.infinite(dof)) || anyNA(dof)) {
       dof <- .degrees_of_freedom_analytical(x)
     }
+  } else if (type == "wald") {
+    if (find_statistic(x) == "z-statistic") {
+      return(Inf)
+    }
+    dof <- .degrees_of_freedom_residual(x, verbose = verbose)
+    if (is.null(dof) || all(is.infinite(dof)) || anyNA(dof)) {
+      return(Inf)
+    }
   } else if (type == "analytical") {
     dof <- .degrees_of_freedom_analytical(x)
   } else {
@@ -59,9 +79,11 @@ get_df.model_fit <- function(x, type = "residual", verbose = TRUE, ...) {
 
 #' @export
 get_df.ivFixed <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal", "wald"))
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     as.vector(x$df)
   }
@@ -73,15 +95,17 @@ get_df.ivprobit <- get_df.ivFixed
 
 #' @export
 get_df.fixest <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
-  if (type == "residual") {
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal", "wald"))
+  if (type %n% c("residual", "wald")) {
     s <- summary(x)
     vcov_scaled <- s$cov.scaled
     if (is.null(vcov_scaled)) {
       s$nobs - s$nparams
     } else {
       max(s$nobs - attr(vcov_scaled, "dof.K"), 1)
     }
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     .model_df(x)
   }
@@ -90,9 +114,12 @@ get_df.fixest <- function(x, type = "residual", ...) {
 
 #' @export
 get_df.multinom <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal", "wald"))
+  stat <- find_statistic(x)
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal" || (type == "wald" && stat == "z-statistic")) {
+    return(Inf)
   } else {
     n_obs(x) - x$edf
   }
@@ -104,9 +131,11 @@ get_df.nnet <- get_df.multinom
 
 #' @export
 get_df.summary.lm <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     x$fstatistic[3]
   }
@@ -146,9 +175,11 @@ get_df.coeftest <- function(x, ...) {
 
 #' @export
 get_df.lqmm <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal", "wald"))
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     cs <- summary(x)
     tryCatch(
@@ -173,9 +204,12 @@ get_df.lqm <- get_df.lqmm
 
 #' @export
 get_df.cgam <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal", "wald"))
+  stat <- find_statistic(x)
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal" || (type == "wald" && stat == "z-statistic")) {
+    return(Inf)
   } else {
     # x$resid_df_obs
     # new in cgam 1.18
@@ -186,9 +220,12 @@ get_df.cgam <- function(x, type = "residual", ...) {
 
 #' @export
 get_df.cgamm <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal", "wald"))
+  stat <- find_statistic(x)
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal" || (type == "wald" && stat == "z-statistic")) {
+    return(Inf)
   } else {
     x$resid_df_obs
   }
@@ -197,9 +234,11 @@ get_df.cgamm <- function(x, type = "residual", ...) {
 
 #' @export
 get_df.glht <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal", "wald"))
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     x$df
   }
@@ -216,8 +255,11 @@ get_df.BBreg <- get_df.glht
 
 #' @export
 get_df.rlm <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
-  if (type == "residual") {
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal", "wald"))
+  stat <- find_statistic(x)
+  if (type == "normal" || (type == "wald" && stat == "z-statistic")) {
+    return(Inf)
+  } else if (type %in% c("residual", "wald")) {
     .degrees_of_freedom_analytical(x)
   } else {
     .model_df(x)
@@ -253,7 +295,7 @@ get_df.truncreg <- get_df.rlm
 
 #' @export
 get_df.rq <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   if (type == "residual") {
     tryCatch(
       {
@@ -265,6 +307,8 @@ get_df.rq <- function(x, type = "residual", ...) {
         NULL
       }
     )
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     .model_df(x)
   }
@@ -273,9 +317,11 @@ get_df.rq <- function(x, type = "residual", ...) {
 
 #' @export
 get_df.rqss <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   if (type == "residual") {
     n_obs(x) - x$edf
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     .model_df(x)
   }
@@ -284,9 +330,11 @@ get_df.rqss <- function(x, type = "residual", ...) {
 
 #' @export
 get_df.bfsl <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   if (type == "residual") {
     x$df.residual
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     .model_df(x)
   }
@@ -295,9 +343,11 @@ get_df.bfsl <- function(x, type = "residual", ...) {
 
 #' @export
 get_df.plm <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   if (type == "residual") {
     x$df.residual
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     .model_df(x)
   }
@@ -306,9 +356,11 @@ get_df.plm <- function(x, type = "residual", ...) {
 
 #' @export
 get_df.selection <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     s <- summary(x)
     s$param$df
@@ -319,7 +371,7 @@ get_df.selection <- function(x, type = "residual", ...) {
 #' @export
 get_df.lmerMod <- function(x, type = "residual", ...) {
   dots <- list(...)
-  type <- match.arg(tolower(type), choices = c("residual", "model", "analytical", "satterthwaite", "kenward", "kenward-roger"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "analytical", "satterthwaite", "kenward", "kenward-roger", "normal", "wald"))
   # fix name for lmerTest
   if (type == "kenward") {
     type <- "kenward-roger"
@@ -350,11 +402,13 @@ get_df.lmerModTest <- get_df.lmerMod
 
 #' @export
 get_df.logitor <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal", "wald"))
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal") {
+    return(Inf)
   } else {
-    get_df.default(x$fit, ...)
+    get_df.default(x$fit, type = type, ...)
   }
 }
 
@@ -393,9 +447,11 @@ get_df.betamfx <- get_df.logitor
 
 #' @export
 get_df.merModList <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     s <- suppressWarnings(summary(x))
     s$fe$df
@@ -407,16 +463,18 @@ get_df.merModList <- function(x, type = "residual", ...) {
 get_df.mira <- function(x, type = "residual", ...) {
   # installed?
   check_if_installed("mice")
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   get_df(mice::pool(x), type, ...)
 }
 
 
 #' @export
 get_df.mipo <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     as.vector(summary(x)$df)
   }
@@ -425,9 +483,11 @@ get_df.mipo <- function(x, type = "residual", ...) {
 
 #' @export
 get_df.vgam <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     params <- get_parameters(x)
     out <- stats::setNames(rep(NA, nrow(params)), params$Parameter)
@@ -439,9 +499,11 @@ get_df.vgam <- function(x, type = "residual", ...) {
 
 #' @export
 get_df.rqs <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
   if (type == "model") {
     .model_df(x)
+  } else if (type == "normal") {
+    return(Inf)
   } else {
     tryCatch(
       {
@@ -459,7 +521,11 @@ get_df.rqs <- function(x, type = "residual", ...) {
 
 #' @export
 get_df.systemfit <- function(x, type = "residual", ...) {
-  type <- match.arg(tolower(type), choices = c("residual", "model"))
+  type <- match.arg(tolower(type), choices = c("residual", "model", "normal"))
+  if (type == "normal") {
+    return(Inf)
+  }
+
   df <- c()
   s <- summary(x)$eq
   params <- find_parameters(x)