diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index a962591c..e817b31e 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -26,7 +26,7 @@ repos: ##### # R - repo: https://github.com/lorenzwalthert/precommit - rev: v0.4.3.9017 + rev: v0.4.3.9019 hooks: - id: lintr ##### diff --git a/hewr/NAMESPACE b/hewr/NAMESPACE index 83d59c73..b3bd0cce 100644 --- a/hewr/NAMESPACE +++ b/hewr/NAMESPACE @@ -2,6 +2,7 @@ S3method(process_model_samples,pyrenew) S3method(process_model_samples,timeseries) +export(augment_timeseries_draws_w_obs) export(epiweekly_samples_from_daily) export(format_timeseries_output) export(generate_exp_growth_pois) @@ -21,6 +22,5 @@ export(process_loc_forecast) export(process_model_samples) export(prop_from_timeseries) export(read_and_combine_data) -export(to_tidy_draws_timeseries) importFrom(rlang,":=") importFrom(rlang,.data) diff --git a/hewr/R/process_loc_forecast.R b/hewr/R/process_loc_forecast.R index f936ff1c..b40e993a 100644 --- a/hewr/R/process_loc_forecast.R +++ b/hewr/R/process_loc_forecast.R @@ -33,8 +33,8 @@ load_and_aggregate_ts <- function( dplyr::mutate( data = purrr::pmap( list(.data$samples, .data$observed), - function(samples, observed, epiweekly) { - to_tidy_draws_timeseries( + function(samples, observed) { + augment_timeseries_draws_w_obs( tidy_forecast = samples, observed = observed ) @@ -239,24 +239,22 @@ read_and_combine_data <- function(model_dir) { #' @param value_colname Name of the column in #' `tidy_forecast` for the sampled values. #' Default `".value"`. -#' @param epiweekly Is the timeseries epiweekly (as opposed -#' to daily)? Boolean, default `FALSE` (i.e. daily timeseries). #' @export -to_tidy_draws_timeseries <- function( +augment_timeseries_draws_w_obs <- function( tidy_forecast, observed, date_colname = "date", sample_id_colname = ".draw", - value_colname = ".value", - epiweekly = FALSE + value_colname = ".value" ) { first_forecast_date <- min(tidy_forecast[[date_colname]]) resolution <- unique(tidy_forecast$resolution) - day_count <- ifelse(resolution == "epiweekly", 7, 1) + checkmate::assert_scalar(resolution) + step_size_days <- dplyr::if_else(resolution == "epiweekly", 7, 1) n_draws <- max(tidy_forecast[[sample_id_colname]]) - target_variables <- unique(tidy_forecast$.variable) - transformed_obs <- observed |> + + obs_as_samples <- observed |> dplyr::filter( .data[[date_colname]] < !!first_forecast_date, .data$.variable %in% target_variables @@ -265,13 +263,13 @@ to_tidy_draws_timeseries <- function( dplyr::mutate(resolution = !!resolution) stopifnot( - max(as.Date(transformed_obs[[date_colname]])) + - lubridate::ddays(day_count) == + max(as.Date(obs_as_samples[[date_colname]])) + + lubridate::ddays(step_size_days) == first_forecast_date ) dplyr::bind_rows( - transformed_obs, + obs_as_samples, tidy_forecast ) |> dplyr::select(!!sample_id_colname, tidyselect::everything()) diff --git a/hewr/man/to_tidy_draws_timeseries.Rd b/hewr/man/augment_timeseries_draws_w_obs.Rd similarity index 79% rename from hewr/man/to_tidy_draws_timeseries.Rd rename to hewr/man/augment_timeseries_draws_w_obs.Rd index 1399aaac..85e596fd 100644 --- a/hewr/man/to_tidy_draws_timeseries.Rd +++ b/hewr/man/augment_timeseries_draws_w_obs.Rd @@ -1,18 +1,17 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/process_loc_forecast.R -\name{to_tidy_draws_timeseries} -\alias{to_tidy_draws_timeseries} +\name{augment_timeseries_draws_w_obs} +\alias{augment_timeseries_draws_w_obs} \title{Combine a forecast in tidy draws based format with observed values to create a synthetic set of tidy posterior "samples".} \usage{ -to_tidy_draws_timeseries( +augment_timeseries_draws_w_obs( tidy_forecast, observed, date_colname = "date", sample_id_colname = ".draw", - value_colname = ".value", - epiweekly = FALSE + value_colname = ".value" ) } \arguments{ @@ -31,9 +30,6 @@ posterior samples / draws. Default \code{".draw"}.} \item{value_colname}{Name of the column in \code{tidy_forecast} for the sampled values. Default \code{".value"}.} - -\item{epiweekly}{Is the timeseries epiweekly (as opposed -to daily)? Boolean, default \code{FALSE} (i.e. daily timeseries).} } \description{ Observed timepoints have the observed value as diff --git a/hewr/man/process_loc_forecast.Rd b/hewr/man/process_loc_forecast.Rd index 260b690e..529e3aab 100644 --- a/hewr/man/process_loc_forecast.Rd +++ b/hewr/man/process_loc_forecast.Rd @@ -21,8 +21,8 @@ process_loc_forecast( \item{n_forecast_days}{An integer specifying the number of days to forecast.} \item{model_name}{Name of directory containing model outputs. -If provided, uses new S3 dispatch interface (overrides -pyrenew_model_name/timeseries_model_name).} +If provided, uses new S3 dispatch interface with auto-detection +(overrides pyrenew_model_name/timeseries_model_name).} \item{pyrenew_model_name}{Name of directory containing pyrenew model outputs (legacy interface)} diff --git a/hewr/tests/testthat/test_process_loc_forecast.R b/hewr/tests/testthat/test_process_loc_forecast.R index 0acc27ba..37479b6a 100644 --- a/hewr/tests/testthat/test_process_loc_forecast.R +++ b/hewr/tests/testthat/test_process_loc_forecast.R @@ -49,7 +49,7 @@ example_eval_dat <- tibble::tibble( ) |> dplyr::mutate(.value = rpois(dplyr::n(), 100)) -test_that("to_tidy_draws_timeseries() works as expected", { +test_that("augment_timeseries_draws_w_obs() works as expected", { forecast <- tibble::tibble( date = as.Date(c("2024-12-21", "2024-12-22")), resolution = "daily", @@ -67,7 +67,7 @@ test_that("to_tidy_draws_timeseries() works as expected", { .variable = rep("other_ed_visits", 4L), .value = c(11037, 12898, 15172, 17716), ) - result <- to_tidy_draws_timeseries( + result <- augment_timeseries_draws_w_obs( forecast, obs ) diff --git a/hewr/tests/testthat/test_timeseries_utils.R b/hewr/tests/testthat/test_timeseries_utils.R index 857a0207..e7bc3a68 100644 --- a/hewr/tests/testthat/test_timeseries_utils.R +++ b/hewr/tests/testthat/test_timeseries_utils.R @@ -144,7 +144,7 @@ test_that("epiweekly_samples_from_daily aggregates correctly", { expect_true(all(result$.variable == "observed_ed_visits")) }) -test_that("to_tidy_draws_timeseries combines forecast and observed", { +test_that("augment_timeseries_draws_w_obs combines forecast and observed", { # Create minimal forecast data - 3 forecast dates x 2 draws = 6 rows tidy_forecast <- tibble::tibble( date = rep(as.Date("2024-01-08") + 0:2, each = 2), @@ -160,7 +160,7 @@ test_that("to_tidy_draws_timeseries combines forecast and observed", { .value = 10:16 ) - result <- to_tidy_draws_timeseries( + result <- augment_timeseries_draws_w_obs( tidy_forecast = tidy_forecast, observed = observed )