Revert "Adding season argument to aedseo function and refacturating e…

…pi_calendar function"

This reverts commit 53b4c6d.

R/aedseo.R

@@ -21,14 +21,10 @@
 #' Choose between "poisson," or "quasipoisson".
 #' @param na_fraction_allowed Numeric value between 0 and 1 specifying the
 #' fraction of observables in the window of size k that are allowed to be NA.
-#' @param season A numeric vector of length 2 c(start,end) with the start and
-#' end weeks of the seasons to stratify the observations by.
-#' Ex: season = c(21,20). Default is NULL.
 #'
 #' @return A `aedseo` object containing:
 #'   - 'reference_time': The time point for which the growth rate is estimated.
 #'   - 'observed': The observed value in the reference time point.
-#'   - 'season': A stratification of observables in corresponding seasons.
 #'   - 'growth_rate': The estimated growth rate.
 #'   - 'lower_growth_rate': The lower bound of the growth rate's confidence
 #'   interval.
@@ -40,8 +36,8 @@
 #'   - 'sum_of_cases_warning': Logical. Does the Sum of Cases exceed the
 #'   disease threshold?
 #'   - 'seasonal_onset_alarm': Logical. Is there a seasonal onset alarm?
-#'   - 'skipped_window': Logical. Was the window skipped due to missing?
 #'   - 'converged': Logical. Was the IWLS judged to have converged?
+#'   - 'skipped_window': Logical. Was the window skipped due to missing?
 #'
 #' @export
 #'
@@ -82,8 +78,7 @@ aedseo <- function(
       "quasipoisson"
       # TODO: #10 Include negative.binomial regressions. @telkamp7
     ),
