Merge pull request #443 from cmu-delphi/ds/r6-clean-lcb/suggests2

dshemetov · web-flow · commit eb4b3554e0ea · 2024-04-29T15:35:36.000-07:00
Edit R6 refactor
diff --git a/NAMESPACE b/NAMESPACE
@@ -93,13 +93,15 @@ importFrom(checkmate,assert_scalar)
 importFrom(checkmate,checkInt)
 importFrom(checkmate,check_atomic)
 importFrom(checkmate,check_data_frame)
+importFrom(checkmate,check_names)
 importFrom(checkmate,test_set_equal)
 importFrom(checkmate,test_subset)
 importFrom(checkmate,vname)
+importFrom(cli,cat_line)
 importFrom(cli,cli_abort)
-importFrom(cli,cli_inform)
 importFrom(cli,cli_vec)
 importFrom(cli,cli_warn)
+importFrom(cli,format_message)
 importFrom(data.table,":=")
 importFrom(data.table,address)
 importFrom(data.table,as.data.table)
diff --git a/R/archive.R b/R/archive.R
@@ -75,6 +75,8 @@ validate_version_bound <- function(version_bound, x, na_ok = FALSE,
 #' @return `max(x$version)` if it has any rows; raises error if it has 0 rows or
 #'   an `NA` version value
 #'
+#' @importFrom checkmate check_names
+#'
 #' @export
 max_version_with_row_in <- function(x) {
   if (nrow(x) == 0L) {
@@ -87,7 +89,8 @@ max_version_with_row_in <- function(x) {
       class = "epiprocess__max_version_cannot_be_used"
     )
   } else {
-    version_col <- purrr::pluck(x, "version") # error not NULL if doesn't exist
+    check_names(names(x), must.include = "version")
+    version_col <- x[["version"]]
     if (anyNA(version_col)) {
       cli_abort("version values cannot be NA",
         class = "epiprocess__version_values_must_not_be_na"
@@ -364,8 +367,7 @@ new_epi_archive <- function(
   DT <- as.data.table(x, key = key_vars) # nolint: object_name_linter
   if (!identical(key_vars, key(DT))) setkeyv(DT, cols = key_vars)
 
-  maybe_first_duplicate_key_row_index <- anyDuplicated(DT, by = key(DT))
-  if (maybe_first_duplicate_key_row_index != 0L) {
+  if (anyDuplicated(DT, by = key(DT)) != 0L) {
     cli_abort("`x` must have one row per unique combination of the key variables. If you
             have additional key variables other than `geo_value`, `time_value`, and
             `version`, such as an age group column, please specify them in `other_keys`.
@@ -466,7 +468,7 @@ as_epi_archive <- function(x, geo_type = NULL, time_type = NULL, other_keys = NU
 #' @param methods Boolean; whether to print all available methods of
 #'   the archive
 #'
-#' @importFrom cli cli_inform
+#' @importFrom cli cat_line format_message
 #' @importFrom rlang check_dots_empty
 #' @export
 print.epi_archive <- function(x, ..., class = TRUE, methods = TRUE) {
@@ -477,23 +479,27 @@ print.epi_archive <- function(x, ..., class = TRUE, methods = TRUE) {
     ))
   }
 
-  cli_inform(
+  cat_line(format_message(
     c(
       ">" = if (class) "An `epi_archive` object, with metadata:",
       "i" = if (length(setdiff(key(x$DT), c("geo_value", "time_value", "version"))) > 0) {
         "Non-standard DT keys: {setdiff(key(x$DT), c('geo_value', 'time_value', 'version'))}"
       },
-      "i" = "Min/max time values: {min(x$DT$time_value)} / {max(x$DT$time_value)}",
-      "i" = "First/last version with update: {min(x$DT$version)} / {max(x$DT$version)}",
+      "i" = if (nrow(x$DT) != 0L) {
+        "Min/max time values: {min(x$DT$time_value)} / {max(x$DT$time_value)}"
+      },
+      "i" = if (nrow(x$DT) != 0L) {
+        "First/last version with update: {min(x$DT$version)} / {max(x$DT$version)}"
+      },
       "i" = if (!is.na(x$clobberable_versions_start)) {
         "Clobberable versions start: {x$clobberable_versions_start}"
       },
       "i" = "Versions end: {x$versions_end}",
       "i" = "A preview of the table ({nrow(x$DT)} rows x {ncol(x$DT)} columns):"
     )
-  )
-
+  ))
   print(x$DT[])
+
   return(invisible(x))
 }
 
diff --git a/R/epiprocess.R b/R/epiprocess.R
@@ -8,7 +8,7 @@
 #'             assert_logical assert_list assert_character assert_class
 #'             assert_int assert_numeric check_data_frame vname check_atomic
 #'             anyInfinite test_subset test_set_equal checkInt
-#' @importFrom cli cli_abort cli_inform cli_warn
+#' @importFrom cli cli_abort cli_warn
 #' @importFrom rlang %||%
 #' @name epiprocess
 "_PACKAGE"
diff --git a/R/grouped_epi_archive.R b/R/grouped_epi_archive.R
@@ -80,7 +80,7 @@ new_grouped_epi_archive <- function(x, vars, drop) {
     list(
       private = private
     ),
-    class = c("grouped_epi_archive", "epi_archive")
+    class = "grouped_epi_archive"
   ))
 }
 
@@ -216,7 +216,7 @@ epix_slide.grouped_epi_archive <- function(x, f, ..., before, ref_time_values,
   if ("group_by" %in% nse_dots_names(...)) {
     cli_abort("
           The `group_by` argument to `slide` has been removed; please use
-          the `group_by` S3 generic function or `$group_by` R6 method
+          the `group_by()` S3 generic function
           before the slide instead. (If you were instead trying to pass a
           `group_by` argument to `f` or create a column named `group_by`,
           this check is a false positive, but you will still need to use a
@@ -370,7 +370,7 @@ epix_slide.grouped_epi_archive <- function(x, f, ..., before, ref_time_values,
         # DT; convert and wrap:
         data.table::setattr(.data_group, "sorted", dt_key)
         data.table::setDT(.data_group, key = dt_key)
-        .data_group_archive <- as_of_archive %>% clone()
+        .data_group_archive <- as_of_archive
         .data_group_archive$DT <- .data_group
         comp_one_grp(.data_group_archive, .group_key,
           f = f, ...,
@@ -437,8 +437,8 @@ is_grouped_epi_archive <- function(x) {
 
 #' @export
 clone.grouped_epi_archive <- function(x, ...) {
-  ungrouped <- x$private$ungrouped %>% clone()
-  new_grouped_epi_archive(ungrouped, x$private$vars, x$private$drop)
+  x$private$ungrouped <- x$private$ungrouped %>% clone()
+  x
 }
 
 
diff --git a/R/methods-epi_archive.R b/R/methods-epi_archive.R
@@ -23,38 +23,38 @@
 #' @return An `epi_df` object.
 #'
 #' @examples
-#' # warning message of data latency shown
 #' epix_as_of(
 #'   archive_cases_dv_subset,
 #'   max_version = max(archive_cases_dv_subset$DT$version)
 #' )
 #'
 #' range(archive_cases_dv_subset$DT$version) # 2020-06-02 -- 2021-12-01
 #'
-#' epix_as_of(
-#'   archive_cases_dv_subset,
-#'   max_version = as.Date("2020-06-12")
-#' )
+#' epix_as_of(archive_cases_dv_subset, as.Date("2020-06-12"))
 #'
-#' # When fetching a snapshot as of the latest version with update data in the
-#' # archive, a warning is issued by default, as this update data might not yet
-#' # be finalized (for example, if data versions are labeled with dates, these
-#' # versions might be overwritten throughout the corresponding days with
-#' # additional data or "hotfixes" of erroroneous data; when we build an archive
-#' # based on database queries, the latest available update might still be
-#' # subject to change, but previous versions should be finalized). We can
-#' # muffle such warnings with the following pattern:
-#' withCallingHandlers(
-#'   {
-#'     epix_as_of(
-#'       archive_cases_dv_subset,
-#'       max_version = max(archive_cases_dv_subset$DT$version)
-#'     )
-#'   },
-#'   epiprocess__snapshot_as_of_clobberable_version = function(wrn) invokeRestart("muffleWarning")
+#' # --- Advanced: ---
+#'
+#' # When requesting recent versions of a data set, there can be some
+#' # reproducibility issues. For example, requesting data as of the current date
+#' # may return different values based on whether today's data is available yet
+#' # or not. Other factors include the time it takes between data becoming
+#' # available and when you download the data, and whether the data provider
+#' # will overwrite ("clobber") version data rather than just publishing new
+#' # versions. You can include information about these factors by setting the
+#' # `clobberable_versions_start` and `versions_end` of an `epi_archive`, in
+#' # which case you will get warnings about potential reproducibility issues:
+#'
+#' archive_cases_dv_subset2 <- as_epi_archive(
+#'   archive_cases_dv_subset$DT,
+#'   # Suppose last version with an update could potentially be rewritten
+#'   # (a.k.a. "hotfixed", "clobbered", etc.):
+#'   clobberable_versions_start = max(archive_cases_dv_subset$DT$version),
+#'   # Suppose today is the following day, and there are no updates out yet:
+#'   versions_end <- max(archive_cases_dv_subset$DT$version) + 1L,
+#'   compactify = TRUE
 #' )
-#' # Since R 4.0, there is a `globalCallingHandlers` function that can be used
-#' # to globally toggle these warnings.
+#'
+#' epix_as_of(archive_cases_dv_subset2, max(archive_cases_dv_subset$DT$version))
 #'
 #' @importFrom data.table between key
 #' @export
@@ -533,7 +533,7 @@ epix_detailed_restricted_mutate <- function(.data, ...) {
     out_dt <- dplyr::dplyr_col_modify(in_tbl, col_modify_cols) %>%
       data.table::setattr("sorted", data.table::key(.data$DT)) %>%
       data.table::setDT(key = key(.data$DT))
-    out_archive <- .data %>% clone()
+    out_archive <- .data
     out_archive$DT <- out_dt
     request_names <- names(col_modify_cols)
     return(list(
diff --git a/man/epix_as_of.Rd b/man/epix_as_of.Rd
diff --git a/tests/testthat/test-epix_fill_through_version.R b/tests/testthat/test-epix_fill_through_version.R
@@ -59,16 +59,13 @@ test_that("epix_fill_through_version does not mutate x", {
     as_epi_archive(tibble::tibble(geo_value = 1L, time_value = 1L, version = 1L, value = 10L))
   )) {
     ea_orig_before <- clone(ea_orig)
-    ea_orig_dt_before_copy <- data.table::copy(ea_orig$DT)
     some_unobserved_version <- 8L
 
     ea_fill_na <- epix_fill_through_version(ea_orig, some_unobserved_version, "na")
     expect_identical(ea_orig_before, ea_orig)
-    expect_identical(ea_orig_dt_before_copy, ea_orig$DT)
 
     ea_fill_locf <- epix_fill_through_version(ea_orig, some_unobserved_version, "locf")
     expect_identical(ea_orig_before, ea_orig)
-    expect_identical(ea_orig_dt_before_copy, ea_orig$DT)
   }
 })
 
diff --git a/tests/testthat/test-epix_merge.R b/tests/testthat/test-epix_merge.R
@@ -1,6 +1,5 @@
 test_that("epix_merge requires forbids on invalid `y`", {
-  ea <- archive_cases_dv_subset %>%
-    clone()
+  ea <- archive_cases_dv_subset
   expect_error(epix_merge(ea, data.frame(x = 1)))
 })
 
diff --git a/tests/testthat/test-epix_slide.R b/tests/testthat/test-epix_slide.R
@@ -371,7 +371,6 @@ test_that("epix_slide with all_versions option has access to all older versions"
   }
 
   ea_orig_mirror <- ea %>% clone()
-  ea_orig_mirror$DT <- data.table::copy(ea_orig_mirror$DT)
 
   result1 <- ea %>%
     group_by() %>%
@@ -485,7 +484,7 @@ test_that("epix_as_of and epix_slide with long enough window are compatible", {
   )
 
   # Test the same sort of thing when grouping by geo in an archive with multiple geos.
-  ea_multigeo <- ea %>% clone()
+  ea_multigeo <- ea
   ea_multigeo$DT <- rbind(
     ea_multigeo$DT,
     copy(ea_multigeo$DT)[, geo_value := "y"][, binary := -binary][]
@@ -565,7 +564,7 @@ test_that("epix_slide with all_versions option works as intended", {
 # back depending on the decisions there:
 #
 # test_that("`epix_slide` uses `versions_end` as a resulting `epi_df`'s `as_of`", {
-#   ea_updated_stale = ea %>% clone()
+#   ea_updated_stale = ea
 #   ea_updated_stale$versions_end <- ea_updated_stale$versions_end + 3 # (dbl)
 #   #
 #   expect_identical(
diff --git a/tests/testthat/test-methods-epi_archive.R b/tests/testthat/test-methods-epi_archive.R
@@ -1,7 +1,6 @@
 library(dplyr)
 
-ea <- archive_cases_dv_subset %>%
-  clone()
+ea <- archive_cases_dv_subset
 
 ea2_data <- tibble::tribble(
   ~geo_value, ~time_value, ~version, ~cases,
@@ -32,7 +31,7 @@ test_that("Warning against max_version being clobberable", {
   expect_warning(regexp = NA, ea %>% epix_as_of(max_version = max(ea$DT$version)))
   expect_warning(regexp = NA, ea %>% epix_as_of(max_version = min(ea$DT$version)))
   # but with `clobberable_versions_start` non-`NA`, yes
-  ea_with_clobberable <- ea %>% clone()
+  ea_with_clobberable <- ea
   ea_with_clobberable$clobberable_versions_start <- max(ea_with_clobberable$DT$version)
   expect_warning(ea_with_clobberable %>% epix_as_of(max_version = max(ea$DT$version)))
   expect_warning(regexp = NA, ea_with_clobberable %>% epix_as_of(max_version = min(ea$DT$version)))
@@ -92,7 +91,7 @@ test_that("epix_truncate_version_after doesn't filter if max_verion at latest ve
   ea2 <- ea2_data %>%
     as_epi_archive()
 
-  ea_expected <- ea2 %>% clone()
+  ea_expected <- ea2
 
   ea_as_of <- ea2 %>%
     epix_truncate_versions_after(max_version = as.Date("2020-06-04"))
@@ -120,7 +119,7 @@ test_that("epix_truncate_version_after returns the same groups as input grouped_
     as_epi_archive()
   ea2 <- ea2 %>% group_by(geo_value)
 
-  ea_expected <- ea2 %>% clone()
+  ea_expected <- ea2
 
   ea_as_of <- ea2 %>%
     epix_truncate_versions_after(max_version = as.Date("2020-06-04"))
