Merge pull request #54 from cmu-delphi/ds/refactors

refactor: small bugfixes and cleanup

Author: dshemetov

DESCRIPTION

@@ -2,60 +2,39 @@ Package: epieval
 Title: Evaluating Timeseries Forecasting on Archival Data
 Version: 0.1.0
 Date: 2023-09-28
-Authors@R: 
+Authors@R:
     c(
     person("David", "Weber", email = "[email protected]", role = c("ctb", "cre")),
-    person("Dmitry", "Shemetov", email = "[email protected]", role = c("aut"))
+    person("Dmitry", "Shemetov", email = "[email protected]", role = c("aut")),
+    person("Nat", "DeFries", email = "[email protected]", role = c("aut"))
     )
 Description: Given a timeseries and accompanying auxillary timeseries, evaluate a collection of forecasters implementable with epipredict using several metrics on historical data. Assuming the source of your timeseries provides versioned data, the evaluation at any given timepoint will only use data that was available at that point.
 License: MIT + file LICENSE
 Depends:
-    epiprocess (>= 0.6.0),
-    epipredict,
     R (>= 3.5.0)
 Imports:
     assertthat,
     aws.s3,
     cli,
-    distributional,
     dplyr,
     epidatr,
     epipredict,
-    fs,
-    generics,
-    glue,
-    hardhat (>= 1.3.0),
+    epiprocess,
     here,
     lubridate,
     magrittr,
-    methods,
-    openssl,
     parsnip (>= 1.0.0),
     purrr,
-    quantreg,
     recipes (>= 1.0.4),
     rlang,
-    smoothqr,
-    stats,
-    targets,
     tibble,
-    tidyr,
-    tidyselect,
-    usethis,
-    vctrs,
-    workflows (>= 1.0.0)
+    tidyr
 Suggests:
-    covidcast,
-    data.table,
     ggplot2,
     knitr,
-    pipeR,
     plotly,
-    poissonreg,
     rmarkdown,
-    shiny,
     testthat (>= 3.0.0),
-    xgboost
 VignetteBuilder:
     knitr
 Remotes:

Makefile

@@ -1,5 +1,5 @@
 install:
-	Rscript -e "install.packages(c('renv', 'pak'))"
+	Rscript -e "install.packages(c('renv', 'pak', 'rspm'))"
 	Rscript -e "renv::restore()"
 
 run:

NAMESPACE

@@ -16,6 +16,7 @@ export(id_ahead_ensemble_grid)
 export(interval_coverage)
 export(lookup_ids)
 export(make_target_param_grid)
+export(manage_S3_forecast_cache)
 export(overprediction)
 export(perform_sanity_checks)
 export(read_external_predictions_data)
@@ -26,24 +27,64 @@ export(sharpness)
 export(single_id)
 export(underprediction)
 export(weighted_interval_score)
-import(dplyr)
-import(epipredict)
-import(openssl)
-import(recipes)
-import(rlang)
 importFrom(assertthat,assert_that)
+importFrom(aws.s3,get_bucket)
+importFrom(aws.s3,s3sync)
+importFrom(cli,cli_abort)
 importFrom(cli,hash_animal)
+importFrom(dplyr,across)
+importFrom(dplyr,any_of)
+importFrom(dplyr,everything)
+importFrom(dplyr,filter)
+importFrom(dplyr,group_by)
+importFrom(dplyr,inner_join)
+importFrom(dplyr,join_by)
+importFrom(dplyr,left_join)
+importFrom(dplyr,mutate)
+importFrom(dplyr,reframe)
+importFrom(dplyr,relocate)
+importFrom(dplyr,rename)
+importFrom(dplyr,rowwise)
+importFrom(dplyr,select)
+importFrom(dplyr,summarize)
+importFrom(dplyr,ungroup)
+importFrom(epipredict,add_frosting)
+importFrom(epipredict,arx_args_list)
 importFrom(epipredict,epi_recipe)
+importFrom(epipredict,epi_workflow)
+importFrom(epipredict,fit)
+importFrom(epipredict,flatline_args_list)
+importFrom(epipredict,flatline_forecaster)
+importFrom(epipredict,frosting)
+importFrom(epipredict,get_test_data)
+importFrom(epipredict,layer_add_target_date)
+importFrom(epipredict,layer_naomit)
+importFrom(epipredict,layer_point_from_distn)
+importFrom(epipredict,layer_population_scaling)
+importFrom(epipredict,layer_predict)
+importFrom(epipredict,layer_quantile_distn)
+importFrom(epipredict,layer_residual_quantiles)
+importFrom(epipredict,layer_threshold)
+importFrom(epipredict,nested_quantiles)
+importFrom(epipredict,step_epi_ahead)
+importFrom(epipredict,step_epi_lag)
+importFrom(epipredict,step_epi_naomit)
 importFrom(epipredict,step_population_scaling)
+importFrom(epipredict,step_training_window)
 importFrom(epiprocess,epix_slide)
-importFrom(lubridate,Date)
+importFrom(here,here)
 importFrom(magrittr,"%<>%")
 importFrom(magrittr,"%>%")
 importFrom(purrr,map)
