fix

Author: dshemetov

R/aux_data_utils.R

@@ -314,9 +314,8 @@ get_health_data <- function(as_of, disease = c("covid", "flu")) {
 
   most_recent_row <- meta_data %>%
     # update_date is actually a time, so we need to filter for the day after.
-    filter(update_date <= as_of + 1) %>%
-    arrange(desc(update_date)) %>%
-    slice(1)
+    filter(update_date <= as.Date(as_of) + 1) %>%
+    slice_max(update_date)
 
   if (nrow(most_recent_row) == 0) {
     cli::cli_abort("No data available for the given date.")
@@ -332,9 +331,7 @@ get_health_data <- function(as_of, disease = c("covid", "flu")) {
   if (disease == "covid") {
     data %<>% mutate(
       hhs = previous_day_admission_adult_covid_confirmed +
-        previous_day_admission_adult_covid_suspected +
-        previous_day_admission_pediatric_covid_confirmed +
-        previous_day_admission_pediatric_covid_suspected
+        previous_day_admission_pediatric_covid_confirmed
     )
   } else if (disease == "flu") {
     data %<>% mutate(hhs = previous_day_admission_influenza_confirmed)

R/forecasters/epipredict_utilities.R

@@ -125,9 +125,7 @@ run_workflow_and_format <- function(preproc,
   # keeping only the last time_value for any given location/key
   pred %<>%
     group_by(across(all_of(key_colnames(train_data, exclude = "time_value")))) %>%
-    # TODO: slice_max(time_value)?
-    arrange(time_value) %>%
-    filter(row_number() == n()) %>%
+    slice_max(time_value) %>%
     ungroup()
   return(format_storage(pred, as_of))
 }

R/forecasters/forecaster_scaled_pop.R

@@ -141,6 +141,7 @@ scaled_pop <- function(epi_data,
       by = c("geo_value" = "abbr")
     )
   }
+
   # with all the setup done, we execute and format
   pred <- run_workflow_and_format(preproc, postproc, trainer, season_data, epi_data)
   # now pred has the columns
@@ -155,6 +156,15 @@ scaled_pop <- function(epi_data,
   if (adding_source) {
     pred_final %<>% select(-source)
   }
+  browser()
+  res %>%
+    group_by(geo_value, forecast_date, target_end_date) %>%
+    summarize(increasing = all(hhs - shift(hhs, 1, -Inf) > 0)) %>%
+    ungroup() %>%
+    filter(!increasing)
+
+  res %>%
+    filter(geo_value == "ma", forecast_date == "2023-10-18", target_end_date == "2023-10-18")
   gc()
   return(pred_final)
 }

scripts/covid_hosp_explore.R

@@ -10,22 +10,14 @@ if (!exists("ref_time_values_")) {
   end_date <- as.Date("2024-04-24")
   # end_date <- start_date + 7 * 10
   date_step <- 7L
-  ref_time_values_ <- seq.Date(as.Date("2023-10-21"), as.Date("2024-04-24"), by = 7L)[1]
+  ref_time_values_ <- seq.Date(start_date, end_date, by = 7L)[3]
 }
 time_value_adjust <- 3 # this moves the week marker from Saturday to Wednesday
 
 # Debug mode will replace all forecasters with a fast dummy forecaster. Helps
 # with prototyping the pipeline.
 dummy_mode <- as.logical(Sys.getenv("DUMMY_MODE", FALSE))
 
-# these are for datasets which have some locations with extreme latency; currently that's only nwss
-# note that this has a vector of names first, and then the list of things to
-# exclude, because targets hates named lists and strips their names
-very_latent_locations <- list(list(
-  c("geo_value"),
-  c("la", "ms", "nd")
-))
-# TODO decide on this, nwss is latent in these locations by ~56 days. might be ok
 
 # Human-readable object to be used for inspecting the forecasters in the pipeline.
 forecaster_parameter_combinations_ <- rlang::list2(

scripts/targets-exploration-common.R

@@ -155,6 +155,7 @@ make_forecasts_and_scores <- function() {
       name = forecast,
       command = {
         debugonce(scaled_pop)
+        debugonce(slide_forecaster)
         browser()
         slid <- slide_forecaster(
           epi_archive = joined_archive_data,