refactor: handle time +/- Inf in helper function

Author: brookslogan

R/epi_slide_opt_archive.R

@@ -64,9 +64,11 @@ epi_slide_opt_archive_one_epikey <- function(
     # Time inp_update_max_t + before should have an output update, since it
     # depends on inp_update_max_t + before - before = inp_update_max_t, which
     # has an input update. Similarly, we could have updates beginning with
-    # inp_update_min_t - after, or anything in between these two bounds.
-    out_update_min_t <- time_minus_n_steps(inp_update_min_t, after, time_type)
-    out_update_max_t <- time_plus_n_steps(inp_update_max_t, before, time_type)
+    # inp_update_min_t - after, or anything in between these two bounds. If
+    # before == Inf, we need to update outputs all the way to the end of the
+    # input *snapshot*.
+    out_update_min_t <- time_minus_slide_window_arg(inp_update_min_t, after, time_type)
+    out_update_max_t <- time_plus_slide_window_arg(inp_update_max_t, before, time_type, max(inp_snapshot$time_value))
     out_update_ts <- vec_slice(inp_snapshot$time_value, between(inp_snapshot$time_value, out_update_min_t, out_update_max_t))
     out_update <- epi_slide_opt_one_epikey(inp_snapshot, f_dots_baked, f_from_package, before, after, unit_step, time_type, out_update_ts, in_colnames, out_colnames)
     out_diff <- tbl_diff2(prev_out_snapshot, out_update, "time_value", "update")

R/epi_slide_opt_edf.R

@@ -172,20 +172,10 @@ epi_slide_opt_one_epikey <- function(inp_tbl,
                                      out_time_values,
                                      in_colnames, out_colnames) {
   # TODO try converting time values to reals, do work on reals, convert back at very end?
-  if (before == Inf) {
-    if (after != 0L) {
-      cli_abort('.window_size = Inf is only supported with .align = "right"',
-        class = "epiprocess__epi_slide_opt_archive__inf_window_invalid_align"
-      )
-    }
-    # We need to use the entire input range, filling in time gaps. We shouldn't
-    # pad the ends.
-    slide_t_min <- min(inp_tbl$time_value) # FIXME match existing behavior, or complete changeover
-    slide_t_max <- max(out_time_values)
-  } else {
-    slide_t_min <- min(out_time_values) - before
-    slide_t_max <- max(out_time_values) + after
-  }
+  #
+  # FIXME min time_value for this epikey vs. entire edf; match existing behavior, or complete changeover
+  slide_t_min <- time_minus_slide_window_arg(min(out_time_values), before, time_type, min(inp_tbl$time_value))
+  slide_t_max <- time_plus_slide_window_arg(max(out_time_values), after, time_type)
   slide_nrow <- time_delta_to_n_steps(slide_t_max - slide_t_min, time_type) + 1L
   slide_time_values <- slide_t_min + 0L:(slide_nrow - 1L) * unit_step
   slide_inp_backrefs <- vec_match(slide_time_values, inp_tbl$time_value)

R/time-utils.R

@@ -339,7 +339,7 @@ difftime_approx_ceiling_time_delta <- function(difftime, time_type) {
   )
 }
 
-#' Difference between two time value vectors in terms of number of time "steps"
+#' Difference between two finite `time_value` vectors in terms of number of time "steps"
 #'
 #' @param x a time_value (vector) of time type `time_type`
 #' @param y a time_value (vector) of time type `time_type`
@@ -352,15 +352,18 @@ time_minus_time_in_n_steps <- function(x, y, time_type) {
   time_delta_to_n_steps(x - y, time_type)
 }
 
-#' Advance/retreat time_values by specified number of time "steps"
+#' Advance/retreat time_value(s) by bare-integerish number(s) of time "steps"
 #'
 #' Here, a "step" is based on the `time_type`, not just the class of `x`.
 #'
 #' @param x a time_value (vector) of time type `time_type`
-#' @param y integerish (vector)
+#' @param y bare integerish (vector)
 #' @param time_type as in [`validate_slide_window_arg()`]
 #' @return a time_value (vector) of time type `time_type`
 #'
+#' @seealso [`time_plus_slide_window_arg`] if you're working with a `y` that is
+#'   a slide window arg, which is scalar but otherwise more general (class-wise,
+#'   Inf-wise) than an integerish vector.
 #' @keywords internal
 time_plus_n_steps <- function(x, y, time_type) {
   x + y * unit_time_delta(time_type, "fast")
@@ -370,3 +373,32 @@ time_plus_n_steps <- function(x, y, time_type) {
 time_minus_n_steps <- function(x, y, time_type) {
   x - y * unit_time_delta(time_type, "fast")
 }
+
+#' Advance/retreat time_value(s) by specified amount (slide window arg)
+#'
+#' @param x a time_value (vector) of time type `time_type`
+#' @param y a (scalar) slide window arg; should pass [`validate_slide_window_arg()`]
+#' @param time_type as in [`validate_slide_window_arg()`]
+#' @param max_time_value when `y == Inf`, what should be the result of adding `y`?
+#' @param min_time_value when `y == Inf`, what should be the result of subtracting `y`?
+#' @return a time_value (vector) of time type `time_type`
+#'
+#' @keywords internal
+#' @seealso [`time_plus_n_steps`], if you're working with an integerish vector
+#'   number of time steps `y` (output from other `*n_steps` functions) instead.
+time_plus_slide_window_arg <- function(x, y, time_type, max_time_value) {
+  if (y == Inf) {
+    rep(max_time_value, vec_size(x))
+  } else {
+    time_plus_n_steps(x, y, time_type)
+  }
+}
+
+#' @rdname time_plus_slide_window_arg
+time_minus_slide_window_arg <- function(x, y, time_type, min_time_value) {
+  if (y == Inf) {
+    rep(min_time_value, vec_size(x))
+  } else {
+    time_minus_n_steps(x, y, time_type)
+  }
+}