+importFrom(purrr,map2_vec)
 importFrom(purrr,transpose)
+importFrom(recipes,all_numeric)
+importFrom(rlang,"!!")
 importFrom(rlang,.data)
 importFrom(rlang,quo)
 importFrom(rlang,sym)
 importFrom(rlang,syms)
 importFrom(tibble,tibble)
+importFrom(tidyr,expand_grid)
 importFrom(tidyr,pivot_wider)
+importFrom(tidyr,unnest)

R/epieval-package.R

@@ -0,0 +1,15 @@
+#' @importFrom magrittr %>% %<>%
+#' @importFrom dplyr select rename inner_join join_by mutate relocate any_of
+#'    group_by reframe summarize left_join across filter rowwise everything ungroup
+#' @importFrom purrr transpose map map2_vec
+#' @keywords internal
+"_PACKAGE"
+globalVariables(c("ahead", "id", "parent_id", "all_of", "last_col", "time_value", "geo_value", "target_end_date", "forecast_date", "quantile", ".pred_distn", "quantiles", "quantile_levels", "signal", ".dstn", "values", ".", "forecasters","forecaster", "trainer", "forecast_date", ".pred", "n_distinct", "target_date", "value"))
+.onLoad <- function(libname, pkgname) {
+  epidatr::set_cache(
+    cache_dir = ".exploration_cache",
+    days = 14,
+    max_size = 4,
+    confirm = FALSE
+  )
+}

R/evaluation_utils.R

