Djm/as tibble attr

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: epiprocess
 Title: Tools for basic signal processing in epidemiology
-Version: 0.7.11
+Version: 0.7.12
 Authors@R: c(
     person("Jacob", "Bien", role = "ctb"),
     person("Logan", "Brooks", email = "[email protected]", role = c("aut", "cre")),

NEWS.md

@@ -34,6 +34,10 @@ Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.x.y will indicat
   format.
 - Improved documentation web site landing page's introduction.
 
+## Cleanup
+- Added optional `decay_to_tibble` attribute controlling `as_tibble()` behavior
+  of `epi_df`s to let `{epipredict}` work more easily with other libraries (#471).
+
 # epiprocess 0.7.0
 
 ## Breaking changes:

R/methods-epi_df.R

@@ -3,6 +3,10 @@
 #' Converts an `epi_df` object into a tibble, dropping metadata and any
 #' grouping.
 #'
+#' Advanced: if you are working with a third-party package that uses
+#' `as_tibble()` on `epi_df`s but you actually want them to remain `epi_df`s,
+#' use `attr(your_epi_df, "decay_to_tibble") <- FALSE` beforehand.
+#'
 #' @template x
 #' @param ... additional arguments to forward to `NextMethod()`
 #'
@@ -12,7 +16,11 @@ as_tibble.epi_df <- function(x, ...) {
   # Decaying drops the class and metadata. `as_tibble.grouped_df` drops the
   # grouping and should be called by `NextMethod()` in the current design.
   # See #223 for discussion of alternatives.
-  decay_epi_df(NextMethod())
+  if (attr(x, "decay_to_tibble") %||% TRUE) {
+    return(decay_epi_df(NextMethod()))
+  }
+  metadata <- attr(x, "metadata")
+  reclass(NextMethod(), metadata)
 }
 
 #' Convert to tsibble format
@@ -52,6 +60,8 @@ print.epi_df <- function(x, ...) {
   cat(sprintf("* %-9s = %s\n", "geo_type", attributes(x)$metadata$geo_type))
   cat(sprintf("* %-9s = %s\n", "time_type", attributes(x)$metadata$time_type))
   cat(sprintf("* %-9s = %s\n", "as_of", attributes(x)$metadata$as_of))
+  # Conditional output (silent if attribute is NULL):
+  cat(sprintf("* %-9s = %s\n", "decay_to_tibble", attr(x, "decay_to_tibble")))
   cat("\n")
   NextMethod()
 }

tests/testthat/test-as_tibble-decay.R

@@ -0,0 +1,19 @@
+test_that("as_tibble checks an attr to avoid decay to tibble", {
+  edf <- jhu_csse_daily_subset
+  expect_identical(class(as_tibble(edf)), c("tbl_df", "tbl", "data.frame"))
+  attr(edf, "decay_to_tibble") <- TRUE
+  expect_identical(class(as_tibble(edf)), c("tbl_df", "tbl", "data.frame"))
+  attr(edf, "decay_to_tibble") <- FALSE
+  expect_identical(class(as_tibble(edf)), c("epi_df", "tbl_df", "tbl", "data.frame"))
+})
+
+test_that("as_tibble ungroups if needed", {
+  edf <- jhu_csse_daily_subset %>% group_by(geo_value)
+  # removes the grouped_df class
+  expect_identical(class(as_tibble(edf)), c("tbl_df", "tbl", "data.frame"))
+  attr(edf, "decay_to_tibble") <- TRUE
+  expect_identical(class(as_tibble(edf)), c("tbl_df", "tbl", "data.frame"))
+  attr(edf, "decay_to_tibble") <- FALSE
+  # removes grouped_df but not `epi_df`
+  expect_identical(class(as_tibble(edf)), c("epi_df", "tbl_df", "tbl", "data.frame"))
+})