Pass ref time value and group key to epix_slide for tidy computations

NAMESPACE

@@ -96,6 +96,7 @@ importFrom(rlang,caller_env)
 importFrom(rlang,check_dots_empty0)
 importFrom(rlang,enquo)
 importFrom(rlang,enquos)
+importFrom(rlang,env)
 importFrom(rlang,eval_tidy)
 importFrom(rlang,f_env)
 importFrom(rlang,f_rhs)
@@ -110,6 +111,7 @@ importFrom(rlang,pairlist2)
 importFrom(rlang,quo_get_env)
 importFrom(rlang,quo_get_expr)
 importFrom(rlang,quo_is_missing)
+importFrom(rlang,quo_set_env)
 importFrom(rlang,sym)
 importFrom(rlang,syms)
 importFrom(stats,cor)

R/grouped_epi_archive.R

@@ -187,6 +187,7 @@ grouped_epi_archive =
 #'   details.
 #' @importFrom data.table key address
 #' @importFrom rlang !! !!! enquo quo_is_missing enquos is_quosure sym syms
+#'  quo_set_env env
           slide = function(f, ..., before, ref_time_values,
                            time_step, new_col_name = "slide_value",
                            as_list_col = FALSE, names_sep = "_",
@@ -437,7 +438,10 @@ grouped_epi_archive =
               }
 
               quo = quos[[1]]
