Merge pull request #336 from cmu-delphi/ndefries/drop-nargs-num-args-check

Drop the `n_mandatory_f_args` placeholder arg from `assert_sufficient_f_args`

Author: nmdefries

R/grouped_epi_archive.R

@@ -232,7 +232,7 @@ grouped_epi_archive =
 
             # Check that `f` takes enough args
             if (!missing(f) && is.function(f)) {
-              assert_sufficient_f_args(f, ..., n_mandatory_f_args = 3L)
+              assert_sufficient_f_args(f, ...)
             }
 
             # Validate and pre-process `before`:

R/slide.R

@@ -170,7 +170,7 @@ epi_slide = function(x, f, ..., before, after, ref_time_values,
 
   # Check that `f` takes enough args
   if (!missing(f) && is.function(f)) {
-    assert_sufficient_f_args(f, ..., n_mandatory_f_args = 3L)
+    assert_sufficient_f_args(f, ...)
   }
 
   if (missing(ref_time_values)) {

R/utils.R

@@ -106,16 +106,14 @@ Warn = function(msg, ...) rlang::warn(break_str(msg, init = "Warning: "), ...)
 #'  `epi_archive` in `epi_slide` or `epix_slide`.
 #' @param ... Dots that will be forwarded to `f` from the dots of `epi_slide` or
 #'   `epix_slide`.
-#' @param n_mandatory_f_args Integer; specifies the number of arguments `f`
-#'  is required to take before any `...` arg. Defaults to 2.
 #'
 #' @importFrom rlang is_missing
 #' @importFrom purrr map_lgl
 #' @importFrom utils tail
 #'
 #' @noRd
-assert_sufficient_f_args <- function(f, ..., n_mandatory_f_args = 2L) {
-  mandatory_f_args_labels <- c("window data", "group key", "reference time value")[seq(n_mandatory_f_args)]
+assert_sufficient_f_args <- function(f, ...) {
+  mandatory_f_args_labels <- c("window data", "group key", "reference time value")
   n_mandatory_f_args <- length(mandatory_f_args_labels)
   args = formals(args(f))
   args_names = names(args)

tests/testthat/test-utils.R

@@ -110,25 +110,25 @@ test_that("enlist works",{
 })
 
 test_that("assert_sufficient_f_args alerts if the provided f doesn't take enough args", {
-  f_xg = function(x, g) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
-  f_xg_dots = function(x, g, ...) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
+  f_xgt = function(x, g, t) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
+  f_xgt_dots = function(x, g, t, ...) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
 
   # If `regexp` is NA, asserts that there should be no errors/messages.
-  expect_error(assert_sufficient_f_args(f_xg), regexp = NA)
-  expect_warning(assert_sufficient_f_args(f_xg), regexp = NA)
-  expect_error(assert_sufficient_f_args(f_xg_dots), regexp = NA)
-  expect_warning(assert_sufficient_f_args(f_xg_dots), regexp = NA)
+  expect_error(assert_sufficient_f_args(f_xgt), regexp = NA)
+  expect_warning(assert_sufficient_f_args(f_xgt), regexp = NA)
+  expect_error(assert_sufficient_f_args(f_xgt_dots), regexp = NA)
+  expect_warning(assert_sufficient_f_args(f_xgt_dots), regexp = NA)
 
   f_x_dots = function(x, ...) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
   f_dots = function(...) dplyr::tibble(value=c(5), count=c(2))
   f_x = function(x) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
   f = function() dplyr::tibble(value=c(5), count=c(2))
 
   expect_warning(assert_sufficient_f_args(f_x_dots),
-    regexp = ", the group key will be included",
+    regexp = ", the group key and reference time value will be included",
     class = "epiprocess__assert_sufficient_f_args__mandatory_f_args_passed_to_f_dots")
   expect_warning(assert_sufficient_f_args(f_dots),
-    regexp = ", the window data and group key will be included",
+    regexp = ", the window data, group key, and reference time value will be included",
     class = "epiprocess__assert_sufficient_f_args__mandatory_f_args_passed_to_f_dots")
   expect_error(assert_sufficient_f_args(f_x),
     class = "epiprocess__assert_sufficient_f_args__f_needs_min_args")
@@ -142,46 +142,42 @@ test_that("assert_sufficient_f_args alerts if the provided f doesn't take enough
   expect_error(assert_sufficient_f_args(f_xs, setting="b"),
     class = "epiprocess__assert_sufficient_f_args__f_needs_min_args_plus_forwarded")
 
-  expect_error(assert_sufficient_f_args(f_xg, "b"),
+  expect_error(assert_sufficient_f_args(f_xgt, "b"),
     class = "epiprocess__assert_sufficient_f_args__f_needs_min_args_plus_forwarded")
 })
 
 test_that("assert_sufficient_f_args alerts if the provided f has defaults for the required args", {
-  f_xg = function(x, g=1) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
-  f_xg_dots = function(x=1, g, ...) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
+  f_xgt = function(x, g=1, t) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
+  f_xgt_dots = function(x=1, g, t, ...) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
   f_x_dots = function(x=1, ...) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
 
-  expect_error(assert_sufficient_f_args(f_xg),
+  expect_error(assert_sufficient_f_args(f_xgt),
     regexp = "pass the group key to `f`'s g argument,",
     class = "epiprocess__assert_sufficient_f_args__required_args_contain_defaults")
-  expect_error(assert_sufficient_f_args(f_xg_dots),
+  expect_error(assert_sufficient_f_args(f_xgt_dots),
     regexp = "pass the window data to `f`'s x argument,",
     class = "epiprocess__assert_sufficient_f_args__required_args_contain_defaults")
   expect_error(suppressWarnings(assert_sufficient_f_args(f_x_dots)),
     class = "epiprocess__assert_sufficient_f_args__required_args_contain_defaults")
 
-  f_xsg = function(x, setting="a", g) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
-  f_xsg_dots = function(x, setting="a", g, ...) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
+  f_xsgt = function(x, setting="a", g, t) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
+  f_xsgt_dots = function(x, setting="a", g, t, ...) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
   f_xs_dots = function(x=1, setting="a", ...) dplyr::tibble(value=mean(x$binary), count=length(x$binary))
 
   # forwarding named dots should prevent some complaints:
-  expect_no_error(assert_sufficient_f_args(f_xsg, setting = "b"))
-  expect_no_error(assert_sufficient_f_args(f_xsg_dots, setting = "b"))
+  expect_no_error(assert_sufficient_f_args(f_xsgt, setting = "b"))
+  expect_no_error(assert_sufficient_f_args(f_xsgt_dots, setting = "b"))
   expect_error(suppressWarnings(assert_sufficient_f_args(f_xs_dots, setting = "b")),
-    regexp = "window data to `f`'s x argument",
+    regexp = "pass the window data to `f`'s x argument",
     class = "epiprocess__assert_sufficient_f_args__required_args_contain_defaults")
 
   # forwarding unnamed dots should not:
-  expect_error(assert_sufficient_f_args(f_xsg, "b"),
+  expect_error(assert_sufficient_f_args(f_xsgt, "b"),
                class = "epiprocess__assert_sufficient_f_args__required_args_contain_defaults")
-  expect_error(assert_sufficient_f_args(f_xsg_dots, "b"),
+  expect_error(assert_sufficient_f_args(f_xsgt_dots, "b"),
                class = "epiprocess__assert_sufficient_f_args__required_args_contain_defaults")
-  expect_error(assert_sufficient_f_args(f_xs_dots, "b"),
-               class = "epiprocess__assert_sufficient_f_args__required_args_contain_defaults")
-
-  # forwarding no dots should produce a different error message in some cases:
-  expect_error(assert_sufficient_f_args(f_xs_dots),
-               regexp = "window data and group key to `f`'s x and setting argument",
+  expect_error(suppressWarnings(assert_sufficient_f_args(f_xs_dots, "b")),
+               regexp = "pass the window data and group key to `f`'s x and setting argument",
                class = "epiprocess__assert_sufficient_f_args__required_args_contain_defaults")
 })