fix tidy.anova for lme4 anova headers (#1115)

DESCRIPTION

@@ -567,6 +567,7 @@ Suggests:
     boot,
     btergm (>= 1.10.6),
     car,
+    carData,
     caret,
     cluster,
     cmprsk,

NEWS.md

@@ -4,6 +4,7 @@ To be released as broom 1.0.1.
 
 * Improves performance of `tidy.lm()` and `tidy.glm()` for full-rank fits (#1112 by `@capnrefsmmat`).
 * Moves forward with deprecation of tidiers for sparse matrices outputted from the Matrix package, initially soft-deprecated in broom 0.5.0. The Matrix tidiers were light wrappers around coercion methods that will now be deprecated from Matrix itself in the upcoming 1.4-2 release. The affected methods are `tidy.sparseMatrix()`, `tidy.dgCMatrix()`, and `tidy.dgTMatrix()`. Note that `tidy.confusionMatrix()`, for relevant objects outputted from the caret package, is unaffected (#1113).
+* `tidy.anova()` works again with `anova` objects from the `lme4` package (broken by addition of the `terms` column in the previous release)
 
 # broom 1.0.0
 

R/stats-anova-tidiers.R

@@ -67,6 +67,7 @@ tidy.anova <- function(x, ...) {
     "Sum of Sq" = "sumsq",
     "F" = "statistic",
     "Chisq" = "statistic",
+    "npar" = "npar",
     "P(>|Chi|)" = "p.value",
     "Pr(>|Chi|)" = "p.value",
     "Pr(>Chi)" = "p.value",
@@ -100,12 +101,17 @@ tidy.anova <- function(x, ...) {
 
   # Special catch for car::linearHypothesis
   x_attr <- attributes(x)
+  ## include "Model 1:", "Model 2:" (stats::anova()) and "mod1:", "mod2:" 
+  ## (lme4::anova()), but *exclude* "Models:" (found in lme4::anova() header).
+  ## alternatively, could drop the first line of the header?
+  modstr <- "[Mm]od.*[0-9]+:"
+  mod_lines <- grep(modstr, x_attr$heading, value = TRUE)
   if (!is.null(x_attr$value)) {
     if (isTRUE(grepl("^Linear hypothesis", x_attr$heading[[1]]))) {
       # Drop unrestricted model (not interesting in linear hypothesis tests)
       # Use formula to subset if available (e.g. with car::linearHypothesis)
-      if (length(grep("Model", x_attr$heading)) != 0) {
-        idx <- sub(".*: ", "", strsplit(x_attr$heading[grep("Model", x_attr$heading)], "\n")[[1]])
+      if (length(mod_lines) != 0) {
+        idx <- sub(".*: ", "", strsplit(mod_lines, "\n")[[1]])
         idx <- idx != "restricted model"
         ret <- ret[idx, , drop = FALSE]
       }
@@ -127,8 +133,8 @@ tidy.anova <- function(x, ...) {
       ret < cbind(cbind(term, ret), response)
       row.names(ret) <- NULL
     }
-  } else if (length(grep("Model", x_attr$heading)) != 0) {
-    mods <- sub(".*: ", "", strsplit(x_attr$heading[grep("Model", x_attr$heading)], "\n")[[1]])
+  } else if (is.null(ret$term) & length(mod_lines) != 0) {
+    mods <- sub(".*: ", "", strsplit(mod_lines, "\n")[[1]])
     ret <- cbind(term = mods, ret)
   } else if (is.null(ret$term) & !is.null(row.names(ret))) {
     ret <- cbind(term = row.names(ret), ret)

tests/testthat/test-car.R

@@ -24,8 +24,10 @@ test_that("tidy.durbinWatsonTest", {
 })
 
 test_that("tidy.leveneTest", {
-  mod1 <- with(Moore, leveneTest(conformity, fcategory))
-  mod2 <- with(Moore, leveneTest(conformity, interaction(fcategory, partner.status)))
+  skip_if_not_installed("carData")
+
+  mod1 <- with(carData::Moore, leveneTest(conformity, fcategory))
+  mod2 <- with(carData::Moore, leveneTest(conformity, interaction(fcategory, partner.status)))
   mod3 <- leveneTest(conformity ~ fcategory * partner.status, data = Moore)
   mod4 <- leveneTest(lm(conformity ~ fcategory * partner.status, data = Moore))
   mod5 <- leveneTest(conformity ~ fcategory * partner.status, data = Moore, center = mean)

tests/testthat/test-stats-anova.R

@@ -18,12 +18,17 @@ test_that("tidy.aov", {
 test_that("tidy.anova", {
   check_arguments(tidy.anova)
 
-  anovafit <- stats::anova(lm(mpg ~ wt + disp, mtcars))
+  m1 <- lm(mpg ~ wt + disp, mtcars)
+  m2 <- update(m1, . ~ . - disp)
+  anovafit <- stats::anova(m1)
   td <- tidy(anovafit)
 
   check_tidy_output(td)
   check_dims(td, 3, 6)
-
+
+  anovacomp <- stats::anova(m2, m1)
+  td2 <- tidy(anovacomp)
+
   expect_true("Residuals" %in% td$term)
 
   loess_anova <- stats::anova(
@@ -32,6 +37,8 @@ test_that("tidy.anova", {
   )
 
   expect_warning(tidy(loess_anova))
+
+
 })
 
 test_that("glance.anova", {
@@ -112,4 +119,13 @@ test_that("tidy.linearHypothesis", {
 
 })
 
-
+skip_if_not_installed("lme4")
+test_that("tidy.anova for merMod objects", {
+  m1_mer <- lme4::lmer(mpg ~ wt + (1|cyl), data = mtcars)
+  m2_mer <- update(m1_mer, . ~ . + disp)
+  aa_mer <- anova(m1_mer, m2_mer, refit = FALSE)
+  td <- tidy(aa_mer)
+  check_tidy_output(td, strict = FALSE)
+  check_dims(td, 2, 9)
+}
+)