feat(epi[x]_slide): hint on forgotten syntax specifying comp

Author: brookslogan

DESCRIPTION

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

NEWS.md

@@ -2,6 +2,13 @@
 
 Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.x.y will indicate PR's.
 
+# epiprocess 0.10
+
+## Improvements
+- `epi_slide` and `epix_slide` now provide some hints if you forget a `~` when
+  using a formula to specify the slide computation, and other bits of forgotten
+  syntax.
+
 # epiprocess 0.9
 
 ## Breaking changes

R/grouped_epi_archive.R

@@ -312,14 +312,15 @@ epix_slide.grouped_epi_archive <- function(
       cli_abort("If `f` is missing then a computation must be specified via `...`.")
     }
 
-    .slide_comp <- as_diagonal_slide_computation(quosures)
+    .f_arg <- ".f" # dummy val, shouldn't be used since we're not using `.f`
+    .slide_comp <- as_diagonal_slide_computation(quosures, .f_arg = .f_arg, .call = caller_env())
     # Magic value that passes zero args as dots in calls below. Equivalent to
     # `... <- missing_arg()`, but use `assign` to avoid warning about
     # improper use of dots.
     assign("...", missing_arg())
   } else {
     used_data_masking <- FALSE
-    .slide_comp <- as_diagonal_slide_computation(.f, ...)
+    .slide_comp <- as_diagonal_slide_computation(.f, ..., .f_arg = caller_arg(.f), .call = caller_env())
   }
 
   # Computation for one group, one time value

R/slide.R

@@ -147,14 +147,16 @@ epi_slide <- function(
     }
 
     .f <- quosures
+    .f_arg <- ".f" # dummy val, shouldn't be used since we're not using `.f`
     # Magic value that passes zero args as dots in calls below. Equivalent to
     # `... <- missing_arg()`, but `assign` avoids warning about improper use of
     # dots.
     assign("...", missing_arg())
   } else {
     used_data_masking <- FALSE
+    .f_arg <- caller_arg(.f)
   }
-  .slide_comp <- as_time_slide_computation(.f, ...)
+  .slide_comp <- as_time_slide_computation(.f, ..., .f_arg = .f_arg, .call = caller_env())
 
   .align <- rlang::arg_match(.align)
   time_type <- attr(.x, "metadata")$time_type

R/utils.R

