refactor: convert "year" time type to generic integer time type

Author: dshemetov

R/epi_df.R

@@ -74,8 +74,7 @@
 #'   `tsibble::yearmonth` object.
 #' * `"yearquarter"`: each observation corresponds to a quarter; coded as a
 #'   `tsibble::yearquarter` object.
-#' * `"year"`: each observation corresponds to a year; coded as an integer
-#'   greater than or equal to 1582.
+#' * `"integer"`: a generic integer index (e.g. years or something else).
 #'
 #' An unrecognizable time type is labeled "custom".
 #'

R/slide.R

@@ -758,7 +758,7 @@ full_date_seq <- function(x, before, after, time_type) {
   # `tsibble` time types have their own behavior, where adding 1 corresponds to
   # incrementing by a quantum (smallest resolvable unit) of the date class. For
   # example, one step = 1 quarter for `yearquarter`.
-  if (time_type %in% c("yearquarter", "yearweek", "yearmonth", "year")) {
+  if (time_type %in% c("yearquarter", "yearweek", "yearmonth", "integer")) {
     all_dates <- seq(min(x$time_value), max(x$time_value), by = 1L)
 
     if (before != 0) {
@@ -775,7 +775,7 @@ full_date_seq <- function(x, before, after, time_type) {
     )
     if (is.null(by)) {
       cli_abort(
-        "time_type must be one of 'day', 'week', 'yearquarter', 'yearweek', 'yearmonth', or 'year'."
+        "time_type must be one of 'day', 'week', 'yearquarter', 'yearweek', 'yearmonth', or 'integer'."
       )
     }
 

R/utils.R

@@ -423,8 +423,8 @@ guess_time_type <- function(time_value, time_value_arg = rlang::caller_arg(time_
     return("yearmonth")
   } else if (inherits(time_value, "yearquarter")) {
     return("yearquarter")
-  } else if (rlang::is_integerish(time_value) && all(nchar(as.character(time_value)) == 4L)) {
-    return("year")
+  } else if (rlang::is_integerish(time_value)) {
+    return("integer")
   }
 
   cli_abort("Unsupported time type in column {time_value_arg}, with class {.code {class(time_value)}}",
@@ -699,10 +699,14 @@ validate_slide_window_arg <- function(arg, time_type, arg_name = rlang::caller_a
       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")) {
+    } else if (time_type %in% c("yearweek", "yearmonth", "yearquarter")) {
       if (!test_int(arg, lower = 0L) || inherits(arg, "difftime")) {
         cli_abort("Expected `{arg_name}` to be a non-negative integer.")
       }
+    } else if (time_type == "integer") {
+      if (!test_int(arg, lower = 0L)) {
+        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 a non-negative integer.")
     }

tests/testthat/test-epi_slide.R

@@ -1071,7 +1071,7 @@ test_that("results for different time_types match between epi_slide and epi_slid
   # tsibble time types, require before and after as integers
   yearmonths <- tsibble::yearmonth(10L + k)
   yearquarters <- tsibble::yearquarter(10L + k)
-  years <- 2000L + k
+  integers <- 2000L + k
 
   ref_epi_data <- generate_special_date_data(days) %>%
     group_by(geo_value)
@@ -1110,7 +1110,7 @@ test_that("results for different time_types match between epi_slide and epi_slid
   test_time_type_mean(yearweeks, before = 6, after = 0)
   test_time_type_mean(yearmonths, before = 6, after = 0)
   test_time_type_mean(yearquarters, before = 6, after = 0)
-  test_time_type_mean(years, before = 6, after = 0)
+  test_time_type_mean(integers, before = 6, after = 0)
 
   # `epi_slide_mean` can also handle `weeks` without `time_step` being
   # provided, but `epi_slide` can't
@@ -1217,7 +1217,7 @@ test_that("helper `full_date_seq` returns expected date values", {
     )
   )
   expect_identical(
-    full_date_seq(generate_special_date_data(years), before = before, after = after, time_type = "year"),
+    full_date_seq(generate_special_date_data(years), before = before, after = after, time_type = "integer"),
     list(
       all_dates = 2000L:2006L,
       pad_early_dates = 1998L:1999L,

tests/testthat/test-utils.R

@@ -45,7 +45,7 @@ test_that("guess_time_type works for different types", {
   yearmonths <- tsibble::yearmonth(10)
   yearquarters <- tsibble::yearquarter(10)
 
-  years <- c(1999, 2000)
+  integers <- c(1999, 2000)
 
   # YYYY-MM-DD is the accepted format
   not_ymd1 <- "January 1, 2022"
@@ -60,7 +60,7 @@ test_that("guess_time_type works for different types", {
   expect_equal(guess_time_type(yearmonths), "yearmonth")
   expect_equal(guess_time_type(yearquarters), "yearquarter")
 
-  expect_equal(guess_time_type(years), "year")
+  expect_equal(guess_time_type(integers), "integer")
 
   expect_error(guess_time_type(not_ymd1))
   expect_error(guess_time_type(not_ymd2))
@@ -69,10 +69,9 @@ test_that("guess_time_type works for different types", {
 })
 
 test_that("guess_time_type works with gaps", {
-  days_gaps <- as.Date("2022-01-01") + c(0, 1, 3, 4, 8, 8 + 7)
-  weeks_gaps <- as.Date("2022-01-01") + 7 * c(0, 1, 3, 4, 8, 8 + 7)
-  expect_equal(guess_time_type(days_gaps), "day")
-  expect_equal(guess_time_type(weeks_gaps), "week")
+  gaps <- c(1:6, 8, 9, 11, 8 + 7)
+  expect_equal(guess_time_type(as.Date("2022-01-01") + gaps), "day")
+  expect_equal(guess_time_type(as.Date("2022-01-01") + 7 * gaps), "week")
 })
 
 test_that("enlist works", {
@@ -230,14 +229,12 @@ test_that("validate_slide_window_arg works", {
   expect_no_error(validate_slide_window_arg(1, "yearweek"))
   expect_no_error(validate_slide_window_arg(1, "yearmonth"))
   expect_no_error(validate_slide_window_arg(1, "yearquarter"))
-  expect_no_error(validate_slide_window_arg(1, "year"))
-  for (time_type in c("day", "week", "yearweek", "yearmonth", "yearquarter", "year")) {
+  expect_no_error(validate_slide_window_arg(1, "integer"))
+  for (time_type in c("day", "week", "yearweek", "yearmonth", "yearquarter", "integer")) {
     expect_no_error(validate_slide_window_arg(Inf, time_type))
   }
 
-  for (time_type in c("day", "week")) {
-    expect_error(validate_slide_window_arg(1, time_type))
-  }
+  expect_error(validate_slide_window_arg(1, "week"))
   for (time_type in c("yearweek", "yearmonth", "yearquarter", "year")) {
     expect_error(validate_slide_window_arg(as.difftime(1, units = "days"), time_type))
     expect_error(validate_slide_window_arg(as.difftime(1, units = "weeks"), time_type))