From a1a7dcecfbe603cd27ac5afbed5b6a4b881fd33b Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 17 Nov 2024 00:37:36 +0100 Subject: [PATCH] Support for survey-Anova tables (#1043) * Support for survey-Anova tables Fixes #600 * fix --- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 2 ++ R/extract_parameters_anova.R | 21 ++++++++++++- R/methods_aov.R | 4 +++ .../testthat/_snaps/model_parameters.anova.md | 30 +++++++++++++++++++ tests/testthat/test-model_parameters.anova.R | 22 ++++++++++++++ 7 files changed, 80 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index aeee7d2c4..ca5575ef6 100644 --- a/DESCRIPTION +++ b/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", diff --git a/NAMESPACE b/NAMESPACE index 172919606..6141109a3 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 61b14bfec..10e876bf2 100644 --- a/NEWS.md +++ b/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 diff --git a/R/extract_parameters_anova.R b/R/extract_parameters_anova.R index b46b750ed..5699a0d8c 100644 --- a/R/extract_parameters_anova.R +++ b/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 ------------- diff --git a/R/methods_aov.R b/R/methods_aov.R index 0d13590c0..a70f25e6e 100644 --- a/R/methods_aov.R +++ b/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 ------------------------------ diff --git a/tests/testthat/_snaps/model_parameters.anova.md b/tests/testthat/_snaps/model_parameters.anova.md index 5fad54b2d..da9f8cd8f 100644 --- a/tests/testthat/_snaps/model_parameters.anova.md +++ b/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) + diff --git a/tests/testthat/test-model_parameters.anova.R b/tests/testthat/test-model_parameters.anova.R index 3573a7b2e..3dbe00513 100644 --- a/tests/testthat/test-model_parameters.anova.R +++ b/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") +skip_if_not_installed("survey") + +withr::with_package( + "survey", + test_that("anova 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))) + }) +)