@@ -358,9 +358,24 @@ assert_sufficient_f_args <- function(.f, ..., .ref_time_value_label) {
 #' @importFrom rlang is_function new_function f_env is_environment missing_arg
 #'  f_rhs is_formula caller_arg caller_env
 #' @keywords internal
-as_slide_computation <- function(.f, ..., .ref_time_value_long_varnames, .ref_time_value_label) {
-  arg <- caller_arg(.f)
-  call <- caller_env()
+as_slide_computation <- function(.f, ..., .f_arg = caller_arg(.f), .call = caller_env(), .ref_time_value_long_varnames, .ref_time_value_label) {
+  f_arg <- .f_arg # for cli interpolation, avoid dot prefix
+  withCallingHandlers(
+    {
+      force(.f)
+    },
+    error = function(e) {
+      cli_abort(
+        c("Failed to convert {.code {f_arg}} to a slide computation.",
+          "*" = "If you were trying to use the formula interface, maybe you forgot a tilde at the beginning.",
+          "*" = "If you were trying to use the tidyeval interface, maybe you forgot to specify the name, e.g.: `my_output_col_name =`.",
+          "*" = "If you were trying to use advanced features of the tidyeval interface such as `!! name_variable :=`, you might have forgotten the required leading comma."
+        ),
+        parent = e,
+        class = "epiprocess__as_slide_computation__error_forcing_.f"
+      )
+    }
+  )
 
   if (rlang::is_quosures(.f)) {
     quosures <- rlang::quos_auto_name(.f) # resolves := among other things
@@ -463,10 +478,10 @@ as_slide_computation <- function(.f, ..., .ref_time_value_long_varnames, .ref_ti
     }
 
     if (length(.f) > 2) {
-      cli_abort("{.code {arg}} must be a one-sided formula",
+      cli_abort("{.code {f_arg}} must be a one-sided formula",
         class = "epiprocess__as_slide_computation__formula_is_twosided",
         epiprocess__f = .f,
-        call = call
+        .call = .call
       )
     }
     if (rlang::dots_n(...) > 0L) {
@@ -486,7 +501,7 @@ as_slide_computation <- function(.f, ..., .ref_time_value_long_varnames, .ref_ti
         class = "epiprocess__as_slide_computation__formula_has_no_env",
         epiprocess__f = .f,
         epiprocess__f_env = env,
-        arg = arg, call = call
+        .f_arg = .f_arg, .call = .call
       )
     }
 
@@ -513,26 +528,32 @@ as_slide_computation <- function(.f, ..., .ref_time_value_long_varnames, .ref_ti
     class = "epiprocess__as_slide_computation__cant_convert_catchall",
     epiprocess__f = .f,
     epiprocess__f_class = class(.f),
-    arg = arg,
-    call = call
+    .f_arg = .f_arg,
+    .call = .call
   )
 }
 
 #' @rdname as_slide_computation
+#' @importFrom rlang caller_arg caller_env
 #' @keywords internal
-as_time_slide_computation <- function(.f, ...) {
+as_time_slide_computation <- function(.f, ..., .f_arg = caller_arg(.f), .call = caller_env()) {
   as_slide_computation(
     .f, ...,
+    .f_arg = .f_arg,
+    .call = .call,
     .ref_time_value_long_varnames = ".ref_time_value",
     .ref_time_value_label = "reference time value"
   )
 }
 
 #' @rdname as_slide_computation
+#' @importFrom rlang caller_arg caller_env
 #' @keywords internal
-as_diagonal_slide_computation <- function(.f, ...) {
+as_diagonal_slide_computation <- function(.f, ..., .f_arg = caller_arg(.f), .call = caller_env()) {
   as_slide_computation(
     .f, ...,
+    .f_arg = .f_arg,
+    .call = .call,
     .ref_time_value_long_varnames = c(".version", ".ref_time_value"),
     .ref_time_value_label = "version"
   )

man/as_slide_computation.Rd

@@ -0,0 +1,27 @@
+# as_slide_computation raises errors as expected
+
+    Code
+      toy_edf %>% group_by(geo_value) %>% epi_slide(.window_size = 6, tibble(
+        slide_value = mean(.x$value)))
+    Condition
+      Error in `as_slide_computation()`:
+      ! Failed to convert `tibble(slide_value = mean(.x$value))` to a slide computation.
+      * If you were trying to use the formula interface, maybe you forgot a tilde at the beginning.
+      * If you were trying to use the tidyeval interface, maybe you forgot to specify the name, e.g.: `my_output_col_name =`.
+      * If you were trying to use advanced features of the tidyeval interface such as `!! name_variable :=`, you might have forgotten the required leading comma.
+      Caused by error:
+      ! object '.x' not found
+
+---
+
+    Code
+      toy_archive %>% epix_slide(tibble(slide_value = mean(.x$value)))
+    Condition
+      Error in `as_slide_computation()`:
+      ! Failed to convert `.f` to a slide computation.
+      * If you were trying to use the formula interface, maybe you forgot a tilde at the beginning.
+      * If you were trying to use the tidyeval interface, maybe you forgot to specify the name, e.g.: `my_output_col_name =`.
+      * If you were trying to use advanced features of the tidyeval interface such as `!! name_variable :=`, you might have forgotten the required leading comma.
+      Caused by error:
+      ! object '.x' not found
+

tests/testthat/_snaps/utils.md

@@ -230,6 +230,35 @@ test_that("as_slide_computation raises errors as expected", {
   expect_error(as_time_slide_computation(5),
     class = "epiprocess__as_slide_computation__cant_convert_catchall"
   )
+
+  # If `.f` doesn't look like tidyeval and we fail to force it, then we hint to
+  # the user some potential problems:
+  toy_edf <- tibble(geo_value = 1, time_value = c(1, 2), value = 1:2) %>%
+    as_epi_df(as_of = 1)
+  toy_archive <- tibble(version = c(1, 2, 2), geo_value = 1, time_value = c(1, 1, 2), value = 1:3) %>%
+    as_epi_archive()
+  expect_error(
+    toy_edf %>%
+      group_by(geo_value) %>%
+      epi_slide(.window_size = 6, tibble(slide_value = mean(.x$value))),
+    class = "epiprocess__as_slide_computation__error_forcing_.f"
+  )
+  expect_snapshot(
+    error = TRUE,
+    toy_edf %>%
+      group_by(geo_value) %>%
+      epi_slide(.window_size = 6, tibble(slide_value = mean(.x$value)))
+  )
+  expect_error(
+    toy_archive %>%
+      epix_slide(tibble(slide_value = mean(.x$value))),
+    class = "epiprocess__as_slide_computation__error_forcing_.f"
+  )
+  expect_snapshot(
+    error = TRUE,
+    toy_archive %>%
+      epix_slide(tibble(slide_value = mean(.x$value)))
+  )
 })
 
 test_that("as_slide_computation works", {