Merge pull request #507 from cmu-delphi/lcb/remove-select-epi-df

Remove `select.epi_df`

Author: brookslogan

DESCRIPTION

@@ -29,7 +29,7 @@ Imports:
     checkmate,
     cli,
     data.table,
-    dplyr (>= 1.0.0),
+    dplyr (>= 1.0.8),
     genlasso,
     ggplot2,
     glue,

NAMESPACE

@@ -38,7 +38,6 @@ S3method(next_after,integer)
 S3method(print,epi_archive)
 S3method(print,epi_df)
 S3method(print,grouped_epi_archive)
-S3method(select,epi_df)
 S3method(summary,epi_df)
 S3method(ungroup,epi_df)
 S3method(ungroup,grouped_epi_archive)

R/group_by_epi_df_methods.R

@@ -3,11 +3,3 @@
 # `epi_df`s. It would be nice if there were a way to replace these with a
 # generic core that automatically fixed all misbehaving methods; see
 # brainstorming within Issue #223.
-
-#' @importFrom dplyr select
-#' @export
-select.epi_df <- function(.data, ...) {
-  selected <- NextMethod(.data)
-  might_decay <- reclass(selected, attr(selected, "metadata"))
-  return(dplyr_reconstruct(might_decay, might_decay))
-}

tests/testthat/test-epi_slide.R

@@ -434,7 +434,7 @@ test_that("`ref_time_values` + `all_rows = TRUE` works", {
     ),
     basic_full_result %>%
       dplyr::mutate(slide_value = dplyr::if_else(time_value %in% (test_date + c(2L, 8L)),
-        slide_value, NA_integer_
+        slide_value, NA_real_ # (`^` outputs numeric)
       ))
   )
 
@@ -472,7 +472,7 @@ test_that("`ref_time_values` + `all_rows = TRUE` works", {
       ),
     basic_mean_result %>%
       dplyr::mutate(slide_value_value = dplyr::if_else(time_value %in% (test_date + c(2L, 8L)),
-        slide_value, NA_integer_
+        slide_value, NA_real_
       )) %>%
       select(-slide_value)
   )
@@ -498,7 +498,7 @@ test_that("`ref_time_values` + `all_rows = TRUE` works", {
     ),
     basic_full_result %>%
       dplyr::mutate(slide_value = dplyr::if_else(time_value %in% (test_date + c(2L, 8L)),
-        slide_value, NA_integer_
+        slide_value, NA_real_
       )) %>%
       dplyr::rename(slide_value_value = slide_value)
   )
@@ -584,7 +584,7 @@ test_that("`ref_time_values` + `all_rows = TRUE` works", {
       unnest(slide_value, names_sep = "_"),
     basic_full_result %>%
       dplyr::mutate(slide_value = dplyr::if_else(time_value %in% (test_date + c(2L, 8L)),
-        slide_value, NA_integer_
+        slide_value, NA_real_
       )) %>%
       dplyr::rename(slide_value_value = slide_value)
   )

tests/testthat/test-methods-epi_df.R

@@ -173,11 +173,30 @@ test_that("Renaming columns while grouped gives appropriate colnames and metadat
   expect_identical(attr(renamed_gedf1, "metadata")$other_keys, c("age_group"))
   # renaming using select
   renamed_gedf2 <- gedf %>%
-    as_epi_df(additional_metadata = list(other_keys = "age")) %>%
     select(geo_value, time_value, age_group = age, value)
   expect_identical(renamed_gedf1, renamed_gedf2)
 })
 
+test_that("Additional `select` on `epi_df` tests", {
+  edf <- tibble::tibble(geo_value = "ak", time_value = as.Date("2020-01-01"), age = 1, value = 1) %>%
+    as_epi_df(additional_metadata = list(other_keys = "age"))
+
+  # Dropping a non-geo_value epikey column doesn't decay, though maybe it
+  # should, since you'd expect that to possibly result in multiple rows per
+  # epikey (though not in this toy case), and while we don't require that, we
+  # sort of expect it:
+  edf_not_decayed <- edf %>%
+    select(geo_value, time_value, value)
+  expect_class(edf_not_decayed, "epi_df")
+  expect_identical(attr(edf_not_decayed, "metadata")$other_keys, character(0L))
+
+  # Dropping geo_value does decay:
+  edf_decayed <- edf %>%
+    select(age, time_value, value)
+  expect_false(inherits(edf_decayed, "epi_df"))
+  expect_identical(attr(edf_decayed, "metadata"), NULL)
+})
+
 test_that("complete.epi_df works", {
   start_date <- as.Date("2020-01-01")
   daily_edf <- tibble::tribble(