@@ -75,6 +75,7 @@ confirm_insufficient_data <- function(epi_data, ahead, args_input, buffer = 9) {
 #' @param predictors a character vector of the columns used as predictors
 #' @param args_list an [`epipredict::arx_args_list`]
 #' @seealso [arx_postprocess] for the layer equivalent
+#' @importFrom epipredict step_epi_lag step_epi_ahead step_epi_naomit step_training_window
 #' @export
 arx_preprocess <- function(rec, outcome, predictors, args_list) {
   # input already validated
@@ -104,6 +105,7 @@ arx_preprocess <- function(rec, outcome, predictors, args_list) {
 #'   the default of `layer_add_target_date`, which is either
 #'   `forecast_date+ahead`, or the `max time_value + ahead`
 #' @seealso [arx_preprocess] for the step equivalent
+#' @importFrom epipredict layer_predict layer_quantile_distn layer_point_from_distn layer_residual_quantiles layer_threshold layer_naomit layer_add_target_date
 #' @export
 arx_postprocess <- function(postproc,
                             trainer,
@@ -112,7 +114,9 @@ arx_postprocess <- function(postproc,
                             target_date = NULL) {
   postproc %<>% layer_predict()
   if (inherits(trainer, "quantile_reg")) {
-    postproc %<>% layer_quantile_distn(quantile_levels = args_list$quantile_levels) %>% layer_point_from_distn()
+    postproc %<>%
+      layer_quantile_distn(quantile_levels = args_list$quantile_levels) %>%
+      layer_point_from_distn()
   } else {
     postproc %<>% layer_residual_quantiles(
       quantile_levels = args_list$quantile_levels, symmetrize = args_list$symmetrize,
@@ -123,7 +127,8 @@ arx_postprocess <- function(postproc,
     postproc %<>% layer_threshold(dplyr::starts_with(".pred"))
   }
 
-  postproc %<>% layer_naomit(dplyr::starts_with(".pred")) %>%
+  postproc %<>%
+    layer_naomit(dplyr::starts_with(".pred")) %>%
     layer_add_target_date(target_date = target_date)
   return(postproc)
 }
@@ -136,7 +141,7 @@ arx_postprocess <- function(postproc,
 #' @param trainer the parsnip trainer
 #' @param epi_data the actual epi_df to train on
 #' @export
-#' @import epipredict recipes
+#' @importFrom epipredict epi_workflow fit add_frosting get_test_data
 run_workflow_and_format <- function(preproc, postproc, trainer, epi_data) {
   workflow <- epi_workflow(preproc, trainer) %>%
     fit(epi_data) %>%
@@ -171,8 +176,9 @@ run_workflow_and_format <- function(preproc, postproc, trainer, epi_data) {
 #'   contain `ahead`
 #' @param forecaster_args_names a bit of a hack around targets, it contains
 #'   the names of the `forecaster_args`.
-#' @import rlang epipredict dplyr
 #' @importFrom epiprocess epix_slide
+#' @importFrom cli cli_abort
+#' @importFrom rlang !!
 #' @export
 forecaster_pred <- function(data,
                             outcome,
@@ -187,7 +193,7 @@ forecaster_pred <- function(data,
     names(forecaster_args) <- forecaster_args_names
   }
   if (is.null(forecaster_args$ahead)) {
-    cli::cli_abort(
+    cli_abort(
       c(
         "exploration-tooling error: forecaster_pred needs some value for ahead."
       ),

R/exploration-tooling-package.R

@@ -4,6 +4,7 @@
 #' does not support `lags` as a parameter, but otherwise has the same parameters as `arx_forecaster`
 #' @inheritParams scaled_pop
 #' @importFrom rlang sym
+#' @importFrom epipredict flatline_forecaster flatline_args_list
 #' @export
 flatline_fc <- function(epi_data,
                         outcome,
@@ -25,8 +26,8 @@ flatline_fc <- function(epi_data,
   if (confirm_insufficient_data(epi_data, effective_ahead, args_input)) {
     null_result <- tibble(
       geo_value = character(),
-      forecast_date = Date(),
-      target_end_date = Date(),
+      forecast_date = lubridate::Date(),
+      target_end_date = lubridate::Date(),
       quantile = numeric(),
       value = numeric()
     )

R/forecaster.R

@@ -36,11 +36,9 @@
 #'   covidhub.
 #' @seealso some utilities for making forecasters: [format_storage],
 #'   [perform_sanity_checks]
-#' @import recipes epipredict
-#' @importFrom magrittr %>% %<>%
-#' @importFrom epipredict epi_recipe step_population_scaling
+#' @importFrom epipredict epi_recipe step_population_scaling frosting arx_args_list layer_population_scaling
 #' @importFrom tibble tibble
-#' @importFrom lubridate Date
+#' @importFrom recipes all_numeric
 #' @export
 scaled_pop <- function(epi_data,
                        outcome,
@@ -63,8 +61,8 @@ scaled_pop <- function(epi_data,
   if (confirm_insufficient_data(epi_data, effective_ahead, args_input)) {
     null_result <- tibble(
       geo_value = character(),
-      forecast_date = Date(),
-      target_end_date = Date(),
+      forecast_date = lubridate::Date(),
+      target_end_date = lubridate::Date(),
       quantile = numeric(),
       value = numeric()
     )
@@ -88,7 +86,7 @@ scaled_pop <- function(epi_data,
   if (pop_scaling) {
     preproc %<>% step_population_scaling(
       all_numeric(),
-      df = state_census,
+      df = epipredict::state_census,
       df_pop_col = "pop",
       create_new = FALSE,
       rate_rescaling = 1e5,
@@ -104,7 +102,7 @@ scaled_pop <- function(epi_data,
   if (pop_scaling) {
     postproc %<>% layer_population_scaling(
       .pred, .pred_distn,
-      df = state_census,
+      df = epipredict::state_census,
       df_pop_col = "pop",
       create_new = FALSE,
       rate_rescaling = 1e5,

R/forecaster_flatline.R

@@ -8,8 +8,8 @@
 #' @param true_forecast_date the actual date from which the model is
 #'   making the forecast, rather than the last day of available data
 #' @param target_end_date the date of the prediction
-#' @import dplyr epipredict
-#' @importFrom magrittr %>% %<>%
+#' @importFrom epipredict nested_quantiles
+#' @importFrom tidyr unnest
 #' @export
 format_storage <- function(pred, true_forecast_date, target_end_date) {
   pred %>%
@@ -34,7 +34,6 @@ format_storage <- function(pred, true_forecast_date, target_end_date) {
 #'   making the forecast, rather than the last day of available data
 #' @param target_end_date the date of the prediction
 #' @param quantile_levels the quantile levels
-#' @import dplyr
 format_covidhub <- function(pred, true_forecast_date, target_end_date, quantile_levels) {
   pred %<>%
     group_by(forecast_date, geo_value, target_date) %>%

R/forecaster_scaled_pop.R

@@ -1,13 +1,24 @@
+#' Manage S3 cache
+#' @param rel_cache_dir The relative path to the cache directory, e.g.
+#' "data-processed/2021-09-01".
+#' @param bucket_name The name of the S3 bucket to sync.
+#' @param direction Set 'download' to download files or 'upload' to upload
+#' files.
+#' @param verbose Set to TRUE to print the files being synced.
+#'
+#' @importFrom aws.s3 s3sync get_bucket
+#' @importFrom here here
+#' @export
 manage_S3_forecast_cache <- function(rel_cache_dir, bucket_name = "forecasting-team-data", direction = "download", verbose = FALSE) {
-  cache_path <- here::here(rel_cache_dir)
+  cache_path <- here(rel_cache_dir)
   if (!dir.exists(cache_path)) dir.create(cache_path)
 
-  s3b <- aws.s3::get_bucket(bucket_name)
+  s3b <- get_bucket(bucket_name)
   if (verbose) {
-    aws.s3::s3sync(cache_path, s3b, paste0("covid-hosp-forecast/", rel_cache_dir), direction = direction)
+    s3sync(cache_path, s3b, paste0("covid-hosp-forecast/", rel_cache_dir), direction = direction)
   } else {
     sink("/dev/null")
-    aws.s3::s3sync(cache_path, s3b, paste0("covid-hosp-forecast/", rel_cache_dir), direction = direction, verbose = FALSE)
+    s3sync(cache_path, s3b, paste0("covid-hosp-forecast/", rel_cache_dir), direction = direction, verbose = FALSE)
     sink()
   }
   return(TRUE)