refactor: pull scalar check into validate_slide_window_arg

Author: dshemetov

R/grouped_epi_archive.R

@@ -252,9 +252,6 @@ epix_slide.grouped_epi_archive <- function(
     ref_time_values <- sort(ref_time_values)
   }
 
-  if (!checkmate::test_scalar(before)) {
-    cli_abort("`before` is a required scalar value.")
-  }
   validate_slide_window_arg(before, guess_time_type(x$private$ungrouped$DT$time_value))
 
   # Symbolize column name

R/slide.R

@@ -154,10 +154,6 @@ epi_slide <- function(x, f, ..., before = NULL, after = NULL, ref_time_values =
   }
   ref_time_values <- sort(ref_time_values)
 
-  # Validate and pre-process `before`, `after`
-  if (!checkmate::test_scalar(before) || !checkmate::test_scalar(after)) {
-    cli_abort("Both `before` and `after` are required scalar values.")
-  }
   time_type <- guess_time_type(x$time_value)
   validate_slide_window_arg(before, time_type)
   validate_slide_window_arg(after, time_type)
@@ -495,10 +491,6 @@ epi_slide_opt <- function(x, col_names, f, ..., before = NULL, after = NULL, ref
   }
   ref_time_values <- sort(ref_time_values)
 
-  # Validate and pre-process `before`, `after`:
-  if (!checkmate::test_scalar(before) || !checkmate::test_scalar(after)) {
-    cli_abort("Both `before` and `after` are required scalar values.")
-  }
   time_type <- guess_time_type(x$time_value)
   validate_slide_window_arg(before, time_type)
   validate_slide_window_arg(after, time_type)

R/utils.R