-    na_fraction_allowed = 0.4,
-    season = NULL) {
+    na_fraction_allowed = 0.4) {
   # Check input arguments
   coll <- checkmate::makeAssertCollection()
   checkmate::assert_data_frame(tsd)
@@ -92,10 +87,6 @@ aedseo <- function(
   checkmate::assert_numeric(c(level, na_fraction_allowed), len = 2,
                             lower = 0, upper = 1, add = coll)
   checkmate::assert_integerish(c(k, disease_threshold), len = 2)
-  if (!is.null(season)) {
-    checkmate::assert_integerish(season, len = 2,
-                                 lower = 1, upper = 53, add = coll)
-  }
   checkmate::reportAssertions(coll)
 
   # Throw an error if any of the inputs are not supported
@@ -108,13 +99,6 @@ aedseo <- function(
   res <- tibble::tibble()
   skipped_window <- base::rep(FALSE, base::nrow(tsd))
 
-  # Add the seasons to tsd if available
-  if (!is.null(season)) {
-    tsd <- tsd |> dplyr::mutate(Season = epi_calendar(time))
-  } else {
-    tsd <- tsd |> dplyr::mutate(Season = "Not defined")
-  }
-
   for (i in k:n) {
     # Index observations for this iteration
     obs_iter <- tsd[(i - k + 1):i, ]
@@ -152,7 +136,6 @@ aedseo <- function(
       tibble::tibble(
         reference_time = tsd$time[i],
         observed = tsd$observed[i],
-        season = tsd$Season[i],
         growth_rate = growth_rates$estimate[1],
         lower_growth_rate = growth_rates$estimate[2],
         upper_growth_rate = growth_rates$estimate[3],

R/epi_calendar.R

@@ -23,32 +23,34 @@
 #'
 #' @examples
 #' # Check if a date is within the epidemiological season
-#' epi_calendar(as.Date("2023-09-15"), start = 21, end = 20)
-#' # Expected output: "2023/2024"
+#' epi_calendar(as.Date("2023-09-15"), start = 40, end = 20)
+#' # Expected output: "2022/2023"
 #'
-#' epi_calendar(as.Date("2023-05-30"), start = 40, end = 20)
+#' epi_calendar(as.Date("2023-05-01"), start = 40, end = 20)
 #' # Expected output: "out_of_season"
 #'
-#' epi_calendar(as.Date("2023-01-15"), start = 21, end = 20)
+#' epi_calendar(as.Date("2023-01-15"), start = 40, end = 20)
 #' # Expected output: "2022/2023"
 #'
-#' epi_calendar(as.Date("2023-12-01"), start = 21, end = 20)
+#' epi_calendar(as.Date("2023-12-01"), start = 40, end = 20)
 #' # Expected output: "2023/2024"
-epi_calendar <- Vectorize(function(date, start = 21, end = 20) {
+epi_calendar <- Vectorize(function(date, start = 40, end = 20) {
   # Compute the current week
-  current_week <- as.integer(format(x = date, "%V"))
+  current_week <- as.integer(format(x = date, "%U"))
 
-  if (!(current_week >= start | current_week <= end)) {
+  if (current_week <= start & end <= current_week) {
     return("out_of_season")
   }
 
   # Compute the current year
-  current_year <- as.integer(strftime(date, format = "%G"))
+  current_year <- format(date, "%Y")
+  # ... and turn into integer
+  current_year_integer <- as.integer(current_year)
 
   if (current_week <= end) {
-    ans <- paste0(current_year - 1, "/", current_year)
+    ans <- paste0(current_year_integer - 1, "/", current_year_integer)
   } else {
-    ans <- paste0(current_year, "/", current_year + 1)
+    ans <- paste0(current_year_integer, "/", current_year_integer + 1)
   }
 
   return(ans)

R/summary.R

@@ -46,13 +46,6 @@ summary.aedseo <- function(object, ...) {
   # Extract the reference time
   reference_time <- last_observation$reference_time
 
-  # Extract the time_interval
-  time_interval <- attr(object, "time_interval")
-
-  # Extract the seasons
-  seasons <- unique(object$season)
-  seasons <- paste(seasons, collapse = ", ")
-
   # Latest sum of cases
   latest_sum_of_cases <- object %>%
     dplyr::filter(dplyr::row_number() == dplyr::n()) %>%
@@ -109,9 +102,6 @@ summary.aedseo <- function(object, ...) {
     calculation of sum of cases:
       %d
 
-    The time interval for the observations:
-      %s
-
     Disease specific threshold:
       %d
 
@@ -133,13 +123,9 @@ summary.aedseo <- function(object, ...) {
       %s
 
     Latest seasonal onset alarm:
-      %s
-
-    The seasons defined in the series:
       %s",
     family,
     k,
-    time_interval,
     disease_threshold,
     as.character(reference_time),
     latest_sum_of_cases,
@@ -151,8 +137,7 @@ summary.aedseo <- function(object, ...) {
     last_observation$upper_growth_rate,
     sum_of_growth_warnings,
     as.character(latest_growth_warning),
-    as.character(latest_seasonal_onset_alarm),
-    seasons
+    as.character(latest_seasonal_onset_alarm)
   )
 
   # Print the summary message

tests/testthat/test-epi_calendar.R

@@ -1,16 +1,16 @@
 # Test if a date within the season returns the correct season
 test_that("Within the season, correct season is returned", {
   expect_equal(
-    epi_calendar(as.Date("2023-03-15"), start = 21, end = 20), "2022/2023"
+    epi_calendar(as.Date("2023-03-15"), start = 40, end = 20), "2022/2023"
   )
   expect_equal(
-    epi_calendar(as.Date("2023-05-01"), start = 21, end = 20), "2022/2023"
+    epi_calendar(as.Date("2023-05-01"), start = 40, end = 20), "2022/2023"
   )
   expect_equal(
-    epi_calendar(as.Date("2023-01-15"), start = 21, end = 20), "2022/2023"
+    epi_calendar(as.Date("2023-01-15"), start = 40, end = 20), "2022/2023"
   )
   expect_equal(
-    epi_calendar(as.Date("2023-12-01"), start = 21, end = 20), "2023/2024"
+    epi_calendar(as.Date("2023-12-01"), start = 40, end = 20), "2023/2024"
   )
 })
 
@@ -26,15 +26,3 @@ test_that("Outside the season, 'out_of_season' is returned", {
     epi_calendar(as.Date("2023-06-30"), start = 40, end = 20), "out_of_season"
   )
 })
-
-# Test that all dates from week 53 belongs to correct season 2015/2016
-test_that("All dates from week 53 belongs to correct season 2015/2016", {
-  week_53_season_15_16 <- c("2015-12-28", "2015-12-29", "2015-12-30",
-                            "2015-12-31", "2016-01-01", "2016-01-02",
-                            "2016-01-03")
-  results <- map(week_53_season_15_16,
-                 ~ epi_calendar(as.Date(.x), start = 21, end = 20))
-  results_vector <- unlist(results)
-
-  expect_equal(results_vector, rep("2015/2016", length(week_53_season_15_16)))
-})