deduplicate function/formula and quosure slides

In `as_slide_computation`, call `eval_tidy` on the quosure `x` passed
directly to `as_slide_computation`, rather than generating an
`f_wrapper` computation function that takes the quosure as an argument.
The computation function is regenerated each time `slide` is called, with
a new quosure, so the computation function doesn't need to be flexible
enough to run with different `quo`s.

This change makes the function/formula and quosure forks more similar,
since `group_modify`, `slide_one_grp` in the `epi_slide` case, and
`comp_one_grp` in the `epix_slide` case no longer need a `quo` argument
in the quosure fork. To make the two forks fully identical, the quosure
fork was changed to pass an empty set of dots to the computation
functions.

The `as_slide_computation` call and `group_modify` call can now be
pulled out of the if/else block.

Author: nmdefries

R/grouped_epi_archive.R

@@ -186,7 +186,8 @@ grouped_epi_archive =
 #'   object. See the documentation for the wrapper function [`epix_slide()`] for
 #'   details.
 #' @importFrom data.table key address
-#' @importFrom rlang !! !!! enquo quo_is_missing enquos is_quosure sym syms env
+#' @importFrom rlang !! !!! enquo quo_is_missing enquos is_quosure sym syms
+#'  env missing_arg
           slide = function(f, ..., before, ref_time_values,
                            time_step, new_col_name = "slide_value",
                            as_list_col = FALSE, names_sep = "_",
@@ -291,71 +292,8 @@ grouped_epi_archive =
                                     !!new_col := .env$comp_value))
             }
 