@@ -682,27 +682,29 @@ guess_period <- function(ref_time_values, ref_time_values_arg = rlang::caller_ar
 
 
 validate_slide_window_arg <- function(arg, time_type, arg_name = rlang::caller_arg(arg)) {
+  if (is.null(arg)) {
+    cli_abort("`{arg_name}` is a required argument.")
+  }
+
+  if (!checkmate::test_scalar(arg)) {
+    cli_abort("Expected `{arg_name}` to be a scalar value.")
+  }
+
   if (!identical(arg, Inf)) {
     if (time_type == "day") {
-      if (!inherits(arg, "difftime")) {
-        cli_abort("Expected {arg_name} to be a difftime with units in days.")
-      }
-      if (units(arg) != "days") {
-        cli_abort("Expected {arg_name} to be a difftime with units in days.")
+      if (!test_int(arg, lower = 0L) && !(inherits(arg, "difftime") && units(arg) == "days")) {
+        cli_abort("Expected `{arg_name}` to be a difftime with units in days or a non-negative integer.")
       }
     } else if (time_type == "week") {
-      if (!inherits(arg, "difftime")) {
-        cli_abort("Expected {arg_name} to be a difftime with units in weeks.")
-      }
-      if (units(arg) != "weeks") {
-        cli_abort("Expected {arg_name} to be a difftime with units in weeks.")
+      if (!(inherits(arg, "difftime") && units(arg) == "weeks")) {
+        cli_abort("Expected `{arg_name}` to be a difftime with units in weeks.")
       }
     } else if (time_type %in% c("yearweek", "yearmonth", "yearquarter", "year")) {
       if (!test_int(arg, lower = 0L) || inherits(arg, "difftime")) {
-        cli_abort("Expected {arg_name} to be a non-negative integer.")
+        cli_abort("Expected `{arg_name}` to be a non-negative integer.")
       }
     } else {
-      cli_abort("Expected {arg_name} to be Inf, an appropriate a difftime, or an integer.")
+      cli_abort("Expected `{arg_name}` to be Inf, an appropriate a difftime, or a non-negative integer.")
     }
   }
 }

tests/testthat/test-epi_slide.R

@@ -53,47 +53,47 @@ basic_mean_result <- tibble::tribble(
 test_that("`before` and `after` are both vectors of length 1", {
   expect_error(
     epi_slide(grouped, f, before = c(0, 1), after = 0, ref_time_values = test_date + 3),
-    "Both `before` and `after` are required scalar values."
+    "Expected `before` to be a scalar value."
   )
   expect_error(
     epi_slide(grouped, f, before = 1, after = c(0, 1), ref_time_values = test_date + 3),
-    "Both `before` and `after` are required scalar values."
+    "Expected `after` to be a scalar value."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = c(0, 1), after = 0, ref_time_values = test_date + 3),
-    "Both `before` and `after` are required scalar values."
+    "Expected `before` to be a scalar value."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = 1, after = c(0, 1), ref_time_values = test_date + 3),
-    "Both `before` and `after` are required scalar values."
+    "Expected `after` to be a scalar value."
   )
 })
 
 test_that("Test errors/warnings for discouraged features", {
   expect_error(
     epi_slide(grouped, f, ref_time_values = test_date + 1),
-    "Both `before` and `after` are required scalar values."
+    "`before` is a required argument."
   )
   expect_error(
     epi_slide(grouped, f, before = 0 * days_dt, ref_time_values = test_date + 1),
-    "Both `before` and `after` are required scalar values."
+    "`after` is a required argument."
   )
   expect_error(
     epi_slide(grouped, f, after = 0 * days_dt, ref_time_values = test_date + 1),
-    "Both `before` and `after` are required scalar values."
+    "`before` is a required argument."
   )
 
   expect_error(
     epi_slide_mean(grouped, col_names = value, ref_time_values = test_date + 1),
-    "Both `before` and `after` are required scalar values."
+    "`before` is a required argument."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = 0 * days_dt, ref_time_values = test_date + 1),
-    "Both `before` and `after` are required scalar values."
+    "`after` is a required argument."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, after = 0 * days_dt, ref_time_values = test_date + 1),
-    "Both `before` and `after` are required scalar values."
+    "`before` is a required argument."
   )
 
   # Below cases should raise no errors/warnings:
@@ -135,64 +135,64 @@ test_that("Test errors/warnings for discouraged features", {
 test_that("Both `before` and `after` must be non-NA, non-negative, integer-compatible", {
   expect_error(
     epi_slide(grouped, f, before = -1L, after = 0 * days_dt, ref_time_values = test_date + 2L),
-    "Expected before to be a difftime with units in days."
+    "Expected `before` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(
     epi_slide(grouped, f, before = 0 * days_dt, after = -1L, ref_time_values = test_date + 2L),
-    "Expected after to be a difftime with units in days."
+    "Expected `after` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(epi_slide(grouped, f, before = "a", after = days_dt, ref_time_values = test_date + 2L),
-    regexp = "Expected before to be a difftime with units in days."
+    regexp = "Expected `before` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(epi_slide(grouped, f, before = days_dt, after = "a", ref_time_values = test_date + 2L),
-    regexp = "Expected after to be a difftime with units in days."
+    regexp = "Expected `after` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(epi_slide(grouped, f, before = 0.5, after = days_dt, ref_time_values = test_date + 2L),
-    regexp = "Expected before to be a difftime with units in days."
+    regexp = "Expected `before` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(epi_slide(grouped, f, before = days_dt, after = 0.5, ref_time_values = test_date + 2L),
-    regexp = "Expected after to be a difftime with units in days."
+    regexp = "Expected `after` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(
     epi_slide(grouped, f, before = NA, after = 1L, ref_time_values = test_date + 2L),
-    "Both `before` and `after` are required scalar values."
+    "Expected `before` to be a scalar value."
   )
   expect_error(
     epi_slide(grouped, f, before = days_dt, after = NA, ref_time_values = test_date + 2L),
-    "Both `before` and `after` are required scalar values."
+    "Expected `after` to be a scalar value."
   )
 
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = -1L, after = 0 * days_dt, ref_time_values = test_date + 2L),
-    "Expected before to be a difftime with units in days."
+    "Expected `before` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = 0 * days_dt, after = -1L, ref_time_values = test_date + 2L),
-    "Expected after to be a difftime with units in days."
+    "Expected `after` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = "a", after = 0 * days_dt, ref_time_values = test_date + 2L),
-    regexp = "Expected before to be a difftime with units in days."
+    regexp = "Expected `before` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = 0 * days_dt, after = "a", ref_time_values = test_date + 2L),
-    regexp = "Expected after to be a difftime with units in days."
+    regexp = "Expected `after` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = 0.5, after = 0 * days_dt, ref_time_values = test_date + 2L),
-    regexp = "Expected before to be a difftime with units in days."
+    regexp = "Expected `before` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = 0 * days_dt, after = 0.5, ref_time_values = test_date + 2L),
-    regexp = "Expected after to be a difftime with units in days."
+    regexp = "Expected `after` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = NA, after = days_dt, ref_time_values = test_date + 2L),
-    "Both `before` and `after` are required scalar values."
+    "Expected `before` to be a scalar value."
   )
   expect_error(
     epi_slide_mean(grouped, col_names = value, before = days_dt, after = NA, ref_time_values = test_date + 2L),
-    "Both `before` and `after` are required scalar values."
+    "Expected `after` to be a scalar value."
   )
 
   # Non-integer-class but integer-compatible values are allowed:

tests/testthat/test-epix_slide.R

@@ -178,15 +178,15 @@ test_that("epix_slide works as intended with `as_list_col=TRUE`", {
 test_that("epix_slide `before` validation works", {
   expect_error(
     xx %>% epix_slide(f = ~ sum(.x$binary), before = NA),
-    "`before` is a required scalar value."
+    "Expected `before` to be a scalar value."
   )
   expect_error(
     xx %>% epix_slide(f = ~ sum(.x$binary), before = -1),
-    "Expected before to be a difftime with units in days."
+    "Expected `before` to be a difftime with units in days or a non-negative integer."
   )
   expect_error(
     xx %>% epix_slide(f = ~ sum(.x$binary), before = 1.5),
-    "Expected before to be a difftime with units in days."
+    "Expected `before` to be a difftime with units in days or a non-negative integer."
   )
   # These `before` values should be accepted:
   expect_error(