feat: big time type handling refactor

Author: dshemetov

DESCRIPTION

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

NEWS.md

@@ -43,6 +43,15 @@ Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.x.y will indicat
 - Added optional `decay_to_tibble` attribute controlling `as_tibble()` behavior
   of `epi_df`s to let `{epipredict}` work more easily with other libraries (#471).
 
+## Breaking Changes
+
+- `epix_slide` `before` argument now defaults to `Inf`, requires a `difftime`
+  that matches the type of the `version` column and the `time_step` argument has
+  been removed. Forbid `datetime` types in `version` column.
+- `epi_slide` `before` and `after` arguments now require a `difftime` type that
+  matches the type of the `time_value` column. The `time_step` argument has been
+  removed. Forbid `datetime` types in `time_value` column.
+
 # epiprocess 0.7.0
 
 ## Breaking changes:

R/archive.R

@@ -181,15 +181,14 @@ NULL
 #'   object:
 #'
 #' * `geo_type`: the type for the geo values.
-#' * `time_type`: the type for the time values.
 #' * `additional_metadata`: list of additional metadata for the data archive.
 #'
 #' Unlike an `epi_df` object, metadata for an `epi_archive` object `x` can be
-#'   accessed (and altered) directly, as in `x$geo_type` or `x$time_type`,
-#'   etc. Like an `epi_df` object, the `geo_type` and `time_type` fields in the
-#'   metadata of an `epi_archive` object are not currently used by any
-#'   downstream functions in the `epiprocess` package, and serve only as useful
-#'   bits of information to convey about the data set at hand.
+#'   accessed (and altered) directly, as in `x$geo_type` etc. Like an `epi_df`
+#'   object, the `geo_type` field in the metadata of an `epi_archive` object are
+#'   not currently used by any downstream functions in the `epiprocess` package,
+#'   and serve only as useful bits of information to convey about the data set
+#'   at hand.
 #'
 #' @section Generating Snapshots:
 #' An `epi_archive` object can be used to generate a snapshot of the data in
@@ -211,15 +210,12 @@ NULL
 #' @param geo_type Type for the geo values. If missing, then the function will
 #'   attempt to infer it from the geo values present; if this fails, then it
 #'   will be set to "custom".
-#' @param time_type Type for the time values. If missing, then the function will
-#'   attempt to infer it from the time values present; if this fails, then it
-#'   will be set to "custom".
 #' @param other_keys Character vector specifying the names of variables in `x`
 #'   that should be considered key variables (in the language of `data.table`)
 #'   apart from "geo_value", "time_value", and "version".
 #' @param additional_metadata List of additional metadata to attach to the
-#'   `epi_archive` object. The metadata will have `geo_type` and `time_type`
-#'   fields; named entries from the passed list or will be included as well.
+#'   `epi_archive` object. The metadata will have the `geo_type` field; named
+#'   entries from the passed list or will be included as well.
 #' @param compactify Optional; Boolean or `NULL`. `TRUE` will remove some
 #'   redundant rows, `FALSE` will not, and missing or `NULL` will remove
 #'   redundant rows, but issue a warning. See more information at `compactify`.
@@ -270,7 +266,6 @@ NULL
 #'
 #' toy_epi_archive <- tib %>% as_epi_archive(
 #'   geo_type = "state",
-#'   time_type = "day"
 #' )
 #' toy_epi_archive
 #'
@@ -296,14 +291,12 @@ NULL
 #'
 #' x <- df %>% as_epi_archive(
 #'   geo_type = "state",
-#'   time_type = "day",
 #'   other_keys = "county"
 #' )
 #'
 new_epi_archive <- function(
     x,
     geo_type = NULL,
-    time_type = NULL,
     other_keys = NULL,
     additional_metadata = NULL,
     compactify = NULL,
@@ -381,7 +374,6 @@ new_epi_archive <- function(
     list(
       DT = DT,
       geo_type = geo_type,
-      time_type = time_type,
       additional_metadata = additional_metadata,
       clobberable_versions_start = clobberable_versions_start,
       versions_end = versions_end
@@ -398,7 +390,6 @@ new_epi_archive <- function(
 validate_epi_archive <- function(
     x,
     geo_type = NULL,
-    time_type = NULL,
     other_keys = NULL,
     additional_metadata = NULL,
     compactify = NULL,
@@ -411,8 +402,8 @@ validate_epi_archive <- function(
   if (any(c("geo_value", "time_value", "version") %in% other_keys)) {
     cli_abort("`other_keys` cannot contain \"geo_value\", \"time_value\", or \"version\".")
   }
-  if (any(names(additional_metadata) %in% c("geo_type", "time_type"))) {
-    cli_warn("`additional_metadata` names overlap with existing metadata fields \"geo_type\", \"time_type\".")
+  if (any(names(additional_metadata) %in% c("geo_type"))) {
+    cli_warn("`additional_metadata` names overlap with existing metadata fields \"geo_type\".")
   }
 
   # Conduct checks and apply defaults for `compactify`
@@ -448,7 +439,6 @@ validate_epi_archive <- function(
 as_epi_archive <- function(
     x,
     geo_type = NULL,
-    time_type = NULL,
     other_keys = NULL,
     additional_metadata = NULL,
     compactify = NULL,
@@ -465,18 +455,17 @@ as_epi_archive <- function(
   }
 
   geo_type <- geo_type %||% guess_geo_type(x$geo_value)
-  time_type <- time_type %||% guess_time_type(x$time_value)
   other_keys <- other_keys %||% character(0L)
   additional_metadata <- additional_metadata %||% list()
   clobberable_versions_start <- clobberable_versions_start %||% NA
   versions_end <- versions_end %||% max_version_with_row_in(x)
 
   validate_epi_archive(
-    x, geo_type, time_type, other_keys, additional_metadata,
+    x, geo_type, other_keys, additional_metadata,
     compactify, clobberable_versions_start, versions_end
   )
   new_epi_archive(
-    x, geo_type, time_type, other_keys, additional_metadata,
+    x, geo_type, other_keys, additional_metadata,
     compactify, clobberable_versions_start, versions_end
   )
 }

R/epi_df.R

@@ -15,16 +15,14 @@
 #'   the following fields:
 #'
 #' * `geo_type`: the type for the geo values.
-#' * `time_type`: the type for the time values.
 #' * `as_of`: the time value at which the given data were available.
 #'
 #' Metadata for an `epi_df` object `x` can be accessed (and altered) via
-#'   `attributes(x)$metadata`. The first two fields in the above list,
-#'   `geo_type` and `time_type`, can usually be inferred from the `geo_value`
-#'   and `time_value` columns, respectively. They are not currently used by any
-#'   downstream functions in the `epiprocess` package, and serve only as useful
-#'   bits of information to convey about the data set at hand. More information
-#'   on their coding is given below.
+#'   `attributes(x)$metadata`. The first field in the above list, `geo_type`,
+#'   can usually be inferred from the `geo_value` columns. They are not
+#'   currently used by any downstream functions in the `epiprocess` package,
+#'   and serve only as useful bits of information to convey about the data set
+#'   at hand. More information on their coding is given below.
 #'
 #' The last field in the above list, `as_of`, is one of the most unique aspects
 #'   of an `epi_df` object. In brief, we can think of an `epi_df` object as a
@@ -88,13 +86,13 @@ NULL
 #' Creates an `epi_df` object
 #'
 #' Creates a new `epi_df` object. By default, builds an empty tibble with the
-#' correct metadata for an `epi_df` object (ie. `geo_type`, `time_type`, and `as_of`).
+#' correct metadata for an `epi_df` object (ie. `geo_type` and `as_of`).
 #' Refer to the below info. about the arguments for more details.
 #'
 #' @template epi_df-params
 #'
 #' @export
-new_epi_df <- function(x = tibble::tibble(), geo_type, time_type, as_of,
+new_epi_df <- function(x = tibble::tibble(), geo_type, as_of,
                        additional_metadata = list(), ...) {
   assert_data_frame(x)
   assert_list(additional_metadata)
@@ -106,11 +104,6 @@ new_epi_df <- function(x = tibble::tibble(), geo_type, time_type, as_of,
     geo_type <- guess_geo_type(x$geo_value)
   }
 
-  # If time type is missing, then try to guess it
-  if (missing(time_type)) {
-    time_type <- guess_time_type(x$time_value)
-  }
-
   # If as_of is missing, then try to guess it
   if (missing(as_of)) {
     # First check the metadata for an as_of field
@@ -135,7 +128,6 @@ new_epi_df <- function(x = tibble::tibble(), geo_type, time_type, as_of,
   # Define metadata fields
   metadata <- list()
   metadata$geo_type <- geo_type
-  metadata$time_type <- time_type
   metadata$as_of <- as_of
   metadata <- c(metadata, additional_metadata)
 
@@ -185,7 +177,7 @@ new_epi_df <- function(x = tibble::tibble(), geo_type, time_type, as_of,
 #'
 #' # The `other_keys` metadata (`"county_code"` in this case) is automatically
 #' # inferred from the `tsibble`'s `key`:
-#' ex1 <- as_epi_df(x = ex1_input, geo_type = "state", time_type = "day", as_of = "2020-06-03")
+#' ex1 <- as_epi_df(x = ex1_input, geo_type = "state", as_of = "2020-06-03")
 #' attr(ex1, "metadata")[["other_keys"]]
 #'
 #'
@@ -257,29 +249,23 @@ as_epi_df.epi_df <- function(x, ...) {
 #'   be used.
 #' @importFrom rlang .data
 #' @export
-as_epi_df.tbl_df <- function(x, geo_type, time_type, as_of,
+as_epi_df.tbl_df <- function(x, geo_type, as_of,
                              additional_metadata = list(), ...) {
   if (!test_subset(c("geo_value", "time_value"), names(x))) {
     cli_abort(
       "Columns `geo_value` and `time_value` must be present in `x`."
     )
   }
 
-  new_epi_df(
-    x, geo_type, time_type, as_of,
-    additional_metadata, ...
-  )
+  new_epi_df(x, geo_type, as_of, additional_metadata, ...)
 }
 
 #' @method as_epi_df data.frame
 #' @describeIn as_epi_df Works analogously to `as_epi_df.tbl_df()`.
 #' @export
-as_epi_df.data.frame <- function(x, geo_type, time_type, as_of,
+as_epi_df.data.frame <- function(x, geo_type, as_of,
                                  additional_metadata = list(), ...) {
-  as_epi_df.tbl_df(
-    tibble::as_tibble(x), geo_type, time_type, as_of,
-    additional_metadata, ...
-  )
+  as_epi_df.tbl_df(tibble::as_tibble(x), geo_type, as_of, additional_metadata, ...)
 }
 
 #' @method as_epi_df tbl_ts
@@ -288,18 +274,15 @@ as_epi_df.data.frame <- function(x, geo_type, time_type, as_of,
 #'   "geo_value") are added to the metadata of the returned object, under the
 #'   `other_keys` field.
 #' @export
-as_epi_df.tbl_ts <- function(x, geo_type, time_type, as_of,
+as_epi_df.tbl_ts <- function(x, geo_type, as_of,
                              additional_metadata = list(), ...) {
   tsibble_other_keys <- setdiff(tsibble::key_vars(x), "geo_value")
   if (length(tsibble_other_keys) != 0) {
     additional_metadata$other_keys <- unique(
       c(additional_metadata$other_keys, tsibble_other_keys)
     )
   }
-  as_epi_df.tbl_df(
-    tibble::as_tibble(x), geo_type, time_type, as_of,
-    additional_metadata, ...
-  )
+  as_epi_df.tbl_df(tibble::as_tibble(x), geo_type, as_of, additional_metadata, ...)
 }
 
 #' Test for `epi_df` format

R/grouped_epi_archive.R

@@ -252,10 +252,10 @@ epix_slide.grouped_epi_archive <- function(
     ref_time_values <- sort(ref_time_values)
   }
 
-  # Validate and pre-process `before`:
-  if (!(identical(before, Inf) || test_int(before, lower = 0L))) {
-    cli_abort("`before` must be a non-negative integer or Inf.")
+  if (!checkmate::test_scalar(before)) {
+    cli_abort("`before` is a required scalar value.")
   }
+  validate_slide_window_arg(before, guess_time_type(x$private$ungrouped$DT$version))
 
   # Symbolize column name
   new_col <- sym(new_col_name)

R/methods-epi_archive.R

@@ -112,7 +112,6 @@ epix_as_of <- function(x, max_version, min_time_value = -Inf, all_versions = FAL
     dplyr::select(-"version") %>%
     as_epi_df(
       geo_type = x$geo_type,
-      time_type = x$time_type,
       as_of = max_version,
       additional_metadata = c(
         x$additional_metadata,
@@ -270,7 +269,7 @@ epix_merge <- function(x, y,
     cli_abort("`x` and `y` must have the same `$geo_type`")
   }
 
-  if (!identical(x$time_type, y$time_type)) {
+  if (!identical(guess_time_type(x$DT$version), guess_time_type(y$DT$version))) {
     cli_abort("`x` and `y` must have the same `$time_type`")
   }
 
@@ -451,7 +450,6 @@ epix_merge <- function(x, y,
   return(as_epi_archive(
     result_dt[], # clear data.table internal invisibility flag if set
     geo_type = x$geo_type,
-    time_type = x$time_type,
     other_keys = setdiff(key(result_dt), c("geo_value", "time_value", "version")),
     additional_metadata = result_additional_metadata,
     # It'd probably be better to pre-compactify before the merge, and might be

R/methods-epi_df.R

@@ -58,7 +58,6 @@ print.epi_df <- function(x, ...) {
     prettyNum(ncol(x), ","), "with metadata:\n"
   )
   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")))
@@ -83,7 +82,6 @@ print.epi_df <- function(x, ...) {
 summary.epi_df <- function(object, ...) {
   cat("An `epi_df` x, with metadata:\n")
   cat(sprintf("* %-9s = %s\n", "geo_type", attributes(object)$metadata$geo_type))
-  cat(sprintf("* %-9s = %s\n", "time_type", attributes(object)$metadata$time_type))
   cat(sprintf("* %-9s = %s\n", "as_of", attributes(object)$metadata$as_of))
   cat("----------\n")
   cat(sprintf("* %-27s = %s\n", "min time value", min(object$time_value)))
@@ -118,15 +116,14 @@ decay_epi_df <- function(x) {
 }
 
 # Implementing `dplyr_extending`: we have a few metadata attributes to consider:
-# `as_of` is an attribute doesn't depend on the rows or columns, `geo_type` and
-# `time_type` are scalar attributes dependent on columns, and `other_keys` acts
-# like an attribute vectorized over columns; `dplyr_extending` advice at time of
-# writing says to implement `dplyr_reconstruct`, 1d `[`, `dplyr_col_modify`, and
-# `names<-`, but not `dplyr_row_slice`; however, we'll also implement
-# `dplyr_row_slice` anyway to prevent a `arrange` on grouped `epi_df`s from
-# dropping the `epi_df` class. We'll implement `[` to allow either 1d or 2d.
-# We'll also implement some other methods where we want to (try to) maintain an
-# `epi_df`.
+# `as_of` is an attribute doesn't depend on the rows or columns, `geo_type` is a
+# scalar attribute dependent on columns, and `other_keys` acts like an attribute
+# vectorized over columns; `dplyr_extending` advice at time of writing says to
+# implement `dplyr_reconstruct`, 1d `[`, `dplyr_col_modify`, and `names<-`, but
+# not `dplyr_row_slice`; however, we'll also implement `dplyr_row_slice` anyway
+# to prevent a `arrange` on grouped `epi_df`s from dropping the `epi_df` class.
+# We'll implement `[` to allow either 1d or 2d. We'll also implement some other
+# methods where we want to (try to) maintain an `epi_df`.
 
 #' @param data tibble or `epi_df` (`dplyr` feeds in former, but we may
 #'   directly feed in latter from our other methods)