Test filter.epi_archive, fix&tweak some behaviors

Author: brookslogan

R/methods-epi_archive.R

@@ -1042,7 +1042,7 @@ filter.epi_archive <- function(.data, ..., .by = NULL, .format_aware = FALSE) {
   in_tbl <- tibble::as_tibble(as.list(.data$DT), .name_repair = "minimal")
   if (.format_aware) {
     out_tbl <- in_tbl %>%
-      filter(..., .by = .by)
+      filter(..., .by = {{.by}})
   } else {
     measurement_colnames <- setdiff(names(.data$DT), key_colnames(.data))
     forbidden_colnames <- c("version", measurement_colnames)
@@ -1067,13 +1067,13 @@ filter.epi_archive <- function(.data, ..., .by = NULL, .format_aware = FALSE) {
                 "Using `version` in `filter.epi_archive` may produce unexpected results.",
                 ">" = "See if `epix_as_of` or `epix_slide` would work instead.",
                 ">" = "If not, see `?filter.epi_archive` details for how to proceed."
-              )), assign.env = e)
+              ), class = "epiprocess__filter_archive__used_version"), assign.env = e)
               for (measurement_colname in measurement_colnames) {
                 delayedAssign(measurement_colname, cli::cli_abort(c(
                   "Using `{format_varname(measurement_colname)}`
                  in `filter.epi_archive` may produce unexpected results.",
                   ">" = "See `?filter.epi_archive` details for how to proceed."
-                )), assign.env = e)
+                ), class = "epiprocess__filter_archive__used_measurement"), assign.env = e)
               }
               break
             }
@@ -1082,16 +1082,23 @@ filter.epi_archive <- function(.data, ..., .by = NULL, .format_aware = FALSE) {
           TRUE
         },
         ...,
-        .by = .by
+        .by = {{.by}}
       )
   }
   # We could try to re-infer the geo_type, e.g., when filtering from
   # national+state to just state. However, we risk inference failures such as
   # "hrr" -> "hhs" from filtering to hrr 10, or "custom" -> USA-related when
   # working with non-USA data:
   out_geo_type <- .data$geo_type
-  # We might be going from daily to weekly; re-infer:
-  out_time_type <- guess_time_type(out_tbl$time_value)
+  if (.data$time_type == "day") {
+    # We might be going from daily to weekly; re-infer:
+    out_time_type <- guess_time_type(out_tbl$time_value)
+  } else {
+    # We might be filtering weekly to a single time_value; avoid re-inferring to
+    # stay "week". Or in other cases, just skip inferring, as re-inferring is
+    # expected to match the input time_type:
+    out_time_type <- .data$time_type
+  }
   # Even if they narrow down to just a single value of an other_keys column,
   # it's probably still better (& simpler) to treat it as an other_keys column
   # since it still exists in the result:

tests/testthat/test-methods-epi_archive.R

@@ -128,3 +128,103 @@ test_that("group_vars works as expected", {
     "geo_value"
   )
 })
+
+test_that("filter.epi_archive works as expected", {
+
+  ea2 <- ea2_data %>%
+    as_epi_archive()
+
+  # Some basic output value checks:
+
+  expect_equal(
+    ea2 %>% filter(geo_value == "tn"),
+    new_epi_archive(
+      ea2$DT[FALSE],
+      ea2$geo_type, ea2$time_type, ea2$other_keys,
+      ea2$clobberable_versions_start, ea2$versions_end
+    )
+  )
+
+  expect_equal(
+    ea2 %>% filter(geo_value == "ca", time_value == as.Date("2020-06-02")),
+    new_epi_archive(
+      data.table::data.table(geo_value = "ca", time_value = as.Date("2020-06-02"),
+                             version = as.Date("2020-06-02") + 0:2, cases = 0:2),
+      ea2$geo_type, ea2$time_type, ea2$other_keys,
+      ea2$clobberable_versions_start, ea2$versions_end
+    )
+  )
+
+  # Output geo_type and time_type behavior:
+
+  hrr_day_ea <- tibble(
+    geo_value = c(rep(1, 14), 100),
+    time_value = as.Date("2020-01-01") - 1 + c(1:14, 14),
+    version = time_value + 3,
+    value = 1:15
+  ) %>%
+    as_epi_archive()
+
+  expect_equal(hrr_day_ea$geo_type, "hrr")
+  expect_equal(hrr_day_ea$time_type, "day")
+
+  hrr_week_ea <- hrr_day_ea %>%
+    filter(geo_value == 1, as.POSIXlt(time_value)$wday == 6L)
+
+  expect_equal(hrr_week_ea$geo_type, "hrr")
+  expect_equal(hrr_week_ea$time_type, "week")
+
+  hrr_one_week_ea <- hrr_week_ea %>%
+    filter(time_value == time_value[[1]])
+
+  expect_equal(hrr_one_week_ea$time_type, "week")
+
+  intcustom_day_ea <- hrr_day_ea
+  intcustom_day_ea$geo_type <- "custom"
+
+  intcustom_week_ea <- intcustom_day_ea %>%
+    filter(geo_value == 1, as.POSIXlt(time_value)$wday == 6L)
+
+  expect_equal(intcustom_week_ea$geo_type, "custom")
+  expect_equal(intcustom_week_ea$time_type, "week")
+
+  # Error-raising:
+  expect_error(
+    ea2 %>% filter(version == as.Date("2020-06-02")),
+    class = "epiprocess__filter_archive__used_version"
+  )
+  expect_error(
+    ea2 %>% filter(version <= as.Date("2020-06-02")),
+    class = "epiprocess__filter_archive__used_version"
+  )
+  expect_snapshot(
+    ea2 %>% filter(version <= as.Date("2020-06-02")),
+    error = TRUE, cnd_class = TRUE
+  )
+  expect_error(
+    ea2 %>% filter(time_value >= as.Date("2020-06-02"), cases >= 2L),
+    class = "epiprocess__filter_archive__used_measurement"
+  )
+  expect_snapshot(
+    ea2 %>% filter(time_value >= as.Date("2020-06-02"), cases >= 2L),
+    error = TRUE, cnd_class = TRUE
+  )
+  expect_error(
+    ea2 %>% filter(time_value >= as.Date("2020-06-02"), cases >= 2L),
+    class = "epiprocess__filter_archive__used_measurement"
+  )
+  expect_error(
+    ea2 %>% filter(cases >= median(cases), .by = geo_value),
+    class = "epiprocess__filter_archive__used_measurement"
+  )
+
+  # Escape hatch:
+  expect_equal(
+    ea2 %>%
+      filter(version <= time_value + as.difftime(1, units = "days"),
+             .format_aware = TRUE) %>%
+      .$DT,
+    ea2$DT[version <= time_value + as.difftime(1, units = "days"), ]
+  )
+
+})