Speed up large gam with random effects (#1196)

* Speed up large `gam` with random effects
easystats/insight#1169

* docs

* update snaps

* add test

* news

* formatting

* formatting

* news

Author: strengejacke

DESCRIPTION

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

NEWS.md

@@ -12,6 +12,11 @@
 
 * `model_parameters()` now supports objects from the *lavaan.mi* package.
 
+* Improved performance of `model_parameters()` for large `mgcv::gam()` models
+  that include random effects when using the new `re_test` argument (e.g.,
+  setting `re_test = FALSE` to skip expensive random-effect tests). Default
+  behavior (with `re_test = TRUE`) is unchanged.
+
 ## Bug fixes
 
 * Fixed issue where wrong (non-robust) standard errors were calculated for

R/1_model_parameters.R

@@ -634,17 +634,21 @@ model_parameters.default <- function(
   if (length(out) == 1 && isTRUE(is.na(out))) {
     insight::format_error(
       paste0(
-        "Sorry, `model_parameters()` failed with the following error (possible class `",
-        class(model)[1],
-        "` not supported):\n"
+        "Sorry, ",
+        sQuote("model_parameters()"),
+        " failed with the following error (possible class ",
+        sQuote(class(model)[1]),
+        " not supported):\n"
       ),
       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],
-      "`."
+      "Sorry, ",
+      sQuote("model_parameters()"),
+      " does not currently work for objects of class ",
+      sQuote(class(model)[1]),
+      "."
     ))
   }
 }

R/extract_parameters.R

@@ -57,7 +57,7 @@
     component = component,
     verbose = FALSE
   )
-  statistic <- insight::get_statistic(model, component = component)
+  statistic <- insight::get_statistic(model, component = component, ...)
 
   # check if all estimates are non-NA
   parameters <- .check_rank_deficiency(model, parameters)

R/methods_gam.R

@@ -1,9 +1,7 @@
 # classes: .gam, .list
 
-
 #################### .gam ------
 
-
 #' @export
 model_parameters.gam <- model_parameters.cgam
 
@@ -14,10 +12,16 @@ ci.gam <- function(x, ci = 0.95, method = NULL, ...) {
 }
 
 
+#' @param re_test Logical, if `TRUE` (default), tests for random effects terms
+#' are performed. Only applies to `mgcv::gam()` model. For large models these
+#' tests can be computationally expensive, in which case it is recommended to
+#' set this argument to `FALSE`.
+#' @rdname standard_error
 #' @export
-standard_error.gam <- function(model, ...) {
-  p.table <- summary(model)$p.table
-  s.table <- summary(model)$s.table
+standard_error.gam <- function(model, re_test = TRUE, ...) {
+  summ <- summary(model, re.test = re_test)
+  p.table <- summ$p.table
+  s.table <- summ$s.table
   d1 <- d2 <- NULL
 
   if (!is.null(p.table)) {
@@ -28,22 +32,21 @@ standard_error.gam <- function(model, ...) {
     )
   }
 
-  if (!is.null(s.table)) {
-    d2 <- .data_frame(
-      Parameter = rownames(s.table),
-      SE = NA,
-      Component = "smooth_terms"
-    )
+  if (!is.null(s.table) && nrow(s.table) > 0) {
+    d2 <- .data_frame(Parameter = rownames(s.table), SE = NA, Component = "smooth_terms")
   }
 
   insight::text_remove_backticks(rbind(d1, d2), verbose = FALSE)
 }
 
 
+#' @inheritParams standard_error.gam
+#' @rdname p_value
 #' @export
-p_value.gam <- function(model, ...) {
-  p.table <- summary(model)$p.table
-  s.table <- summary(model)$s.table
+p_value.gam <- function(model, re_test = TRUE, ...) {
+  summ <- summary(model, re.test = re_test)
+  p.table <- summ$p.table
+  s.table <- summ$s.table
   d1 <- d2 <- NULL
 
   if (!is.null(p.table)) {
@@ -54,7 +57,7 @@ p_value.gam <- function(model, ...) {
     )
   }
 
-  if (!is.null(s.table)) {
+  if (!is.null(s.table) && nrow(s.table) > 0) {
     d2 <- .data_frame(
       Parameter = rownames(s.table),
       p = as.vector(s.table[, 4]),
@@ -68,7 +71,9 @@ p_value.gam <- function(model, ...) {
 
 #' @export
 simulate_model.gam <- function(model, iterations = 1000, ...) {
-  if (is.null(iterations)) iterations <- 1000
+  if (is.null(iterations)) {
+    iterations <- 1000
+  }
 
   beta <- stats::coef(model)
   varcov <- insight::get_varcov(model, component = "all", ...)
@@ -83,7 +88,6 @@ simulate_model.gam <- function(model, iterations = 1000, ...) {
 
 #################### .list ------
 
-
 #' @export
 model_parameters.list <- function(model, ...) {
   if ("gam" %in% names(model)) {
@@ -94,7 +98,9 @@ model_parameters.list <- function(model, ...) {
     model <- model$pamobject
     model_parameters(model, ...)
   } else {
-    insight::format_error("We don't recognize this object of class `list`. Please raise an issue.")
+    insight::format_error(
+      "We don't recognize this object of class `list`. Please raise an issue."
+    )
   }
 }