-              f = function(x, quo, ...) rlang::eval_tidy(quo, x)
+              f = function(.x, .group_key, .ref_time_value, quo, ...) {
+                quo = quo_set_env(quo, env())
+                rlang::eval_tidy(quo, .x)
+              }
               new_col = sym(names(rlang::quos_auto_name(quos)))
 
               x = purrr::map_dfr(ref_time_values, function(ref_time_value) {

R/methods-epi_archive.R

@@ -662,12 +662,15 @@ group_by.epi_archive = function(.data, ..., .add=FALSE, .drop=dplyr::group_by_dr
 #'   by a one-row tibble containing the values of the grouping variables for
 #'   the associated group; followed by a Date containing the reference time
 #'   value to use; followed by any number of named arguments. If a formula,
-#'   `f` can operate directly on columns accessed via `.x$var` or `.`, as in
-#'   `~ mean (.x$var)` to compute a mean of a column `var` for each
+#'   `f` can operate directly on columns accessed via `.x$var` or `.$var`, as
+#'   in `~ mean(.x$var)` to compute a mean of a column `var` for each
 #'   `ref_time_value`-group combination. The group key can be accessed via
 #'   `.y` or `.group_key`, and the reference time value can be accessed via
-#'   `.z` or `.ref_time_value`. If `f` is missing, then `...` will specify
-#'   the computation.
+#'   `.z` or `.ref_time_value`. If `f` is missing, then `...` will specify the
+#'   computation. In this case, the computation can reference columns via the
+#'   column name directly or via `.x$var`, as in `mean(var)` or `mean
+#'   (.x$var)`. The group key can be accessed via `.group_key`, and the
+#'   reference time value can be accessed via `.ref_time_value`.
 #' @param ... Additional arguments to pass to the function or formula specified
 #'   via `f`. Alternatively, if `f` is missing, then `...` is interpreted as an
 #'   expression for tidy evaluation. See details of [`epi_slide`].

tests/testthat/test-epix_slide.R

@@ -361,53 +361,111 @@ test_that("epix_slide alerts if the provided f doesn't take enough args", {
     class = "check_sufficient_f_args__f_needs_min_args_before_dots")
 })
 
-test_that("epix_slide computation can use ref_time_value", {
-  # Formula
-  xx1 <- xx %>%
-    group_by(.data$geo_value) %>%
-    epix_slide(f = ~ .ref_time_value,
-               before = 2)
-
+test_that("epix_slide computation via formula can use ref_time_value", {
   xx_ref <- tibble(geo_value = rep("x",4),
                 time_value = c(4,5,6,7),
                 slide_value = c(4,5,6,7)
                 ) %>%
     as_epi_df(as_of = 4) %>% # Also a bug (issue #213)
     group_by(geo_value)
 
-  expect_identical(xx1,xx_ref)
+  xx1 <- xx %>%
+    group_by(.data$geo_value) %>%
+    epix_slide(f = ~ .ref_time_value,
+               before = 2)
+
+  expect_identical(xx1, xx_ref)
 
   xx2 <- xx %>%
     group_by(.data$geo_value) %>%
     epix_slide(f = ~ .z,
                before = 2)
 
-  expect_identical(xx2,xx_ref)
+  expect_identical(xx2, xx_ref)
 
   xx3 <- xx %>%
     group_by(.data$geo_value) %>%
     epix_slide(f = ~ ..3,
                before = 2)
 
-  expect_identical(xx3,xx_ref)
+  expect_identical(xx3, xx_ref)
+})
 
-  # Function
-  xx4 <- xx %>%
+test_that("epix_slide computation via function can use ref_time_value", {
+  xx_ref <- tibble(geo_value = rep("x",4),
+                time_value = c(4,5,6,7),
+                slide_value = c(4,5,6,7)
+                ) %>%
+    as_epi_df(as_of = 4) %>% # Also a bug (issue #213)
+    group_by(geo_value)
+
+  xx1 <- xx %>%
     group_by(.data$geo_value) %>%
     epix_slide(f = function(x, g, t) t,
                before = 2)
 
-  expect_identical(xx4,xx_ref)
+  expect_identical(xx1, xx_ref)
+})
+
+test_that("epix_slide computation via dots can use ref_time_value and group", {
+  # ref_time_value
+  xx_ref <- tibble(geo_value = rep("x",4),
+                time_value = c(4,5,6,7),
+                slide_value = c(4,5,6,7)
+                ) %>%
+    as_epi_df(as_of = 4) %>% # Also a bug (issue #213)
+    group_by(geo_value)
+
+  xx1 <- xx %>%
+    group_by(.data$geo_value) %>%
+    epix_slide(before = 2,
+      slide_value = .ref_time_value)
 
-  # Dots
-  expect_error(xx %>%
+  expect_identical(xx1, xx_ref)
+
+  xx2 <- xx %>%
     group_by(.data$geo_value) %>%
     epix_slide(before = 2,
-      slide_value = ref_time_value),
-    "object 'ref_time_value' not found")
-expect_error(xx %>%
+      slide_value = .env$.ref_time_value)
+
+  expect_identical(xx2, xx_ref)
+
+  # group_key
+  xx_ref <- tibble(geo_value = rep("x",4),
+                time_value = c(4,5,6,7),
+                slide_value = "x"
+                ) %>%
+    as_epi_df(as_of = 4) %>% # Also a bug (issue #213)
+    group_by(geo_value)
+
+  # Use group_key column
+  xx3 <- xx %>%
     group_by(.data$geo_value) %>%
     epix_slide(before = 2,
-      slide_value = .env$ref_time_value),
-    "object 'ref_time_value' not found")
+      slide_value = .group_key$geo_value)
+
+  expect_identical(xx3, xx_ref)
+
+  # Use entire group_key object
+  expect_error(
+    xx %>%
+      group_by(.data$geo_value) %>%
+      epix_slide(before = 2,
+        slide_value = nrow(.group_key)),
+    NA
+  )
+})
+
+test_that("epix_slide computation via dots outputs the same result using col names and the data var", {
+  xx_ref <- xx %>%
+    group_by(.data$geo_value) %>%
+    epix_slide(before = 2,
+      sum_binary = sum(time_value))
+
+  xx1 <- xx %>%
+    group_by(.data$geo_value) %>%
+    epix_slide(before = 2,
+      sum_binary = sum(.x$time_value))
+
+  expect_identical(xx1, xx_ref)
 })