fix #556 (#1061)

* fix #556 * lint + style * oops! @strengejacke good catch * more tests * update description --------- Co-authored-by: Daniel <[email protected]>
easystats · Feb 20, 2025 · 23d3b07 · 23d3b07
1 parent 6119c63
commit 23d3b07
Show file tree

Hide file tree

Showing 4 changed files with 61 additions and 4 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.24.1.1
+Version: 0.24.1.2
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

diff --git a/NEWS.md b/NEWS.md
@@ -19,6 +19,8 @@
 
 ## Bug fixes
 
+* Fixed issue with `model_parameters(<aovlist>, table_wide = TRUE)` with complex error structures ( #556 )
+
 * Fixed issue when printing `model_parameters()` with models from `mgcv::gam()`.
 
 * Fixed issues due to breaking changes in the latest release of the *datawizard*

diff --git a/R/methods_aov.R b/R/methods_aov.R
@@ -532,19 +532,25 @@ model_parameters.seqanova.svyglm <- model_parameters.aov
 .anova_table_wide <- function(data, ...) {
   wide_anova <- function(x) {
     # creating numerator and denominator degrees of freedom
-    idxResid <- x$Parameter == "Residuals"
+    idxResid <- which(x$Parameter == "Residuals")
     if (length(idxResid)) {
       x$df_error <- x$df[idxResid]
       x$Sum_Squares_Error <- x$Sum_Squares[idxResid]
-      x$Mean_Square_Error <- x$Sum_Squares[idxResid]
-      x <- x[!idxResid, ]
+      x$Mean_Square_Error <- x$Mean_Square[idxResid]
+      x <- x[-idxResid, ]
     }
     x
   }
 
   if ("Group" %in% colnames(data)) {
     data <- split(data, data$Group)
     data <- lapply(data, wide_anova)
+    data <- Filter(function(x) nrow(x) >= 1L, data)
+    cols <- unique(unlist(lapply(data, colnames)))
+    data <- lapply(data, function(x) {
+      x[, setdiff(cols, colnames(x))] <- NA
+      x
+    })
     data <- do.call(rbind, data)
   } else {
     data <- wide_anova(data)

diff --git a/tests/testthat/test-model_parameters.aov.R b/tests/testthat/test-model_parameters.aov.R
@@ -84,3 +84,52 @@ test_that("model_parameters.anova", {
   model <- aov(Sepal.Length ~ Species / Cat1 + Error(Cat2), data = iris)
   expect_identical(sum(model_parameters(model, verbose = FALSE)$df), 149)
 })
+
+
+test_that("model_parameters.aov - table_wide", {
+  skip_if_not_installed("effectsize")
+  skip_if_not_installed("datawizard")
+
+  data("iris")
+  # can't use the pipe yet :(
+  iris_long <- datawizard::data_modify(iris, id = seq_along(Species))
+  iris_long <- datawizard::data_to_long(iris_long, select = colnames(iris)[1:4])
+  iris_long <- datawizard::data_separate(iris_long,
+    select = "name", separator = "\\.",
+    new_columns = c("attribute", "measure")
+  )
+
+  mod1 <- stats::aov(
+    formula = value ~ attribute * measure + Error(id),
+    data = iris_long
+  )
+
+  mod2 <- stats::aov(
+    formula = value ~ attribute * measure + Error(id / (attribute * measure)),
+    data = iris_long
+  )
+
+  mp1 <- model_parameters(mod1, eta_squared = "partial", ci = 0.95, table_wide = TRUE)
+  mp2 <- model_parameters(mod2, eta_squared = "partial", ci = 0.95, table_wide = TRUE)
+
+  expect_identical(nrow(mp1), 3L)
+  expect_identical(nrow(mp2), 6L)
+
+
+
+  mod1 <- aov(yield ~ N * P * K + Error(block), data = npk)
+
+  out1 <- model_parameters(mod1, table_wide = FALSE)
+  out2 <- model_parameters(mod1, table_wide = TRUE)
+
+  idx <- which(out1$Parameter == "Residuals")
+
+  expect_true(all(out2$Sum_Squares_Error %in% out1$Sum_Squares[idx]))
+  expect_true(all(out1$Sum_Squares[idx] %in% out2$Sum_Squares_Error))
+
+  expect_true(all(out2$Mean_Square_Error %in% out1$Mean_Square[idx]))
+  expect_true(all(out1$Mean_Square[idx] %in% out2$Mean_Square_Error))
+
+  expect_true(all(out2$df_error %in% out1$df[idx]))
+  expect_true(all(out1$df[idx] %in% out2$df_error))
+})