Add tidy.summary_emm() (#691)

* Adds tidy-method form summary_emm-objects.

* Updates NEWS

* Apply suggestions from code review

Co-Authored-By: alex hayes <alexpghayes@gmail.com>

* Makes requested changes for emmeans tidiers. (#691)

- Adds joint_tests()-example
- Removes strict = FALSE from tests

* Roxygenizes documentation.

DESCRIPTION

@@ -235,6 +235,11 @@ Authors@R:
              family = "Szoecs",
              role = "ctb",
              email = "eduardszoecs@gmail.com"),
+      person(given = "Frederik",
+             family = "Aust",
+             role = "ctb",
+             email = "frederik.aust@uni-koeln.de",
+             comment = c(ORCID = "0000-0003-4900-788X")),
       person(given = "Angus",
              family = "Moore",
              role = "ctb",

NAMESPACE

@@ -205,6 +205,7 @@ S3method(tidy,summary.glht)
 S3method(tidy,summary.lm)
 S3method(tidy,summary.lm.beta)
 S3method(tidy,summary.manova)
+S3method(tidy,summary_emm)
 S3method(tidy,survdiff)
 S3method(tidy,survexp)
 S3method(tidy,survfit)

NEWS.md

@@ -127,6 +127,8 @@ TODO: sort out what happens to `glance.aov()`
 
 - `tidy.lmodel2()` now returns a `p.value` column (#570)
 
+- Added `tidy.summary_emm()` (#691 by @crsh)
+
 - `tidy.zoo()` now doesn't change column names that have spaces or other
 special characters (previously they were converted to data.frame friendly
 column names by `make.names`)

R/emmeans-tidiers.R

@@ -62,6 +62,9 @@
 #' ggplot(tidy(by_price), aes(price2, estimate, color = day)) +
 #'   geom_line() +
 #'   geom_errorbar(aes(ymin = conf.low, ymax = conf.high))
+#'   
+#' # joint_tests
+#' tidy(joint_tests(oranges_lm1))
 #'
 #' @aliases emmeans_tidiers
 #' @export
@@ -126,9 +129,43 @@ tidy.emmGrid <- function(x, ...) {
   tidy_emmeans(x, ...)
 }
 
+#' @templateVar class summary_emm
+#' @template title_desc_tidy
+#' 
+#' @param x An `summary_emm` object.
+#' @inherit tidy.lsmobj params examples details 
+#'   
+#' @evalRd return_tidy(
+#'   "std.error", 
+#'   "df", 
+#'   "num.df",
+#'   "den.df",
+#'   "conf.low", 
+#'   "conf.high",
+#'   level1 = "One level of the factor being contrasted",
+#'   level2 = "The other level of the factor being contrasted",
+#'   "contrast",
+#'   term = "Model term in joint tests",
+#'   "p.value",
+#'   statistic = "T-ratio statistic or F-ratio statistic",
+#'   estimate = "Estimated least-squares mean."
+#' )
+#'
+#' @export
+#' @family emmeans tidiers
+#' @seealso [tidy()], [emmeans::ref_grid()], [emmeans::emmeans()],
+#'   [emmeans::contrast()]
+tidy.summary_emm <- function(x, ...) {
+  tidy_emmeans_summary(x, ...)
+}
+
 tidy_emmeans <- function(x, ...) {
   s <- summary(x, ...)
-  ret <- as.data.frame(s)
+  tidy_emmeans_summary(s)
+}
+
+tidy_emmeans_summary <- function(x) {
+  ret <- as.data.frame(x)
   repl <- list(
     "lsmean" = "estimate",
     "emmean" = "estimate",
@@ -137,17 +174,27 @@ tidy_emmeans <- function(x, ...) {
     "SE" = "std.error",
     "lower.CL" = "conf.low",
     "upper.CL" = "conf.high",
-    "t.ratio" = "statistic"
+    "t.ratio" = "statistic",
+    "F.ratio" = "statistic",
+    "df1" = "num.df",
+    "df2" = "den.df",
+    "model term" = "term"
   )
-
+  
   if ("contrast" %in% colnames(ret) &&
-    all(stringr::str_detect(ret$contrast, " - "))) {
+      all(stringr::str_detect(ret$contrast, " - "))) {
     ret <- tidyr::separate_(ret, "contrast",
-      c("level1", "level2"),
-      sep = " - "
+                            c("level1", "level2"),
+                            sep = " - "
     )
   }
-
+  
   colnames(ret) <- dplyr::recode(colnames(ret), !!!(repl))
+
+  if("term" %in% colnames(ret)) {
+    ret <- ret %>%
+      mutate(term = stringr::str_trim(term))
+  }
+
   as_tibble(ret)
 }

tests/testthat/test-emmeans.R

@@ -11,6 +11,10 @@ rg <- ref.grid(fit)
 
 marginal <- lsmeans(rg, "day")
 
+marginal_summary <- summary(marginal)
+
+joint_tests_summary <- joint_tests(fit)
+
 # generate dataset with dashes
 marginal_dashes <- tibble(
   y = rnorm(100),
@@ -30,7 +34,7 @@ test_that("tidy.lsmobj", {
   tdm <- tidy(marginal)
   tdmd <- tidy(marginal_dashes)
   tdc <- tidy(contrast(marginal, method = "pairwise"))
-  
+
   check_tidy_output(tdm, strict = FALSE)
   check_tidy_output(tdmd, strict = FALSE)
   check_tidy_output(tdc, strict = FALSE)
@@ -45,3 +49,14 @@ test_that("ref.grid tidiers work", {
   check_tidy_output(td, strict = FALSE)
   check_dims(td, 36, 7)
 })
+
+test_that("summary_emm tidiers work", {
+  tdm <- tidy(marginal)
+  tdms <- tidy(marginal_summary)
+
+  expect_identical(tdm, tdms)
+
+  tdjt <- tidy(joint_tests_summary)
+  check_tidy_output(tdjt)
+  check_dims(tdjt, 2, 5)
+})