wip: rework slide window args

Author: dshemetov

R/autoplot.R

@@ -47,8 +47,8 @@ autoplot.epi_df <- function(
     .facet_by = c(".response", "other_keys", "all_keys", "geo_value", "all", "none"),
     .base_color = "#3A448F",
     .max_facets = Inf) {
-  .color_by <- match.arg(.color_by)
-  .facet_by <- match.arg(.facet_by)
+  .color_by <- rlang::match_arg(.color_by)
+  .facet_by <- rlang::match_arg(.facet_by)
 
   assert(anyInfinite(.max_facets), checkInt(.max_facets), combine = "or")
   assert_character(.base_color, len = 1)

R/correlation.R

@@ -99,7 +99,7 @@ epi_cor <- function(x, var1, var2, dt1 = 0, dt2 = 0, shift_by = geo_value, # nol
   shift_by <- syms(names(eval_select(enquo(shift_by), x)))
 
   # Which method?
-  method <- match.arg(method)
+  method <- rlang::match_arg(method)
 
   # Perform time shifts, then compute appropriate correlations and return
   return(x %>%

R/growth_rate.R

@@ -120,7 +120,7 @@ growth_rate <- function(x = seq_along(y), y, x0 = x,
   # Check x, y, x0
   if (length(x) != length(y)) cli_abort("`x` and `y` must have the same length.")
   if (!all(x0 %in% x)) cli_abort("`x0` must be a subset of `x`.")
-  method <- match.arg(method)
+  method <- rlang::match_arg(method)
 
   # Arrange in increasing order of x
   o <- order(x)

R/outliers.R

@@ -89,7 +89,7 @@ detect_outlr <- function(x = seq_along(y), y,
                          ),
                          combiner = c("median", "mean", "none")) {
   # Validate combiner
-  combiner <- match.arg(combiner)
+  combiner <- rlang::match_arg(combiner)
 
   # Validate that x contains all distinct values
   if (any(duplicated(x))) {

R/slide.R

@@ -21,16 +21,10 @@
 #'   If `f` is missing, then `...` will specify the computation.
 #' @param ... Additional arguments to pass to the function or formula specified
 #'   via `f`. Alternatively, if `f` is missing, then the `...` is interpreted as
-#'   a ["data-masking"][rlang::args_data_masking] expression or expressions for
-#'   tidy evaluation; in addition to referring columns directly by name, the
-#'   expressions have access to `.data` and `.env` pronouns as in `dplyr` verbs,
-#'   and can also refer to `.x`, `.group_key`, and `.ref_time_value`. See
-#'   details.
-#' @param new_col_name String indicating the name of the new column that will
-#'   contain the derivative values. The default is "slide_value" unless your
-#'   slide computations output data frames, in which case they will be unpacked
-#'   into the constituent columns and those names used. Note that setting
-#'   `new_col_name` equal to an existing column name will overwrite this column.
+#'   an expression for tidy evaluation; in addition to referring to columns
+#'   directly by name, the expression has access to `.data` and `.env` pronouns
+#'   as in `dplyr` verbs, and can also refer to `.x`, `.group_key`, and
+#'   `.ref_time_value`. See details.
 #'
 #' @template basic-slide-details
 #'
@@ -85,63 +79,85 @@
 #'     before = 1, as_list_col = TRUE
 #'   ) %>%
 #'   ungroup()
-epi_slide <- function(x, f, ..., before = NULL, after = NULL, ref_time_values = NULL,
-                      new_col_name = NULL, all_rows = FALSE,
-                      as_list_col = deprecated(), names_sep = deprecated()) {
+epi_slide <- function(
+    x, f, ...,
+    .window_size = 0, .align = c("right", "center", "left"), .ref_time_values = NULL, .all_rows = FALSE) {
+
+  if (any(map(c(n, before, after, ref_time_values, new_col_name, as_list_col, names_sep, all_rows), Negate(is.null)))) {
+    cli_abort(
+      "epi_slide: deprecated arguments `n`, `before`, `after`, `ref_time_values`, `new_col_name`, `as_list_col`,
+      `names_sep`, and `all_rows` have been removed. Please use `.n`, `.align`, `.ref_time_values`,
+      `.new_col_name`, `.as_list_col`, and `.names_sep` instead."
+    )
+  }
+
   assert_class(x, "epi_df")
 
   if (nrow(x) == 0L) {
     return(x)
   }
 
-  if (is.null(ref_time_values)) {
-    ref_time_values <- unique(x$time_value)
+  if (is.null(.ref_time_values)) {
+    .ref_time_values <- unique(x$time_value)
   } else {
-    assert_numeric(ref_time_values, min.len = 1L, null.ok = FALSE, any.missing = FALSE)
-    if (!test_subset(ref_time_values, unique(x$time_value))) {
+    assert_numeric(.ref_time_values, min.len = 1L, null.ok = FALSE, any.missing = FALSE)
+    if (!test_subset(.ref_time_values, unique(x$time_value))) {
       cli_abort(
         "`ref_time_values` must be a unique subset of the time values in `x`.",
         class = "epi_slide__invalid_ref_time_values"
       )
     }
-    if (anyDuplicated(ref_time_values) != 0L) {
+
+    if (anyDuplicated(.ref_time_values) != 0L) {
       cli_abort(
-        "`ref_time_values` must not contain any duplicates; use `unique` if appropriate.",
+        "`.ref_time_values` must not contain any duplicates; use `unique` if appropriate.",
         class = "epi_slide__invalid_ref_time_values"
       )
     }
   }
-  ref_time_values <- sort(ref_time_values)
+  .ref_time_values <- sort(.ref_time_values)
 
-  # Handle defaults for before/after
-  time_type <- attr(x, "metadata")$time_type
-  if (is.null(before) && !is.null(after)) {
-    if (inherits(after, "difftime")) {
-      before <- as.difftime(0, units = units(after))
-    } else {
-      before <- 0
-    }
+  if (!is.null(before) || !is.null(after)) {
+    cli_abort("`before` and `after` are deprecated for `epi_slide`. Use `n` instead.")
   }
-  if (is.null(after) && !is.null(before)) {
-    if (inherits(before, "difftime")) {
-      after <- as.difftime(0, units = units(before))
-    } else {
-      if (identical(before, Inf) && time_type %in% c("day", "week")) {
+
+  # Handle window arguments
+  align <- rlang::arg_match(.align)
+  time_type <- attr(x, "metadata")$time_type
+  validate_slide_window_arg(.window_size, time_type)
+  if (identical(.window_size, Inf)) {
+    if (align == "right") {
+      before <- Inf
+      if (time_type %in% c("day", "week")) {
         after <- as.difftime(0, units = glue::glue("{time_type}s"))
       } else {
         after <- 0
       }
+    } else {
+      cli_abort(
+        "`epi_slide`: center and left alignment are not supported with an infinite window size."
+      )
+    }
+  } else {
+    if (align == "right") {
+      before <- .window_size - 1
+      after <- 0
+    } else if (align == "center") {
+      # For n = 5, before = 2, after = 2. For n = 4, before = 2, after = 1.
+      before <- floor(.window_size / 2)
+      after <- .window_size - before - 1
+    } else if (align == "left") {
+      before <- 0
+      after <- .window_size - 1
     }
   }
-  validate_slide_window_arg(before, time_type)
-  validate_slide_window_arg(after, time_type, allow_inf = FALSE)
 
   # Arrange by increasing time_value
   x <- arrange(x, .data$time_value)
 
   # Now set up starts and stops for sliding/hopping
-  starts <- ref_time_values - before
-  stops <- ref_time_values + after
+  starts <- .ref_time_values - before
+  stops <- .ref_time_values + after
 
   # If `f` is missing, interpret ... as an expression for tidy evaluation
   if (missing(f)) {
@@ -220,6 +236,7 @@ epi_slide <- function(x, f, ..., before = NULL, after = NULL, ref_time_values =
     return(f_wrapper)
   }
 
+
   # Computation for one group, all time values
   slide_one_grp <- function(.data_group,
                             .group_key, # see `?group_modify`
@@ -282,6 +299,7 @@ epi_slide <- function(x, f, ..., before = NULL, after = NULL, ref_time_values =
 
     slide_values <- vctrs::list_unchop(slide_values_list)
 
+
     if (
       all(purrr::map_int(slide_values_list, vctrs::vec_size) == 1L) &&
         length(slide_values_list) != 0L
@@ -333,12 +351,13 @@ epi_slide <- function(x, f, ..., before = NULL, after = NULL, ref_time_values =
     f_factory = f_wrapper_factory,
     starts = starts,
     stops = stops,
-    ref_time_values = ref_time_values,
-    all_rows = all_rows,
+    ref_time_values = .ref_time_values,
+    all_rows = .all_rows,
     new_col_name = new_col_name,
     .keep = FALSE
   )
 
+
   return(x)
 }
 

man-roxygen/basic-slide-params.R

@@ -1,35 +1,30 @@
 #' @param x The `epi_df` object under consideration, [grouped][dplyr::group_by]
 #'   or ungrouped. If ungrouped, all data in `x` will be treated as part of a
 #'   single data group.
-#' @param before,after How far `before` and `after` each `ref_time_value` should
-#'   the sliding window extend? At least one of these two arguments must be
-#'   provided; the other's default will be 0. The accepted values for these
-#'   depend on the type of the `time_value` column:
+#' @param .window_size The size of the sliding window. By default, this is 0,
+#' meaning that only the current ref_time_value is included. The accepted values
+#' here depend on the `time_value` column:
 #'
-#'   - if it is a Date and the cadence is daily, then they can be integers
-#'     (which will be interpreted in units of days) or difftimes with units
+#'   - if time_type is Date and the cadence is daily, then `.n` can be an integer
+#'     (which will be interpreted in units of days) or a difftime with units
 #'     "days"
-#'   - if it is a Date and the cadence is weekly, then they must be difftimes
+#'   - if time_type is Date and the cadence is weekly, then `.n` must be a difftime
 #'     with units "weeks"
-#'   - if it is an integer, then they must be integers
+#'   - if time_type is an integer, then `.n` must be an integer
 #'
-#'   Endpoints of the window are inclusive. Common settings:
-#'
-#'   - For trailing/right-aligned windows from `ref_time_value - k` to
-#'     `ref_time_value`: either pass `before=k` by itself, or pass `before=k,
-#'     after=0`.
-#'   - For center-aligned windows from `ref_time_value - k` to
-#'     `ref_time_value + k`: pass `before=k, after=k`.
-#'   - For leading/left-aligned windows from `ref_time_value` to
-#'     `ref_time_value + k`: either pass pass `after=k` by itself,
-#'     or pass `before=0, after=k`.
-#'
-#'   See "Details:" on how missing rows are handled within the window.
-#' @param ref_time_values Time values for sliding computations, meaning, each
+#' @param .align The alignment of the sliding window. If `right` (default), then
+#' the window has its end at the reference time; if `center`, then the window is
+#' centered at the reference time; if `left`, then the window has its start at
+#' the reference time. If the alignment is `center` and the window size is odd,
+#' then the window will have floor(window_size/2) points before and after the
+#' reference time. If the window size is even, then the window will be
+#' asymmetric and have one less value on the right side of the reference time.
+#' @param before,after Deprecated. Use `.n` instead.
+#' @param .ref_time_values Time values for sliding computations, meaning, each
 #'   element of this vector serves as the reference time point for one sliding
 #'   window. If missing, then this will be set to all unique time values in the
 #'   underlying data table, by default.
-#' @param all_rows If `all_rows = TRUE`, then all rows of `x` will be kept in
+#' @param .all_rows If `all_rows = TRUE`, then all rows of `x` will be kept in
 #'   the output even with `ref_time_values` provided, with some type of missing
 #'   value marker for the slide computation output column(s) for `time_value`s
 #'   outside `ref_time_values`; otherwise, there will be one row for each row in