-            # If f is not missing, then just go ahead, slide by group
-            if (!missing(f)) {
-              f = as_slide_computation(f, calc_ref_time_value = FALSE, ...)
-              x = purrr::map_dfr(ref_time_values, function(ref_time_value) {
-                # Ungrouped as-of data; `epi_df` if `all_versions` is `FALSE`,
-                # `epi_archive` if `all_versions` is `TRUE`:
-                as_of_raw = private$ungrouped$as_of(ref_time_value, min_time_value = ref_time_value - before, all_versions = all_versions)
-
-                # Set:
-                # * `as_of_df`, the data.frame/tibble/epi_df/etc. that we will
-                #    `group_modify` as the `.data` argument. Might or might not
-                #    include version column.
-                # * `group_modify_fn`, the corresponding `.f` argument
-                if (!all_versions) {
-                  as_of_df = as_of_raw
-                  group_modify_fn = comp_one_grp
-                } else {
-                  as_of_archive = as_of_raw
-                  # We essentially want to `group_modify` the archive, but
-                  #  haven't implemented this method yet. Next best would be
-                  #  `group_modify` on its `$DT`, but that has different
-                  #  behavior based on whether or not `dtplyr` is loaded.
-                  #  Instead, go through an ordinary data frame, trying to avoid
-                  #  copies.
-                  if (address(as_of_archive$DT) == address(private$ungrouped$DT)) {
-                    # `as_of` aliased its the full `$DT`; copy before mutating:
-                    as_of_archive$DT <- copy(as_of_archive$DT)
-                  }
-                  dt_key = data.table::key(as_of_archive$DT)
-                  as_of_df = as_of_archive$DT
-                  data.table::setDF(as_of_df)
-                  
-                  # Convert each subgroup chunk to an archive before running the calculation.
-                  group_modify_fn = function(.data_group, .group_key,
-                                    f, ...,
-                                    ref_time_value,
-                                    new_col) {
-                    # .data_group is coming from as_of_df as a tibble, but we
-                    # want to feed `comp_one_grp` an `epi_archive` backed by a
-                    # 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$DT = .data_group
-                    comp_one_grp(.data_group_archive, .group_key, f = f, ...,
-                                 ref_time_value = ref_time_value,
-                                 new_col = new_col
-                    )
-                  }
-                }
-                
-                return(
-                  dplyr::group_by(as_of_df, dplyr::across(tidyselect::all_of(private$vars)),
-                                  .drop=private$drop) %>%
-                    dplyr::group_modify(group_modify_fn,
-                                        f = f, ...,
-                                        ref_time_value = ref_time_value,
-                                        new_col = new_col,
-                                        .keep = TRUE)
-                )
-              })
-            }
-
-            # Else interpret ... as an expression for tidy evaluation
-            else {
+            # Interpret ... as an expression for tidy evaluation
+            if (missing(f)) {
               quos = enquos(...)
               if (length(quos) == 0) {
                 Abort("If `f` is missing then a computation must be specified via `...`.")
@@ -364,69 +302,70 @@ grouped_epi_archive =
                 Abort("If `f` is missing then only a single computation can be specified via `...`.")
               }
 
-              quo = quos[[1]]
-              f = as_slide_computation(quo, calc_ref_time_value = FALSE, ...)
+              f = quos[[1]]
               new_col = sym(names(rlang::quos_auto_name(quos)))
+              ... = missing_arg()
+            }
 
-              x = purrr::map_dfr(ref_time_values, function(ref_time_value) {
-                # Ungrouped as-of data; `epi_df` if `all_versions` is `FALSE`,
-                # `epi_archive` if `all_versions` is `TRUE`:
-                as_of_raw = private$ungrouped$as_of(ref_time_value, min_time_value = ref_time_value - before, all_versions = all_versions)
+            f = as_slide_computation(f, calc_ref_time_value = FALSE, ...)
+            x = purrr::map_dfr(ref_time_values, function(ref_time_value) {
+              # Ungrouped as-of data; `epi_df` if `all_versions` is `FALSE`,
+              # `epi_archive` if `all_versions` is `TRUE`:
+              as_of_raw = private$ungrouped$as_of(ref_time_value, min_time_value = ref_time_value - before, all_versions = all_versions)
 
-                # Set:
-                # * `as_of_df`, the data.frame/tibble/epi_df/etc. that we will
-                #    `group_modify` as the `.data` argument. Might or might not
-                #    include version column.
-                # * `group_modify_fn`, the corresponding `.f` argument
-                if (!all_versions) {
-                  as_of_df = as_of_raw
-                  group_modify_fn = comp_one_grp
-                } else {
-                  as_of_archive = as_of_raw
-                  # We essentially want to `group_modify` the archive, but don't
-                  # provide an implementation yet. Next best would be
-                  # `group_modify` on its `$DT`, but that has different behavior
-                  # based on whether or not `dtplyr` is loaded. Instead, go
-                  # through an ordinary data frame, trying to avoid copies.
-                  if (address(as_of_archive$DT) == address(private$ungrouped$DT)) {
-                    # `as_of` aliased its the full `$DT`; copy before mutating:
-                    as_of_archive$DT <- copy(as_of_archive$DT)
-                  }
-                  dt_key = data.table::key(as_of_archive$DT)
-                  as_of_df = as_of_archive$DT
-                  data.table::setDF(as_of_df)
+              # Set:
+              # * `as_of_df`, the data.frame/tibble/epi_df/etc. that we will
+              #    `group_modify` as the `.data` argument. Might or might not
+              #    include version column.
+              # * `group_modify_fn`, the corresponding `.f` argument
+              if (!all_versions) {
+                as_of_df = as_of_raw
+                group_modify_fn = comp_one_grp
+              } else {
+                as_of_archive = as_of_raw
+                # We essentially want to `group_modify` the archive, but
+                # haven't implemented this method yet. Next best would be
+                # `group_modify` on its `$DT`, but that has different
+                # behavior based on whether or not `dtplyr` is loaded.
+                # Instead, go through an ordinary data frame, trying to avoid
+                # copies.
+                if (address(as_of_archive$DT) == address(private$ungrouped$DT)) {
+                  # `as_of` aliased its the full `$DT`; copy before mutating:
+                  as_of_archive$DT <- copy(as_of_archive$DT)
+                }
+                dt_key = data.table::key(as_of_archive$DT)
+                as_of_df = as_of_archive$DT
+                data.table::setDF(as_of_df)
 
-                  # Convert each subgroup chunk to an archive before running the calculation.
-                  group_modify_fn = function(.data_group, .group_key,
-                                    f, ...,
-                                    ref_time_value,
-                                    new_col) {
-                    # .data_group is coming from as_of_df as a tibble, but we
-                    # want to feed `comp_one_grp` an `epi_archive` backed by a
-                    # 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$DT = .data_group
-                    comp_one_grp(.data_group_archive, .group_key, f = f, quo = quo,
-                                 ref_time_value = ref_time_value,
-                                 new_col = new_col
-                    )
-                  }
+                # Convert each subgroup chunk to an archive before running the calculation.
+                group_modify_fn = function(.data_group, .group_key,
+                                  f, ...,
+                                  ref_time_value,
+                                  new_col) {
+                  # .data_group is coming from as_of_df as a tibble, but we
+                  # want to feed `comp_one_grp` an `epi_archive` backed by a
+                  # 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$DT = .data_group
+                  comp_one_grp(.data_group_archive, .group_key, f = f, ...,
+                               ref_time_value = ref_time_value,
+                               new_col = new_col
+                  )
                 }
+              }
 
-                return(
-                  dplyr::group_by(as_of_df, dplyr::across(tidyselect::all_of(private$vars)),
-                                  .drop=private$drop) %>%
-                    dplyr::group_modify(group_modify_fn,
-                                        f = f, quo = quo,
-                                        ref_time_value = ref_time_value,
-                                        comp_effective_key_vars = comp_effective_key_vars,
-                                        new_col = new_col,
-                                        .keep = TRUE)
-                )
-              })
-            }
+              return(
+                dplyr::group_by(as_of_df, dplyr::across(tidyselect::all_of(private$vars)),
+                                .drop=private$drop) %>%
+                  dplyr::group_modify(group_modify_fn,
+                                      f = f, ...,
+                                      ref_time_value = ref_time_value,
+                                      new_col = new_col,
+                                      .keep = TRUE)
+              )
+            })
 
             # Unchop/unnest if we need to
             if (!as_list_col) {

R/slide.R

@@ -123,7 +123,7 @@
 #'   
 #' @importFrom lubridate days weeks
 #' @importFrom dplyr bind_rows group_vars filter select
-#' @importFrom rlang .data .env !! enquo enquos sym env
+#' @importFrom rlang .data .env !! enquo enquos sym env missing_arg
 #' @export
 #' @examples 
 #' # slide a 7-day trailing average formula on cases
@@ -351,22 +351,8 @@ epi_slide = function(x, f, ..., before, after, ref_time_values,
     return(mutate(.data_group, !!new_col := slide_values))
   }
 
-  # If f is not missing, then just go ahead, slide by group
-  if (!missing(f)) {
-    f = as_slide_computation(f, calc_ref_time_value = TRUE, before = before, ...)
-    x = x %>%
-      group_modify(slide_one_grp,
-                   f = f, ...,
-                   starts = starts,
-                   stops = stops,
-                   time_values = ref_time_values,
-                   all_rows = all_rows,
-                   new_col = new_col,
-                   .keep = FALSE)
-  }
-
-  # Else interpret ... as an expression for tidy evaluation
-  else {
+  # Interpret ... as an expression for tidy evaluation
+  if (missing(f)) {
     quos = enquos(...)
     if (length(quos) == 0) {
       Abort("If `f` is missing then a computation must be specified via `...`.")
@@ -375,20 +361,21 @@ epi_slide = function(x, f, ..., before, after, ref_time_values,
       Abort("If `f` is missing then only a single computation can be specified via `...`.")
     }
 
-    quo = quos[[1]]
+    f = quos[[1]]
     new_col = sym(names(rlang::quos_auto_name(quos)))
-
-    f = as_slide_computation(quo, calc_ref_time_value = TRUE, before = before, ...)
-    x = x %>%
-      group_modify(slide_one_grp,
-                   f = f, quo = quo,
-                   starts = starts,
-                   stops = stops,
-                   time_values = ref_time_values,
-                   all_rows = all_rows,
-                   new_col = new_col,
-                   .keep = FALSE)
+    ... = missing_arg()
   }
+
+  f = as_slide_computation(f, calc_ref_time_value = TRUE, before = before, ...)
+  x = x %>%
+    group_modify(slide_one_grp,
+                 f = f, ...,
+                 starts = starts,
+                 stops = stops,
+                 time_values = ref_time_values,
+                 all_rows = all_rows,
+                 new_col = new_col,
+                 .keep = FALSE)
 
   # Unnest if we need to, and return
   if (!as_list_col) {

R/utils.R

@@ -253,7 +253,7 @@ as_slide_computation <- function(x,
   # A quosure is a type of formula, so be careful with `if` logic here.
   if (is_quosure(x)) {
     if (calc_ref_time_value) {
-      f_wrapper = function(.x, .group_key, quo, ...) {
+      f_wrapper = function(.x, .group_key, ...) {
         .ref_time_value = min(.x$time_value) + before
         .x <- .x[.x$.real,]
         .x$.real <- NULL
@@ -266,25 +266,24 @@ as_slide_computation <- function(x,
         data_mask$.x = .x
         data_mask$.group_key = .group_key
         data_mask$.ref_time_value = .ref_time_value
-        rlang::eval_tidy(quo, data_mask)
+        rlang::eval_tidy(x, data_mask)
       }
       return(f_wrapper)
     }
 
-    f_wrapper = function(.x, .group_key, .ref_time_value, quo, ...) {
+    f_wrapper = function(.x, .group_key, .ref_time_value, ...) {
       # Convert to environment to standardize between tibble and R6
       # based inputs. In both cases, we should get a simple
       # environment with the empty environment as its parent.
       data_env = rlang::as_environment(.x)
       data_mask = rlang::new_data_mask(bottom = data_env, top = data_env)
       data_mask$.data <- rlang::as_data_pronoun(data_mask)
-      # We'll also install `.x` directly, not as an
-      # `rlang_data_pronoun`, so that we can, e.g., use more dplyr and
-      # epiprocess operations.
+      # We'll also install `.x` directly, not as an `rlang_data_pronoun`, so
+      # that we can, e.g., use more dplyr and epiprocess operations.
       data_mask$.x = .x
       data_mask$.group_key = .group_key
       data_mask$.ref_time_value = .ref_time_value
-      rlang::eval_tidy(quo, data_mask)
+      rlang::eval_tidy(x, data_mask)
     }
     return(f_wrapper)
   }