Add support for "kenward" option (#1175)

* Support `"kenward"` option for glmmTMB

* formatting

* speed improvement

* fix

* fix

* fix, tests

* tests

* satterthwaite

* news, wordlist

* URLs

* fix

* fix

Author: strengejacke

.github/CONTRIBUTING.md

@@ -1,6 +1,6 @@
 # Contributing to parameters
 
-This outlines how to propose a change to **parameters**. 
+This outlines how to propose a change to **parameters**.
 
 ## Fixing typos
 
@@ -9,7 +9,7 @@ Small typos or grammatical errors in documentation may be edited directly using
 ## Filing an issue
 
 The easiest way to propose a change or new feature is to file an issue. If you've found a
-bug, you may also create an associated issue. If possible, try to illustrate your proposal or the bug with a minimal [reproducible example](https://www.tidyverse.org/help/#reprex).
+bug, you may also create an associated issue. If possible, try to illustrate your proposal or the bug with a minimal reproducible example.
 
 ## Pull requests
 

.github/SUPPORT.md

@@ -7,9 +7,7 @@ Start by making a minimal **repr**oducible **ex**ample using the
 [reprex](http://reprex.tidyverse.org/) package. If you haven't heard of or used
 reprex before, you're in for a treat! Seriously, reprex will make all of your
 R-question-asking endeavors easier (which is a pretty insane ROI for the five to
-ten minutes it'll take you to learn what it's all about). For additional reprex
-pointers, check out the [Get help!](https://www.tidyverse.org/help/) resource
-used by the tidyverse team.
+ten minutes it'll take you to learn what it's all about).
 
 Armed with your reprex, the next step is to figure out where to ask:
 
@@ -26,4 +24,4 @@ default, the search will be pre-populated with `is:issue is:open`. You can
 (e.g. `is:pr`, `is:closed`) as needed. For example, you'd simply
 remove `is:open` to search _all_ issues in the repo, open or closed.
 
-Thanks for your help!
+Thanks for your help!

DESCRIPTION

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

NAMESPACE

@@ -114,6 +114,8 @@ S3method(ci,systemfit)
 S3method(ci,varest)
 S3method(ci,zerocount)
 S3method(ci,zeroinfl)
+S3method(ci_kenward,default)
+S3method(ci_kenward,glmmTMB)
 S3method(cluster_discrimination,cluster_analysis)
 S3method(cluster_discrimination,default)
 S3method(cluster_performance,dbscan)
@@ -138,7 +140,6 @@ S3method(display,parameters_pca_summary)
 S3method(display,parameters_sem)
 S3method(display,parameters_simulate)
 S3method(display,parameters_standardized)
-S3method(dof_satterthwaite,lmerMod)
 S3method(equivalence_test,MixMod)
 S3method(equivalence_test,estimate_contrasts)
 S3method(equivalence_test,estimate_means)
@@ -568,7 +569,6 @@ S3method(p_value,wbm)
 S3method(p_value,zcpglm)
 S3method(p_value,zerocount)
 S3method(p_value,zeroinfl)
-S3method(p_value_kenward,lmerMod)
 S3method(plot,cluster_analysis)
 S3method(plot,cluster_analysis_summary)
 S3method(plot,compare_parameters)
@@ -660,6 +660,8 @@ S3method(reduce_parameters,lm)
 S3method(reduce_parameters,merMod)
 S3method(reshape_loadings,data.frame)
 S3method(reshape_loadings,parameters_efa)
+S3method(se_kenward,default)
+S3method(se_kenward,glmmTMB)
 S3method(se_satterthwaite,default)
 S3method(select_parameters,lm)
 S3method(select_parameters,merMod)

NEWS.md

@@ -4,6 +4,11 @@
 
 * Added support for package *lcmm*.
 
+* Added `ci_method` options `"kenward-roger"` and `"satterthwaite"` for models
+  from package *glmmTMB*. Consequently, `se_kenward()`, `se_satterthwaite()`,
+  `ci_kenward()`, `ci_satterthwaite()`, `p_value_kenward()` and
+  `p_value_satterthwaite()` can now be used with `glmmTMB` models.
+
 # parameters 0.28.2
 
 ## Bug fixes

R/ci_generic.R

@@ -1,19 +1,22 @@
 # generic function for CI calculation
-.ci_generic <- function(model,
-                        ci = 0.95,
-                        method = "wald",
-                        dof = NULL,
-                        effects = "fixed",
-                        component = "all",
-                        vcov = NULL,
-                        vcov_args = NULL,
-                        verbose = TRUE,
-                        ...) {
+.ci_generic <- function(
+  model,
+  ci = 0.95,
+  method = "wald",
+  dof = NULL,
+  effects = "fixed",
+  component = "all",
+  vcov = NULL,
+  vcov_args = NULL,
+  verbose = TRUE,
+  ...
+) {
   # check method
   if (is.null(method)) {
     method <- "wald"
   }
   method <- tolower(method)
+  # fmt: skip
   method <- insight::validate_argument(
     method,
     c(
@@ -23,6 +26,7 @@
   )
 
   effects <- insight::validate_argument(effects, c("fixed", "random", "all"))
+  # fmt: skip
   component <- insight::validate_argument(
     component,
     c(
@@ -31,7 +35,8 @@
     )
   )
 
-  if (method == "ml1") { # nolint
+  if (method == "ml1") {
+    # nolint
     return(ci_ml1(model, ci = ci))
   } else if (method == "betwithin") {
     return(ci_betwithin(model, ci = ci))

R/ci_kenward.R

@@ -1,7 +1,15 @@
 #' @rdname p_value_kenward
 #' @export
-ci_kenward <- function(model, ci = 0.95) {
-  .check_REML_fit(model)
+ci_kenward <- function(model, ci = 0.95, ...) {
+  UseMethod("ci_kenward")
+}
+
+#' @export
+ci_kenward.default <- function(model, ci = 0.95, ...) {
+  if (!.check_REML_fit(model)) {
+    model <- stats::update(model, . ~ ., REML = TRUE)
+  }
+
   df_kr <- dof_kenward(model)
   out <- lapply(ci, function(i) {
     .ci_dof(
@@ -19,15 +27,43 @@ ci_kenward <- function(model, ci = 0.95) {
   out
 }
 
+#' @export
+ci_kenward.glmmTMB <- function(model, ci = 0.95, ...) {
+  if (!.check_REML_fit(model)) {
+    model <- stats::update(model, . ~ ., REML = TRUE)
+  }
+
+  df_kr <- dof_kenward(model)
+  out <- lapply(ci, function(i) {
+    .ci_dof(
+      model = model,
+      ci = i,
+      dof = df_kr,
+      effects = "fixed",
+      component = "conditional", # for glmmTMB, only conditional
+      method = "kenward",
+      se = attr(df_kr, "se", exact = TRUE)
+    )
+  })
+  out <- do.call(rbind, out)
+  row.names(out) <- NULL
+  out
+}
+
 
 .ci_kenward_dof <- function(model, ci = 0.95, df_kr) {
+  if (inherits(model, "glmmTMB")) {
+    component <- "conditional"
+  } else {
+    component <- "all"
+  }
   out <- lapply(ci, function(i) {
     .ci_dof(
       model = model,
       ci = i,
       dof = df_kr$df_error,
       effects = "fixed",
-      component = "all",
+      component = component,
       method = "kenward",
       se = df_kr$SE
     )

R/ci_satterthwaite.R

@@ -2,13 +2,18 @@
 #' @export
 ci_satterthwaite <- function(model, ci = 0.95, ...) {
   df_satter <- dof_satterthwaite(model)
+  if (inherits(model, "glmmTMB")) {
+    component <- "conditional"
+  } else {
+    component <- "all"
+  }
   out <- lapply(ci, function(i) {
     .ci_dof(
       model = model,
       ci = i,
       dof = df_satter,
       effects = "fixed",
-      component = "all",
+      component = component,
       method = "satterthwaite",
       ...
     )

R/dof.R

@@ -154,7 +154,7 @@ dof <- degrees_of_freedom
       ))
     }
     return(FALSE)
-}
+  }
 
   if (!info$is_linear && method %in% c("satterthwaite", "kenward", "kr")) {
     if (verbose) {