diff --git a/DESCRIPTION b/DESCRIPTION index e7f9d062..fb8b7495 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -101,7 +101,8 @@ Imports: scales, ggplot2, posterior, - checkmate + checkmate, + zoo Remotes: stan-dev/cmdstanr VignetteBuilder: diff --git a/R/generate_simulated_data.R b/R/generate_simulated_data.R index 1c8b5ad5..e24f0a23 100644 --- a/R/generate_simulated_data.R +++ b/R/generate_simulated_data.R @@ -103,7 +103,7 @@ generate_simulated_data <- function(r_in_weeks = # nolint nt = 9, forecast_horizon = 28, sim_start_date = lubridate::ymd( - "2023-09-01" + "2023-09-03" ), hosp_wday_effect = c( 0.95, 1.01, 1.02, @@ -512,6 +512,11 @@ generate_simulated_data <- function(r_in_weeks = # nolint date_df = date_df ) + weekly_hosp_data <- make_weekly_data( + hosp_data = hosp_data, + day_of_week_to_sum = "Saturday" + ) + hosp_data_eval <- format_hosp_data( pred_obs_hosp = pred_obs_hosp, dur_obs = (ot + ht), @@ -522,6 +527,12 @@ generate_simulated_data <- function(r_in_weeks = # nolint "daily_hosp_admits_for_eval" = "daily_hosp_admits" ) + weekly_hosp_data_eval <- make_weekly_data( + hosp_data = hosp_data_eval, + count_col_name = "daily_hosp_admits_for_eval", + day_of_week_to_sum = "Saturday" + ) + # Make a subpopulation level hospital admissions data # For now this will only be used for evaluation, eventually, can add # feature to use this in calibration @@ -571,6 +582,8 @@ generate_simulated_data <- function(r_in_weeks = # nolint ww_data_eval = ww_data_eval, hosp_data = hosp_data, hosp_data_eval = hosp_data_eval, + weekly_hosp_data = weekly_hosp_data, + weekly_hosp_data_eval = weekly_hosp_data_eval, subpop_hosp_data = subpop_hosp_data, subpop_hosp_data_eval = subpop_hosp_data_eval, true_global_rt = true_rt diff --git a/R/make_weekly_data.R b/R/make_weekly_data.R new file mode 100644 index 00000000..3180527d --- /dev/null +++ b/R/make_weekly_data.R @@ -0,0 +1,38 @@ +#' Make daily data into weekly data +#' This is an internal function used to generate simulated weekly data +#' +#' @param hosp_data A tibble containing daily hospital admissions data, +#' expects the following columns: "date", and whatever is specified in +#' `count_col_name` +#' @param count_col_name A character string indicating the name of the column +#' with the daily counts, default is `"daily_hosp_admits"` +#' @param day_of_week_to_sum A character string indicating what day of the +#' week to assign the past 7 days of hospital admissions to. Must be full +#' weekday name with first letter in uppercase. Default is Saturday +#' +#' @return A dataframe with weekly hospital admissions data, assigned to +#' the day of the week to sum +make_weekly_data <- function(hosp_data, + count_col_name = "daily_hosp_admits", + day_of_week_to_sum = "Saturday") { + hosp_data_w_wday <- hosp_data |> + dplyr::mutate( + day_of_week = lubridate::wday(.data$date, + week_start = 1, + label = TRUE, + abbr = FALSE + ), + day_of_week_numeric = lubridate::wday(.data$date), + weekly_hosp_admits = zoo::rollsum(.data[[count_col_name]], + k = 7, + na.pad = TRUE, + align = "right" + ) + ) |> + dplyr::filter(day_of_week == {{ day_of_week_to_sum }}) + + weekly_hosp_data <- hosp_data_w_wday |> + dplyr::select(date, weekly_hosp_admits, state_pop) + + return(weekly_hosp_data) +} diff --git a/data-raw/vignette_data.R b/data-raw/vignette_data.R index 8f4c2dbd..57e6a10b 100644 --- a/data-raw/vignette_data.R +++ b/data-raw/vignette_data.R @@ -6,12 +6,16 @@ ww_data_eval <- simulated_data$ww_data_eval hosp_data <- hosp_data_from_sim |> dplyr::mutate("location" = "example state") hosp_data_eval <- simulated_data$hosp_data_eval +weekly_hosp_data <- simulated_data$weekly_hosp_data +weekly_hosp_data_eval <- simulated_data$weekly_hosp_data_eval subpop_hosp_data <- simulated_data$subpop_hosp_data subpop_hosp_data_eval <- simulated_data$subpop_hosp_data_eval true_global_rt <- simulated_data$true_global_rt usethis::use_data(hosp_data, overwrite = TRUE) usethis::use_data(hosp_data_eval, overwrite = TRUE) +usethis::use_data(weekly_hosp_data, overwrite = TRUE) +usethis::use_data(weekly_hosp_data_eval, overwrite = TRUE) usethis::use_data(ww_data, overwrite = TRUE) usethis::use_data(ww_data_eval, overwrite = TRUE) usethis::use_data(subpop_hosp_data, overwrite = TRUE) diff --git a/data/hosp_data.rda b/data/hosp_data.rda index 83e0eeb8..42f68449 100644 Binary files a/data/hosp_data.rda and b/data/hosp_data.rda differ diff --git a/data/hosp_data_eval.rda b/data/hosp_data_eval.rda index 4ec7bf76..d6bfcd5c 100644 Binary files a/data/hosp_data_eval.rda and b/data/hosp_data_eval.rda differ diff --git a/data/subpop_hosp_data.rda b/data/subpop_hosp_data.rda index 29de9168..d9bcd93a 100644 Binary files a/data/subpop_hosp_data.rda and b/data/subpop_hosp_data.rda differ diff --git a/data/subpop_hosp_data_eval.rda b/data/subpop_hosp_data_eval.rda index 66dda2dd..c00d8607 100644 Binary files a/data/subpop_hosp_data_eval.rda and b/data/subpop_hosp_data_eval.rda differ diff --git a/data/true_global_rt.rda b/data/true_global_rt.rda index c1a6d882..822d299d 100644 Binary files a/data/true_global_rt.rda and b/data/true_global_rt.rda differ diff --git a/data/weekly_hosp_data.rda b/data/weekly_hosp_data.rda new file mode 100644 index 00000000..f66ce06e Binary files /dev/null and b/data/weekly_hosp_data.rda differ diff --git a/data/weekly_hosp_data_eval.rda b/data/weekly_hosp_data_eval.rda new file mode 100644 index 00000000..05e7cd42 Binary files /dev/null and b/data/weekly_hosp_data_eval.rda differ diff --git a/data/ww_data.rda b/data/ww_data.rda index c58ab9dd..7dbaf040 100644 Binary files a/data/ww_data.rda and b/data/ww_data.rda differ diff --git a/data/ww_data_eval.rda b/data/ww_data_eval.rda index 176a52b4..b611934c 100644 Binary files a/data/ww_data_eval.rda and b/data/ww_data_eval.rda differ diff --git a/man/generate_simulated_data.Rd b/man/generate_simulated_data.Rd index da353779..7d8c47bf 100644 --- a/man/generate_simulated_data.Rd +++ b/man/generate_simulated_data.Rd @@ -14,7 +14,7 @@ generate_simulated_data( ot = 90, nt = 9, forecast_horizon = 28, - sim_start_date = lubridate::ymd("2023-09-01"), + sim_start_date = lubridate::ymd("2023-09-03"), hosp_wday_effect = c(0.95, 1.01, 1.02, 1.02, 1.01, 1, 0.99)/7, i0_over_n = 5e-04, initial_growth = 1e-04, diff --git a/man/make_weekly_data.Rd b/man/make_weekly_data.Rd new file mode 100644 index 00000000..b1be6fd2 --- /dev/null +++ b/man/make_weekly_data.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/make_weekly_data.R +\name{make_weekly_data} +\alias{make_weekly_data} +\title{Make daily data into weekly data +This is an internal function used to generate simulated weekly data} +\usage{ +make_weekly_data(hosp_data, day_of_week_to_sum = "Saturday") +} +\arguments{ +\item{hosp_data}{A tibble containing daily hospital admissions data, +expects the following columns: "date", "daily_hosp_admits"} + +\item{day_of_week_to_sum}{A character string indicating what day of the +week to assign the past 7 days of hospital admissions to. Must be full +weekday name with first letter in uppercase} +} +\description{ +Make daily data into weekly data +This is an internal function used to generate simulated weekly data +} diff --git a/scratch/sim_data_script.R b/scratch/sim_data_script.R index 337ec169..88e79fa4 100644 --- a/scratch/sim_data_script.R +++ b/scratch/sim_data_script.R @@ -17,7 +17,7 @@ lab <- c(1, 2, 3, 3, 3) ot <- 90 nt <- 9 forecast_horizon <- 28 -sim_start_date <- lubridate::ymd("2023-09-01") +sim_start_date <- lubridate::ymd("2023-09-03") hosp_wday_effect <- c( 0.95, 1.01, 1.02, 1.02, 1.01, 1,