Add complete.epi_df method so grouped completions don't drop epi_dfness

Author: brookslogan

NAMESPACE

@@ -11,6 +11,7 @@ S3method(as_tsibble,epi_df)
 S3method(autoplot,epi_df)
 S3method(clone,epi_archive)
 S3method(clone,grouped_epi_archive)
+S3method(complete,epi_df)
 S3method(dplyr_col_modify,col_modify_recorder_df)
 S3method(dplyr_col_modify,epi_df)
 S3method(dplyr_reconstruct,epi_df)
@@ -50,6 +51,7 @@ export(as_epi_df)
 export(as_tsibble)
 export(autoplot)
 export(clone)
+export(complete)
 export(detect_outlr)
 export(detect_outlr_rm)
 export(detect_outlr_stl)
@@ -64,6 +66,7 @@ export(epix_merge)
 export(epix_slide)
 export(epix_truncate_versions_after)
 export(filter)
+export(full_seq)
 export(geo_column_names)
 export(group_by)
 export(group_modify)
@@ -194,6 +197,8 @@ importFrom(stats,median)
 importFrom(tibble,as_tibble)
 importFrom(tibble,new_tibble)
 importFrom(tibble,validate_tibble)
+importFrom(tidyr,complete)
+importFrom(tidyr,full_seq)
 importFrom(tidyr,unnest)
 importFrom(tidyselect,any_of)
 importFrom(tidyselect,eval_select)

R/methods-epi_df.R

@@ -8,7 +8,6 @@
 #' use `attr(your_epi_df, "decay_to_tibble") <- FALSE` beforehand.
 #'
 #' @template x
-#' @param ... additional arguments to forward to `NextMethod()`
 #'
 #' @importFrom tibble as_tibble
 #' @export
@@ -48,9 +47,9 @@ as_tsibble.epi_df <- function(x, key, ...) {
 #' Print and summary functions for an `epi_df` object.
 #'
 #' @template x
-#' @param ... additional arguments to forward to `NextMethod()`
 #'
 #' @method print epi_df
+#' @param ... additional arguments to forward to `NextMethod()`, or unused
 #' @export
 print.epi_df <- function(x, ...) {
   cat(
@@ -76,7 +75,6 @@ print.epi_df <- function(x, ...) {
 #'   Currently unused.
 #'
 #' @method summary epi_df
-#' @rdname print.epi_df
 #' @importFrom rlang .data
 #' @importFrom stats median
 #' @export
@@ -241,6 +239,21 @@ group_modify.epi_df <- function(.data, .f, ..., .keep = FALSE) {
   dplyr::dplyr_reconstruct(NextMethod(), .data)
 }
 
+#' @importFrom tidyr complete
+#' @rdname print.epi_df
+#' @param data an `epi_df`
+#' @param fill see [`tidyr::complete`]
+#' @param explicit see [`tidyr::complete`]
+#' @method complete epi_df
+#' @export
+complete.epi_df <- function(data, ..., fill = list(), explicit = TRUE) {
+  result <- dplyr::dplyr_reconstruct(NextMethod(), data)
+  if ("time_value" %in% names(rlang::call_match(dots_expand = FALSE)[["..."]])) {
+    attr(result, "metadata")$time_type <- guess_time_type(result$time_value)
+  }
+  result
+}
+
 #' @method unnest epi_df
 #' @rdname print.epi_df
 #' @param data an `epi_df`

R/reexports.R

@@ -57,6 +57,19 @@ dplyr::slice
 tidyr::unnest
 
 
+#' @importFrom tidyr complete
+#' @export
+tidyr::complete
+
+# We don't provide a method for full_seq, but complete-ing using
+# full_seq(time_value) is still needed to make some downstream things behave
+# nicely.  So make that more ergonomic/discoverable with a re-export:
+
+#' @importFrom tidyr full_seq
+#' @export
+tidyr::full_seq
+
+
 # ggplot2 -----------------------------------------------------------------
 
 #' @importFrom ggplot2 autoplot

man/as_tibble.epi_df.Rd

@@ -177,3 +177,64 @@ test_that("Renaming columns while grouped gives appropriate colnames and metadat
     select(geo_value, time_value, age_group = age, value)
   expect_identical(renamed_gedf1, renamed_gedf2)
 })
+
+test_that("complete.epi_df works", {
+  start_date <- as.Date("2020-01-01")
+  daily_edf <- tibble::tibble(
+    geo_value = c(1, 2),
+    time_value = start_date + c(1, 2),
+    value = 1
+  ) %>%
+    as_epi_df(as_of = start_date + 3)
+  expect_identical(
+    daily_edf %>%
+      tidyr::complete(geo_value, time_value = full_seq(time_value, period = 1)),
+    tibble::tibble(
+      geo_value = c(1, 1, 2, 2),
+      time_value = start_date + c(1, 2, 1, 2),
+      value = c(1, NA, NA, 1)
+    ) %>%
+      as_epi_df(as_of = start_date + 3)
+  )
+  expect_identical(
+    daily_edf %>%
+      group_by(geo_value) %>%
+      tidyr::complete(time_value = full_seq(time_value, period = 1)),
+    daily_edf %>%
+      group_by(geo_value)
+  )
+  weekly_edf <- tibble::tibble(
+    geo_value = c(1, 1, 1, 2),
+    time_value = start_date + c(1, 15, 22, 1),
+    value = 1
+  ) %>%
+    as_epi_df(as_of = start_date + 3)
+  expect_identical(
+    weekly_edf %>%
+      complete(geo_value,
+        time_value = full_seq(time_value, period = 7),
+        fill = list(value = 5)
+      ),
+    tibble::tibble(
+      geo_value = c(1, 1, 1, 1, 2, 2, 2, 2),
+      time_value = start_date + c(1, 8, 15, 22, 1, 8, 15, 22),
+      value = c(1, 5, 1, 1, 1, 5, 5, 5)
+    ) %>%
+      as_epi_df(as_of = start_date + 3)
+  )
+  expect_identical(
+    weekly_edf %>%
+      group_by(geo_value) %>%
+      complete(
+        time_value = full_seq(time_value, period = 7),
+        fill = list(value = 5)
+      ) %>%
+      ungroup(),
+    tibble::tibble(
+      geo_value = c(1, 1, 1, 1, 2),
+      time_value = start_date + c(1, 8, 15, 22, 1),
+      value = c(1, 5, 1, 1, 1)
+    ) %>%
+      as_epi_df(as_of = start_date + 3)
+  )
+})