Support for survey-Anova tables

Fixes #600

Author: strengejacke

DESCRIPTION

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

NAMESPACE

@@ -327,6 +327,7 @@ S3method(model_parameters,rqss)
 S3method(model_parameters,scam)
 S3method(model_parameters,selection)
 S3method(model_parameters,sem)
+S3method(model_parameters,seqanova.svyglm)
 S3method(model_parameters,slopes)
 S3method(model_parameters,stanfit)
 S3method(model_parameters,stanmvreg)

NEWS.md

@@ -9,6 +9,8 @@
 
 * Added support for `coxph.panel` models.
 
+* Added support for `anova()` from models of the *survey* package.
+
 ## Bug fixes
 
 * Fixed bug when extracting 'pretty labels' for model parameters, which could

R/extract_parameters_anova.R

@@ -15,6 +15,8 @@
     parameters <- .extract_anova_aovlist(model)
   } else if (inherits(model, "anova.rms")) {
     parameters <- .extract_anova_aov_rms(model)
+  } else if (inherits(model, "seqanova.svyglm")) {
+    parameters <- .extract_anova_aov_svyglm(model)
   }
 
   # Rename
@@ -70,7 +72,7 @@
   # Reorder
   row.names(parameters) <- NULL
   col_order <- c(
-    "Response", "Group", "Parameter", "Coefficient", "SE", "Pillai", "AIC",
+    "Response", "Group", "Parameter", "Coefficient", "DEff", "SE", "Pillai", "AIC",
     "BIC", "Log_Likelihood", "Chi2", "Chi2_df", "RSS", "Sum_Squares",
     "Sum_Squares_Partial", "Sum_Squares_Error", "df", "Deviance", "Statistic",
     "df_num", "df_error", "Deviance_error", "Mean_Square", "F", "Rao", "p"
@@ -255,6 +257,23 @@
 }
 
 
+# Anova.seqanova.svyglm -------------
+.extract_anova_aov_svyglm <- function(model) {
+  if (identical(attributes(model)$method, "Wald")) {
+    params <- lapply(model, function(x) {
+      data.frame(F = as.vector(x$Ftest), df = x$df, df_error = x$ddf, p = as.vector(x$p))
+    })
+  } else {
+    params <- lapply(model, function(x) {
+      data.frame(Chi2 = x$chisq, DEff = x$lambda, df = x$df, df_error = x$ddf, p = as.vector(x$p))
+    })
+  }
+
+  params <- do.call(rbind, params)
+  cbind(data.frame(Parameter = sapply(model, "[[", "test.terms"), params))
+}
+
+
 
 
 # test helper -------------

R/methods_aov.R

@@ -312,6 +312,10 @@ model_parameters.Anova.mlm <- model_parameters.aov
 #' @export
 model_parameters.maov <- model_parameters.aov
 
+#' @export
+model_parameters.seqanova.svyglm <- model_parameters.aov
+
+
 
 # helper ------------------------------
 

tests/testthat/_snaps/model_parameters.anova.md

@@ -26,3 +26,33 @@
       
       Anova Table (Type 3 tests)
 
+# anova survey
+
+    Code
+      print(model_parameters(out))
+    Output
+      # Fixed Effects
+      
+      Parameter | DEff | Chi2(1) | df (error) |     p
+      -----------------------------------------------
+      ell       | 0.77 |    1.13 |         38 | 0.236
+      meals     | 1.24 |    4.82 |         37 | 0.058
+      ell:meals | 1.48 |   16.52 |         36 | 0.002
+      
+      Anova Table (Type 1 tests)
+
+---
+
+    Code
+      print(model_parameters(out))
+    Output
+      # Fixed Effects
+      
+      Parameter | df | df (error) |    F |     p
+      ------------------------------------------
+      ell       |  1 |         38 | 1.47 | 0.234
+      meals     |  1 |         37 | 3.54 | 0.068
+      ell:meals |  1 |         36 | 9.10 | 0.005
+      
+      Anova Table (Type 1 tests)
+

tests/testthat/test-model_parameters.anova.R

@@ -273,3 +273,25 @@ test_that("anova rms", {
   expect_named(mp, c("Parameter", "Chi2", "df", "p"))
   expect_equal(mp$Chi2, data.frame(a)$Chi.Square, tolerance = 1e-3)
 })
+
+skip_if_not_installed("withr")
+
+withr::with_package(
+  "survey",
+  test_that("anova survey", {
+    skip_if_not_installed("survey")
+    data(api, package = "survey")
+    dclus2 <<- survey::svydesign(id =  ~dnum + snum, weights =  ~ pw, data = apiclus2)
+    model0 <- survey::svyglm(
+      I(sch.wide == "Yes") ~ ell * meals,
+      design = dclus2,
+      family = quasibinomial()
+    )
+
+    out <- anova(model0)
+    expect_snapshot(print(model_parameters(out)))
+
+    out <- anova(model0, method = "Wald")
+    expect_snapshot(print(model_parameters(out)))
+  })
+)