From 9e396234609f6160bba99d3042ac36b268948c92 Mon Sep 17 00:00:00 2001 From: "George G. Vega Yon" Date: Fri, 30 Aug 2024 05:35:01 -0600 Subject: [PATCH 01/46] Adding class and methods for wwinference model fit (#58) * Starting off refactoring (expected to fail) [skip ci] * Adding new method * Fixing bug in fit_model (was exploiting scoping) * Updating docs (fixing S3 methods) * 49 output class creation (#59) * add a space * add first test of first check * add tests for all of the check/assert functions * run precommit * check bug in passing output of checkmate to cliabort * initial tests of preprocess_ww_data * add custum utils function for autoescaping brackets to pass to glue * add a bunch of tests for preprocessing wastewater data * add one more test of site lab indexing * fix bugs caught in CI * fix lab site spacing * fix spacing in name again * add test to hospital admissions preprocessing * add additional test to ensure character to indexing of sites and labs * remove bug in expected number of unique lab site indices * add tests to make sure data is daily and test to checkers * add a bunch of validation checks to the joint datasets and the user specifications * replace with new way of getting stan data * fix examples, add test, add warning * fix examples, add test, add warning * change from hosp -> count everywhere except stan and vignette/examples * add tests for pmfs * fix bugs in documentation * add padding value as a function arg * change pmf size check to a warning not an error * fix bug * make initialization function more generic * update changelog * modify to test * fix typo from merge * fix parsing of cmdstan object * change parsing of fit obj * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * some tweaks to checkers * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * fix documentation * fix typo * fix typo * change outputs from wwinference() function * fix typos, add documentation * fix bug missing stan args * exclude t columns in data join * fix vignette bug * add the ww_output documentation * document ... * fix missing comma * move documentation of params around * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * Update R/checkers.R Co-authored-by: Dylan H. Morris * change syntax and filenames * Update R/preprocessing.R Co-authored-by: Dylan H. Morris * Update R/wwinference.R Co-authored-by: Dylan H. Morris * Update R/wwinference.R Co-authored-by: Dylan H. Morris * change naming and internal checking * change syntax * move around documentation * fix check * fix tests, fix documentation * rename assert function to specify within a certain frame * add element to text * fix bug in function name * tweak to inference function * fix two bugs * adjust tests based on updated get stan data function which breaks up generation of input data * Update get_stan_data.R example * update documentation after fixing example * add example to wwinference wrapper function * attempt to move around documentation for wwinference methods * play around with the documentation of the default and the S3 method functions * export S3 method function * add back in exporting functions to get input data formatted for stan * make first argument of function have same name as class object * fix bug in how max generation time is found * update vignette to explain wwinference_fit class object vs explicit function calling, add diagnostics and show both ways * fix naming blocks adding comma when needed * dont export autoescape brackets function * fix same bug * update test and preprocessing to count at LOD values at below LOD * fix internal call to diagnostic flags function * Update R/validate.R Co-authored-by: Dylan H. Morris * Update tests/testthat/test_preprocess_count_data.R Co-authored-by: Dylan H. Morris * implement DMs suggestions * run pre-commit * export default functions * Add test-coverage.yaml from epinowcast * remove test coverage * remove example, function not exported * export default function * export both diagnostics functions * add documentation of additional arguments * Update R/validate.R Co-authored-by: Dylan H. Morris * Update R/validate.R Co-authored-by: Dylan H. Morris * Update R/validate.R Co-authored-by: Dylan H. Morris * Update tests/testthat/test_checkers.R Co-authored-by: Dylan H. Morris * Update tests/testthat/test_checkers.R Co-authored-by: Dylan H. Morris * Update tests/testthat/test_preprocess_count_data.R Co-authored-by: Dylan H. Morris * Update tests/testthat/test_preprocess_ww_data.R Co-authored-by: Dylan H. Morris * Update R/validate.R Co-authored-by: Dylan H. Morris * manually input some suggestions * Update tests/testthat/test_checkers.R Co-authored-by: Dylan H. Morris * Update tests/testthat/test_checkers.R Co-authored-by: Dylan H. Morris * Update tests/testthat/test_preprocess_count_data.R Co-authored-by: Dylan H. Morris * Update tests/testthat/test_preprocess_count_data.R Co-authored-by: Dylan H. Morris * Update tests/testthat/test_preprocess_count_data.R Co-authored-by: Dylan H. Morris * add more checknames * run pre-commit locally * fix typo * add some very minimal tests * fix wwinference function * fix bug * fix bug * Update tests/testthat/test_preprocess_count_data.R Co-authored-by: Dylan H. Morris * Update tests/testthat/test_preprocess_count_data.R Co-authored-by: Dylan H. Morris * run pre-commit locally * fix bugs in tests * fix error in tests * move forecast date, calib time, horizon time to args to wrapper function * fix hosp only example in vignette * fix error in example * add dont run to examples * check -> expect in checkmate, confirm tests pass locally --------- Co-authored-by: Dylan H. Morris Co-authored-by: George G. Vega Yon * Making pre-commit happy * Reworking cross-references and print method * Removing copy of fit_model * Fixing function call * Addressing PR comments * Forgot to save some changes * Change output names (#86) * change names of outputs of wwinference wrapper function * fix a few other missed replacements * fix pre-commit * Fixing R CMD check * Pre-commit * Removing diagnostics_summary --------- Co-authored-by: George G. Vega Yon * Update vignettes/wwinference.Rmd Co-authored-by: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> * Update vignettes/wwinference.Rmd Co-authored-by: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> * Adding example of summary and print in the vignette. Addressing some minor comments * fix test for expected names after changing function args * set seed in tests --------- Co-authored-by: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Co-authored-by: Dylan H. Morris Co-authored-by: kaitejohnson --- NAMESPACE | 8 + NEWS.md | 2 + R/generate_simulated_data.R | 2 + R/get_draws_df.R | 117 +++++++-- R/get_stan_data.R | 8 +- R/model_diagnostics.R | 73 ++++-- R/wwinference.R | 299 +++++++++++++++-------- man/generate_simulated_data.Rd | 2 + man/get_draws_df.Rd | 47 ++-- man/get_model_diagnostic_flags.Rd | 35 ++- man/get_stan_data.Rd | 2 +- man/parameter_diagnostics.Rd | 24 ++ man/wwinference.Rd | 131 ++++++++-- tests/testthat/test_get_stan_data.R | 2 + tests/testthat/test_preprocess_ww_data.R | 2 +- tests/testthat/test_wwinference.R | 79 ++++++ vignettes/wwinference.Rmd | 209 +++++++++++----- 17 files changed, 795 insertions(+), 247 deletions(-) create mode 100644 man/parameter_diagnostics.Rd create mode 100644 tests/testthat/test_wwinference.R diff --git a/NAMESPACE b/NAMESPACE index 54b822a1..060fd288 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,12 @@ # Generated by roxygen2: do not edit by hand +S3method(get_draws_df,data.frame) +S3method(get_draws_df,default) +S3method(get_draws_df,wwinference_fit) +S3method(get_model_diagnostic_flags,default) +S3method(get_model_diagnostic_flags,wwinference_fit) +S3method(print,wwinference_fit) +S3method(summary,wwinference_fit) export(add_pmfs) export(add_time_indexing) export(calc_rt) @@ -30,6 +37,7 @@ export(get_ww_data_indices) export(get_ww_data_sizes) export(get_ww_values) export(indicate_ww_exclusions) +export(parameter_diagnostics) export(preprocess_count_data) export(preprocess_ww_data) export(to_simplex) diff --git a/NEWS.md b/NEWS.md index 83655594..55500fe1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,11 @@ # wwinference This will serve as our change-log + - 2024-07-12: Add functionality to fit the wastewater-informed model to an example fitting COVID-19 hospital admissions and wastewater from a few sites - 2024-07-19: Add an example in the vignette to fit the model to only the hospital admissions. Plus a few small tweaks to the vignette. - 2024-08-05: Add input data validation with informative error messaging - 2024-08-09: Add testing and additional validation of the data being passed into the model - 2024-08-22: Update `generate_simulated_data()` function to modularize the model components, adding additional forward simulation functions. +- 2024-08-23: Added new `wwinference_fit` class with corresponding print and summary methods. diff --git a/R/generate_simulated_data.R b/R/generate_simulated_data.R index 1bd9193c..f7301aef 100644 --- a/R/generate_simulated_data.R +++ b/R/generate_simulated_data.R @@ -73,6 +73,7 @@ #' @export #' #' @examples +#' \dontrun{ #' # Generate a simulated dataset from a hypothetical state with 6 sites and 2 #' # different labs #' sim_data <- generate_simulated_data( @@ -84,6 +85,7 @@ #' ) #' hosp_data <- sim_data$hosp_data #' ww_data <- sim_data$ww_data +#' } generate_simulated_data <- function(r_in_weeks = # nolint c( rep(1.1, 5), rep(0.9, 5), diff --git a/R/get_draws_df.R b/R/get_draws_df.R index 05559302..9db33ac1 100644 --- a/R/get_draws_df.R +++ b/R/get_draws_df.R @@ -5,23 +5,21 @@ #' and the 3 relevant mappings from stan indices to the real data, in order #' to generate a dataframe containing the posterior draws of the counts (e.g. #' hospital admissions), the wastewater concentration values, the "global" R(t), -#' and the "local" R(t) estimates + the critical metadata in the data +#' and the "local" R(t) estimates + the critical metadata in the data. +#' This funtion has a default method that takes the two sets of input data, +#' the last of stan arguments, and the CmdStan fitting object, as well as an S3 +#' method for objects of class 'wwinference_fit' #' #' -#' @param ww_data A dataframe of the preprocessed wastewater concentration data -#' used to fit the model +#' @param x Either a dataframe of wastewater observations, or an object of +#' class wwinference_fit #' @param count_data A dataframe of the preprocessed daily count data (e.g. #' hospital admissions) from the "global" population +#' @param stan_data_list A list containing all the data passed to stan for +#' fitting the model #' @param fit_obj a CmdStan object that is the output of fitting the model to -#' the `ww_data` and `count_data` -#' @param date_time_spine A tibble mapping the time index in stan (observed + -#' nowcast + forecast) to real dates -#' @param lab_site_spine A tibble mapping the site-lab index in stan to the -#' corresponding site, lab, and site population -#' @param subpop_spine A tibble mapping the site index in stan to the -#' corresponding subpopulation (either a site or the auxiliary site we add to -#' represent the rest of the population) -#' +#' `x` and `count_data` +#' @param ... additional arguments #' @return A tibble containing the full set of posterior draws of the #' estimated, nowcasted, and forecasted: counts, site-level wastewater #' concentrations, "global"(e.g. state) R(t) estimate, and the "local" (site + @@ -29,14 +27,73 @@ #' are observations, the data will be joined to each draw of the predicted #' observation to facilitate plotting. #' @export -get_draws_df <- function(ww_data, - count_data, - fit_obj, - date_time_spine, - lab_site_spine, - subpop_spine) { +get_draws_df <- function(x, ...) { + UseMethod("get_draws_df") +} + +#' S3 method for extracting posterior draws alongside data for a +#' wwinference_fit object +#' +#' This method overloads the generic get_draws_df function specifically +#' for objects of type 'wwinference_fit'. +#' +#' @rdname get_draws_df +#' @export +get_draws_df.wwinference_fit <- function(x, ...) { + get_draws_df.data.frame( + x = x$raw_input_data$input_ww_data, + count_data = x$raw_input_data$input_count_data, + stan_data_list = x$stan_data_list, + fit_obj = x$fit + ) +} + +#' @export +#' @rdname get_draws_df +get_draws_df.default <- function(x, ...) { + stop( + "No method defined for get_draws_df for object of class(es) ", + paste(class(x), collapse = ", "), + ". Use directly on a wwinference_fit object or a", + "dataframe of wastewater observations.", + call. = FALSE + ) +} + +#' @rdname get_draws_df +#' @export +get_draws_df.data.frame <- function(x, + count_data, + stan_data_list, + fit_obj, + ...) { draws <- fit_obj$result$draws() + # Get the necessary mappings needed to join draws to data + date_time_spine <- tibble::tibble( + date = seq( + from = min(count_data$date), + to = min(count_data$date) + stan_data_list$ot + stan_data_list$ht, + by = "days" + ) + ) |> + dplyr::mutate(t = row_number()) + # Lab-site index to corresponding lab, site, and site population size + lab_site_spine <- x |> + dplyr::distinct(site, lab, lab_site_index, site_pop) + # Site index to corresponding site and subpopulation size + subpop_spine <- x |> + dplyr::distinct(site, site_index, site_pop) |> + dplyr::mutate(site = as.factor(site)) |> + dplyr::bind_rows(tibble::tibble( + site = "remainder of pop", + site_index = max(x$site_index) + 1, + site_pop = stan_data_list$subpop_size[ + length(unique(stan_data_list$subpop_size)) + ] + )) + + count_draws <- draws |> tidybayes::spread_draws(pred_hosp[t]) |> dplyr::rename(pred_value = pred_hosp) |> @@ -46,7 +103,11 @@ get_draws_df <- function(ww_data, ) |> dplyr::select(name, t, pred_value, draw) |> dplyr::left_join(date_time_spine, by = "t") |> - dplyr::left_join(count_data, by = "date") |> + dplyr::left_join( + count_data |> + dplyr::select(-t), + by = "date" + ) |> dplyr::ungroup() |> dplyr::rename(observed_value = count) |> dplyr::mutate( @@ -74,10 +135,14 @@ get_draws_df <- function(ww_data, dplyr::select(name, lab_site_index, t, pred_value, draw) |> dplyr::left_join(date_time_spine, by = "t") |> dplyr::left_join(lab_site_spine, by = "lab_site_index") |> - dplyr::left_join(ww_data, by = c( - "lab_site_index", "date", - "lab", "site", "site_pop" - )) |> + dplyr::left_join( + x |> + dplyr::select(-t), + by = c( + "lab_site_index", "date", + "lab", "site", "site_pop" + ) + ) |> dplyr::ungroup() |> dplyr::mutate(observed_value = genome_copies_per_ml) |> dplyr::mutate( @@ -97,7 +162,11 @@ get_draws_df <- function(ww_data, ) |> dplyr::select(name, t, pred_value, draw) |> dplyr::left_join(date_time_spine, by = "t") |> - dplyr::left_join(count_data, by = "date") |> + dplyr::left_join( + count_data |> + dplyr::select(-t), + by = "date" + ) |> dplyr::ungroup() |> dplyr::rename(observed_value = count) |> dplyr::mutate( diff --git a/R/get_stan_data.R b/R/get_stan_data.R index 86d4e354..0d51e9e4 100644 --- a/R/get_stan_data.R +++ b/R/get_stan_data.R @@ -189,7 +189,7 @@ get_input_ww_data_for_stan <- function(preprocessed_ww_data, #' last_count_data_date, #' calibration_time #' ) -#' stan_args <- get_stan_data( +#' stan_data_list <- get_stan_data( #' input_count_data_for_stan, #' input_ww_data_for_stan, #' forecast_date, @@ -354,8 +354,8 @@ get_stan_data <- function(input_count_data, inf_to_count_delay_max <- length(inf_to_count_delay) - stan_args <- list( - gt_max = params$gt_max, + stan_data_list <- list( + gt_max = min(length(generation_interval), params$gt_max), hosp_delay_max = inf_to_count_delay_max, inf_to_hosp = inf_to_count_delay, mwpd = params$ml_of_ww_per_person_day, @@ -434,7 +434,7 @@ get_stan_data <- function(input_count_data, ) - return(stan_args) + return(stan_data_list) } #' Get the integer sizes of the wastewater input data diff --git a/R/model_diagnostics.R b/R/model_diagnostics.R index e29ab0db..1f71b366 100644 --- a/R/model_diagnostics.R +++ b/R/model_diagnostics.R @@ -1,14 +1,17 @@ -#' Get diagnostic flags +#' Get a table of diagnostic flags #' #' @description #' This function takes in the output from a cmdstanr$sample() function (the #' fit object) and a series of diagnostic tolerances and returns #' a dataframe containing flags for whether any of the diagnostic thresholds #' were exceeded, which would indicate that the model did not properly -#' converge +#' converge. This funtion has a default method that takes +#' the CmdStan fitting object, as well as an S3 method for objects of class +#' 'wwinference_fit' #' #' -#' @param stan_fit_object The R6 Cmdstan Object fit object +#' @param x Either an object of the 'wwinference_fit' class or +#' the R6 Cmdstan Object fit object #' @param ebmfi_tolerance float indicating the tolerance for EBMFI #' (estimated bayesian fraction of missing information), default is `0.2` #' @param divergences_tolerance float indicating the tolerance for the @@ -18,24 +21,46 @@ #' @param rhat_tolerance float indicating the tolerance for the rhat for #' individual parameters, default is `1.05` #' @param max_tree_depth_tol float indicating the tolerance for the proportion -#' of iterations that exceed the maximum tree depth, default is `0.01` +#' of iterations that exceed the maximum tree depth, default is `0.01`, +#' @param ... additional arguments #' +#' @family diagnostics #' @return flag_df: dataframe containing columns for each of the flags, #' if any flags are TRUE that indicates some model issue #' @export +get_model_diagnostic_flags <- function(x, ...) { + UseMethod("get_model_diagnostic_flags") +} + +#' S3 method for getting a table of diagnostic flags fpr a wwinference_fit +#' object #' -get_model_diagnostic_flags <- function(stan_fit_object, - ebmfi_tolerance = 0.2, - divergences_tolerance = 0.01, - frac_high_rhat_tolerance = 0.05, - rhat_tolerance = 1.05, - max_tree_depth_tol = 0.01) { - n_chains <- stan_fit_object$num_chains() - iter_sampling <- stan_fit_object$metadata()$iter_sampling +#' This method overloads the generic get_model_diagnostic_flags function +#' specifically for objects of type 'wwinference_fit'. +#' +#' @rdname get_model_diagnostic_flags +#' @export +get_model_diagnostic_flags.wwinference_fit <- function(x, ...) { + get_model_diagnostic_flags.default( + x = x$fit$result + ) +} + +#' @rdname get_model_diagnostic_flags +#' @export +get_model_diagnostic_flags.default <- function(x, + ebmfi_tolerance = 0.2, + divergences_tolerance = 0.01, + frac_high_rhat_tolerance = 0.05, + rhat_tolerance = 1.05, + max_tree_depth_tol = 0.01, + ...) { + n_chains <- x$num_chains() + iter_sampling <- x$metadata()$iter_sampling # Summary is a large dataframe with diagnostics for each parameters - summary <- stan_fit_object$summary() - diagnostic_summary <- stan_fit_object$diagnostic_summary(quiet = TRUE) + summary <- x$summary() + diagnostic_summary <- x$diagnostic_summary(quiet = TRUE) flag_low_embfi <- mean(diagnostic_summary$ebfmi) <= ebmfi_tolerance max_n_divergences <- n_chains * iter_sampling * divergences_tolerance @@ -57,5 +82,25 @@ get_model_diagnostic_flags <- function(stan_fit_object, flag_high_rhat, flag_low_embfi ) + + # Message if a flag doesn't pass. Still return + # the same data, but we want user to know the issue + if (any(flag_df[1, ])) { + warning("Model flagged for convergence issues, run model diagnostics + on the output stanfit object for more information") + } return(flag_df) } + + +#' Method for printing the CmdStan parameter diagnostics for a +#' wwinference_fit_object +#' +#' @param ww_fit An object of class wwinference_fit +#' @param ... additional arguments +#' +#' @family diagnostics +#' @export +parameter_diagnostics <- function(ww_fit, ...) { + ww_fit$fit$result$diagnostic_summary(quiet = TRUE) +} diff --git a/R/wwinference.R b/R/wwinference.R index 63cf3d7e..a69dc144 100644 --- a/R/wwinference.R +++ b/R/wwinference.R @@ -31,8 +31,8 @@ #' `get_model_spec()`. The default here pertains to the `forecast_date` in the #' example data provided by the package, but this should be specified by the #' user based on the date they are producing a forecast -#' @param mcmc_options The MCMC parameters as defined using -#' `get_mcmc_options()`. +#' @param fit_opts The fit options, which in this case default to the +#' MCMC parameters as defined using `get_mcmc_options()`. #' @param generate_initial_values Boolean indicating whether or not to specify #' the initialization of the sampler, default is `TRUE`, meaning that #' initialization lists will be generated and passed as the `init` argument @@ -41,38 +41,109 @@ #' @param compiled_model The pre-compiled model as defined using #' `compile_model()` #' -#' @return A nested list of the following items, intended to allow the user to -#' quickly and easily plot results from their inference, while also being able -#' to have the full user functionality of running the model themselves in stan -#' by providing the raw model object and diagnostics. If the model runs, this +#' @return An object of the `ww_inference_fit` class containing the following +#' items that are intended to be passed to downstream functions to do things +#' like extract posterior draws, get diangostic behavior, and plot results +#' (for example). If the model runs, this #' function will return: -#' `draws_df`: A tibble containing the full set of posterior draws of the -#' estimated, nowcasted, and forecasted: counts, site-level wastewater -#' concentrations, "global"(e.g. state) R(t) estimate, and the "local" (site + -#' the one auxiliary subpopulation) R(t) estimates. In the instance where there -#' are observations, the data will be joined to each draw of the predicted -#' observation to facilitate plotting. -#' `raw_fit_obj`: The CmdStan object that is returned from the call to +#' `fit`: The CmdStan object that is returned from the call to #' `cmdstanr::sample()`. Can be used to access draws, summary, diagnostics, etc. -#' `date_time_spine`: Mapping from time in stan to dates -#' `lab_site_spine`: Mapping from lab_site_index in stan to lab and site -#' `subpop_spine`: Mapping from site index in stan to site +#' `raw_input_data`: a list containing the input `ww_data` and the input +#' `count_data` used in the model. +#' `stan_data_list`: a list containing the inputs passed directly to the +#' stan model +#' `fit_opts`: a list of the MCMC specifications passed to stan #' #' If the model fails to run, a list containing the follow will be returned: #' `error`: the error message provided from stan, indicating why the model #' failed to run. Note, the model might still run and produce draws even if it #' has major model issues. We recommend the user always run the -#' `check_diagnostics()` function on the `diagnostic_summary` as part of any +#' `check_diagnostics()` function on the `parameter_diagnostics` as part of any #' pipeline to ensure model convergence. +#' @name wwinference +#' @family diagnostics +#' #' @export +#' @examples +#' \dontrun{ +#' ww_data <- tibble::tibble( +#' date = rep(seq( +#' from = lubridate::ymd("2023-08-01"), +#' to = lubridate::ymd("2023-11-01"), +#' by = "weeks" +#' ), 2), +#' site = c(rep(1, 14), rep(2, 14)), +#' lab = c(rep(1, 28)), +#' conc = abs(rnorm(28, mean = 500, sd = 50)), +#' lod = c(rep(20, 14), rep(15, 14)), +#' site_pop = c(rep(2e5, 14), rep(4e5, 14)) +#' ) +#' +#' ww_data_preprocessed <- preprocess_ww_data(ww_data, +#' conc_col_name = "conc", +#' lod_col_name = "lod" +#' ) +#' input_ww_data <- indicate_ww_exclusions(ww_data_preprocessed) +#' +#' hosp_data <- tibble::tibble( +#' date = seq( +#' from = lubridate::ymd("2023-07-01"), +#' to = lubridate::ymd("2023-10-30"), +#' by = "days" +#' ), +#' daily_admits = sample(5:70, 122, replace = TRUE), +#' state_pop = rep(1e6, 122) +#' ) +#' +#' input_count_data <- preprocess_count_data( +#' hosp_data, +#' "daily_admits", +#' "state_pop" +#' ) #' +#' generation_interval <- to_simplex(c(0.01, 0.2, 0.3, 0.2, 0.1, 0.1, 0.01)) +#' inf_to_count_delay <- to_simplex(c( +#' rep(0.01, 12), rep(0.2, 4), +#' rep(0.01, 10) +#' )) +#' infection_feedback_pmf <- generation_interval +#' +#' params <- get_params( +#' system.file("extdata", "example_params.toml", +#' package = "wwinference" +#' ) +#' ) +#' forecast_date <- "2023-11-06" +#' calibration_time <- 90 +#' forecast_horizon <- 28 +#' include_ww <- 1 +#' ww_fit <- wwinference(input_ww_data, +#' input_count_data, +#' model_spec = get_model_spec( +#' forecast_date = forecast_date, +#' calibration_time = calibration_time, +#' forecast_horizon = forecast_horizon, +#' generation_interval = generation_interval, +#' inf_to_count_delay = inf_to_coutn_delay, +#' infection_feedback_pmf = infection_feedback_pmf, +#' params = params +#' ), +#' fit_opts = get_mcmc_options( +#' iter_warmup = 250, +#' iter_sampling = 250, +#' n_chains = 2 +#' ) +#' ) +#' } +#' @rdname wwinference +#' @aliases wwinference_fit wwinference <- function(ww_data, count_data, forecast_date = NULL, calibration_time = 90, forecast_horizon = 28, model_spec = get_model_spec(), - mcmc_options = get_mcmc_options(), + fit_opts = get_mcmc_options(), generate_initial_values = TRUE, compiled_model = compile_model()) { if (is.null(forecast_date)) { @@ -97,13 +168,13 @@ wwinference <- function(ww_data, last_count_data_date, calibration_time ) - input_data <- list( + raw_input_data <- list( input_count_data = input_count_data, input_ww_data = input_ww_data ) # If checks pass, create stan data object - stan_args <- get_stan_data( + stan_data_list <- get_stan_data( input_count_data = input_count_data, input_ww_data = input_ww_data, forecast_date = forecast_date, @@ -120,94 +191,33 @@ wwinference <- function(ww_data, init_lists <- NULL if (generate_initial_values) { init_lists <- c() - for (i in 1:mcmc_options$n_chains) { - init_lists[[i]] <- get_inits_for_one_chain(stan_args, params) + for (i in 1:fit_opts$n_chains) { + init_lists[[i]] <- get_inits_for_one_chain(stan_data_list, params) } } - - fit_model <- function(compiled_model, - stan_args, - model_spec, - init_lists) { - fit <- compiled_model$sample( - data = stan_args, - init = init_lists, - seed = mcmc_options$seed, - iter_sampling = mcmc_options$iter_sampling, - iter_warmup = mcmc_options$iter_warmup, - max_treedepth = mcmc_options$max_treedepth, - chains = mcmc_options$n_chains, - parallel_chains = mcmc_options$n_chains - ) - - return(fit) - } - # This returns the cmdstan object if the model runs, and result = NULL if # the model errors safe_fit_model <- purrr::safely(fit_model) fit <- safe_fit_model( - compiled_model, - stan_args, - model_spec, - init_lists + compiled_model = compiled_model, + stan_data_list = stan_data_list, + fit_opts = fit_opts, + init_lists = init_lists ) - if (!is.null(fit$error)) { # If the model errors, return a list with the - # error and everything else NULL - out <- list( - error = fit$error[[1]] - ) - message(fit$error[[1]]) - } else { - # This is a bit messy, but get the spines needed to map stan data to - # the real data - # Time index to date - date_time_spine <- tibble::tibble( - date = seq( - from = min(count_data$date), - to = min(count_data$date) + stan_args$ot + stan_args$ht, - by = "days" - ) - ) |> - dplyr::mutate(t = row_number()) - # Lab-site index to corresponding lab, site, and site population size - lab_site_spine <- ww_data |> - dplyr::distinct(site, lab, lab_site_index, site_pop) - # Site index to corresponding site and subpopulation size - subpop_spine <- ww_data |> - dplyr::distinct(site, site_index, site_pop) |> - dplyr::mutate(site = as.factor(site)) |> - dplyr::bind_rows(tibble::tibble( - site = "remainder of pop", - site_index = max(ww_data$site_index) + 1, - site_pop = stan_args$subpop_size[ - length(unique(stan_args$subpop_size)) - ] - )) + if (!is.null(fit$error)) { # If the model errors, return the error message - draws <- get_draws_df( - ww_data = ww_data, - count_data = count_data, - fit_obj = fit, - date_time_spine = date_time_spine, - lab_site_spine = lab_site_spine, - subpop_spine = subpop_spine - ) - summary_diagnostics <- fit$result$diagnostic_summary() - convergence_flag_df <- get_model_diagnostic_flags( - stan_fit_object = - fit$result - ) + return(fit$error) + } else { + convergence_flag_df <- get_model_diagnostic_flags(fit$result) out <- list( - draws_df = draws, - raw_fit_obj = fit$result, - date_time_spine = date_time_spine, - lab_site_spine = lab_site_spine, - subpop_spine = subpop_spine + fit = fit, + raw_input_data = raw_input_data, + stan_data_list = stan_data_list, + fit_opts = fit_opts ) # Message if a flag doesn't pass. Still return @@ -218,9 +228,106 @@ wwinference <- function(ww_data, } } - return(out) + # Constructs the wwinference_fit class object + do.call(new_wwinference_fit, out) } +#' Constructor for the `wwinference_fit` class +#' @param fit The CmdStan object that is the output of fitting the model +#' @param raw_input_data A list containing all the data passed to stan +#' for fitting the model +#' @param stan_data_list A list containing the inputs passed directly to the +#' stan model +#' @param fit_opts A list of the the fitting options, in this case the +#' MCMC specifications passed to stan +#' @return An object of the `wwinference_fit` class. +#' @noRd +#' +new_wwinference_fit <- function( + fit, + raw_input_data, + stan_data_list, + fit_opts) { + # Checking + stopifnot( + inherits(fit$result, what = "CmdStanFit"), + inherits(raw_input_data, "list"), + inherits(stan_data_list, "list"), + inherits(fit_opts, "list") + ) + + structure( + list( + fit = fit, + raw_input_data = raw_input_data, + stan_data_list = stan_data_list, + fit_opts = fit_opts + ), + class = "wwinference_fit" + ) +} + +#' @param x,object Object of class `wwinference_fit` +#' @param ... Additional parameters passed to the corresponding method +#' @export +#' @rdname wwinference +#' @return +#' - The print method prints out information about the model and +#' returns the object invisibly. +print.wwinference_fit <- function(x, ...) { + cat("wwinference_fit object\n") + cat("N of WW sites :", x$stan_data_list$n_ww_sites, "\n") + cat("N of unique lab-site pairs :", x$stan_data_list$n_ww_lab_sites, "\n") + cat("State population :", formatC( + x$stan_data_list$state_pop, + format = "d" + ), "\n") + cat("N of weeks :", x$stan_data_list$n_weeks, "\n") + cat("--------------------\n") + cat("For more details, you can access the following:\n") + cat(" - `$fit` for the CmdStan object\n") + cat(" - `$raw_input_data` for the input data\n") + cat(" - `$stan_data_list` for the stan data arguments\n") + cat(" - `$fit_opts` for the fitting options\n") + invisible(x) +} + +#' @export +#' @rdname wwinference +#' @return +#' - The summary method returns the outcome from the +#' `$summary` ([cmdstanr::summary()]) function. +summary.wwinference_fit <- function(object, ...) { + object$fit$result$summary(...) +} + + +#' Model fitting function +#' @param compiled_model The compiled model object +#' @param stan_data_list The list of data to pass to stan +#' @param fit_opts The fitting specifications +#' @param init_lists A list of initial values for the sampler +#' @return The fit object from the model +#' @noRd +fit_model <- function(compiled_model, + stan_data_list, + fit_opts, + init_lists) { + fit <- compiled_model$sample( + data = stan_data_list, + init = init_lists, + seed = fit_opts$seed, + iter_sampling = fit_opts$iter_sampling, + iter_warmup = fit_opts$iter_warmup, + max_treedepth = fit_opts$max_treedepth, + chains = fit_opts$n_chains, + parallel_chains = fit_opts$n_chains + ) + + return(fit) +} + + #' Get MCMC options #' #' @description diff --git a/man/generate_simulated_data.Rd b/man/generate_simulated_data.Rd index a620431d..ecee6d53 100644 --- a/man/generate_simulated_data.Rd +++ b/man/generate_simulated_data.Rd @@ -134,6 +134,7 @@ wastewater data directly from the generative model, specifying the conditions and parameters to generate from. } \examples{ +\dontrun{ # Generate a simulated dataset from a hypothetical state with 6 sites and 2 # different labs sim_data <- generate_simulated_data( @@ -146,3 +147,4 @@ sim_data <- generate_simulated_data( hosp_data <- sim_data$hosp_data ww_data <- sim_data$ww_data } +} diff --git a/man/get_draws_df.Rd b/man/get_draws_df.Rd index 8ee86097..ee6ec13a 100644 --- a/man/get_draws_df.Rd +++ b/man/get_draws_df.Rd @@ -2,36 +2,33 @@ % Please edit documentation in R/get_draws_df.R \name{get_draws_df} \alias{get_draws_df} +\alias{get_draws_df.wwinference_fit} +\alias{get_draws_df.default} +\alias{get_draws_df.data.frame} \title{Postprocess to generate a draws dataframe} \usage{ -get_draws_df( - ww_data, - count_data, - fit_obj, - date_time_spine, - lab_site_spine, - subpop_spine -) +get_draws_df(x, ...) + +\method{get_draws_df}{wwinference_fit}(x, ...) + +\method{get_draws_df}{default}(x, ...) + +\method{get_draws_df}{data.frame}(x, count_data, stan_data_list, fit_obj, ...) } \arguments{ -\item{ww_data}{A dataframe of the preprocessed wastewater concentration data -used to fit the model} +\item{x}{Either a dataframe of wastewater observations, or an object of +class wwinference_fit} + +\item{...}{additional arguments} \item{count_data}{A dataframe of the preprocessed daily count data (e.g. hospital admissions) from the "global" population} -\item{fit_obj}{a CmdStan object that is the output of fitting the model to -the \code{ww_data} and \code{count_data}} +\item{stan_data_list}{A list containing all the data passed to stan for +fitting the model} -\item{date_time_spine}{A tibble mapping the time index in stan (observed + -nowcast + forecast) to real dates} - -\item{lab_site_spine}{A tibble mapping the site-lab index in stan to the -corresponding site, lab, and site population} - -\item{subpop_spine}{A tibble mapping the site index in stan to the -corresponding subpopulation (either a site or the auxiliary site we add to -represent the rest of the population)} +\item{fit_obj}{a CmdStan object that is the output of fitting the model to +\code{x} and \code{count_data}} } \value{ A tibble containing the full set of posterior draws of the @@ -46,5 +43,11 @@ This function takes in the two input data sources, the CmdStan fit object, and the 3 relevant mappings from stan indices to the real data, in order to generate a dataframe containing the posterior draws of the counts (e.g. hospital admissions), the wastewater concentration values, the "global" R(t), -and the "local" R(t) estimates + the critical metadata in the data +and the "local" R(t) estimates + the critical metadata in the data. +This funtion has a default method that takes the two sets of input data, +the last of stan arguments, and the CmdStan fitting object, as well as an S3 +method for objects of class 'wwinference_fit' + +This method overloads the generic get_draws_df function specifically +for objects of type 'wwinference_fit'. } diff --git a/man/get_model_diagnostic_flags.Rd b/man/get_model_diagnostic_flags.Rd index ea871bc6..bb4ebda5 100644 --- a/man/get_model_diagnostic_flags.Rd +++ b/man/get_model_diagnostic_flags.Rd @@ -2,19 +2,29 @@ % Please edit documentation in R/model_diagnostics.R \name{get_model_diagnostic_flags} \alias{get_model_diagnostic_flags} -\title{Get diagnostic flags} +\alias{get_model_diagnostic_flags.wwinference_fit} +\alias{get_model_diagnostic_flags.default} +\title{Get a table of diagnostic flags} \usage{ -get_model_diagnostic_flags( - stan_fit_object, +get_model_diagnostic_flags(x, ...) + +\method{get_model_diagnostic_flags}{wwinference_fit}(x, ...) + +\method{get_model_diagnostic_flags}{default}( + x, ebmfi_tolerance = 0.2, divergences_tolerance = 0.01, frac_high_rhat_tolerance = 0.05, rhat_tolerance = 1.05, - max_tree_depth_tol = 0.01 + max_tree_depth_tol = 0.01, + ... ) } \arguments{ -\item{stan_fit_object}{The R6 Cmdstan Object fit object} +\item{x}{Either an object of the 'wwinference_fit' class or +the R6 Cmdstan Object fit object} + +\item{...}{additional arguments} \item{ebmfi_tolerance}{float indicating the tolerance for EBMFI (estimated bayesian fraction of missing information), default is \code{0.2}} @@ -29,7 +39,7 @@ proportion of parameters rhats>rhat_tolderance, default is \code{0.05}} individual parameters, default is \code{1.05}} \item{max_tree_depth_tol}{float indicating the tolerance for the proportion -of iterations that exceed the maximum tree depth, default is \code{0.01}} +of iterations that exceed the maximum tree depth, default is \code{0.01},} } \value{ flag_df: dataframe containing columns for each of the flags, @@ -40,5 +50,16 @@ This function takes in the output from a cmdstanr$sample() function (the fit object) and a series of diagnostic tolerances and returns a dataframe containing flags for whether any of the diagnostic thresholds were exceeded, which would indicate that the model did not properly -converge +converge. This funtion has a default method that takes +the CmdStan fitting object, as well as an S3 method for objects of class +'wwinference_fit' + +This method overloads the generic get_model_diagnostic_flags function +specifically for objects of type 'wwinference_fit'. +} +\seealso{ +Other diagnostics: +\code{\link{parameter_diagnostics}()}, +\code{\link{wwinference}()} } +\concept{diagnostics} diff --git a/man/get_stan_data.Rd b/man/get_stan_data.Rd index 731e365c..370280ac 100644 --- a/man/get_stan_data.Rd +++ b/man/get_stan_data.Rd @@ -122,7 +122,7 @@ input_ww_data_for_stan <- get_input_ww_data_for_stan( last_count_data_date, calibration_time ) -stan_args <- get_stan_data( +stan_data_list <- get_stan_data( input_count_data_for_stan, input_ww_data_for_stan, forecast_date, diff --git a/man/parameter_diagnostics.Rd b/man/parameter_diagnostics.Rd new file mode 100644 index 00000000..ffbc6404 --- /dev/null +++ b/man/parameter_diagnostics.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model_diagnostics.R +\name{parameter_diagnostics} +\alias{parameter_diagnostics} +\title{Method for printing the CmdStan parameter diagnostics for a +wwinference_fit_object} +\usage{ +parameter_diagnostics(ww_fit, ...) +} +\arguments{ +\item{ww_fit}{An object of class wwinference_fit} + +\item{...}{additional arguments} +} +\description{ +Method for printing the CmdStan parameter diagnostics for a +wwinference_fit_object +} +\seealso{ +Other diagnostics: +\code{\link{get_model_diagnostic_flags}()}, +\code{\link{wwinference}()} +} +\concept{diagnostics} diff --git a/man/wwinference.Rd b/man/wwinference.Rd index 5cc08654..094202ef 100644 --- a/man/wwinference.Rd +++ b/man/wwinference.Rd @@ -2,6 +2,9 @@ % Please edit documentation in R/wwinference.R \name{wwinference} \alias{wwinference} +\alias{wwinference_fit} +\alias{print.wwinference_fit} +\alias{summary.wwinference_fit} \title{Joint inference of count data (e.g. cases/admissions) and wastewater data} \usage{ @@ -12,10 +15,14 @@ wwinference( calibration_time = 90, forecast_horizon = 28, model_spec = get_model_spec(), - mcmc_options = get_mcmc_options(), + fit_opts = get_mcmc_options(), generate_initial_values = TRUE, compiled_model = compile_model() ) + +\method{print}{wwinference_fit}(x, ...) + +\method{summary}{wwinference_fit}(object, ...) } \arguments{ \item{ww_data}{A dataframe containing the pre-processed, site-level @@ -42,8 +49,8 @@ forecast date, to produce forecasts for, default is \code{28}} example data provided by the package, but this should be specified by the user based on the date they are producing a forecast} -\item{mcmc_options}{The MCMC parameters as defined using -\code{get_mcmc_options()}.} +\item{fit_opts}{The fit options, which in this case default to the +MCMC parameters as defined using \code{get_mcmc_options()}.} \item{generate_initial_values}{Boolean indicating whether or not to specify the initialization of the sampler, default is \code{TRUE}, meaning that @@ -53,31 +60,41 @@ function} \item{compiled_model}{The pre-compiled model as defined using \code{compile_model()}} + +\item{x, object}{Object of class \code{wwinference_fit}} + +\item{...}{Additional parameters passed to the corresponding method} } \value{ -A nested list of the following items, intended to allow the user to -quickly and easily plot results from their inference, while also being able -to have the full user functionality of running the model themselves in stan -by providing the raw model object and diagnostics. If the model runs, this +An object of the \code{ww_inference_fit} class containing the following +items that are intended to be passed to downstream functions to do things +like extract posterior draws, get diangostic behavior, and plot results +(for example). If the model runs, this function will return: -\code{draws_df}: A tibble containing the full set of posterior draws of the -estimated, nowcasted, and forecasted: counts, site-level wastewater -concentrations, "global"(e.g. state) R(t) estimate, and the "local" (site + -the one auxiliary subpopulation) R(t) estimates. In the instance where there -are observations, the data will be joined to each draw of the predicted -observation to facilitate plotting. -\code{raw_fit_obj}: The CmdStan object that is returned from the call to +\code{fit}: The CmdStan object that is returned from the call to \code{cmdstanr::sample()}. Can be used to access draws, summary, diagnostics, etc. -\code{date_time_spine}: Mapping from time in stan to dates -\code{lab_site_spine}: Mapping from lab_site_index in stan to lab and site -\code{subpop_spine}: Mapping from site index in stan to site +\code{raw_input_data}: a list containing the input \code{ww_data} and the input +\code{count_data} used in the model. +\code{stan_data_list}: a list containing the inputs passed directly to the +stan model +\code{fit_opts}: a list of the MCMC specifications passed to stan If the model fails to run, a list containing the follow will be returned: \code{error}: the error message provided from stan, indicating why the model failed to run. Note, the model might still run and produce draws even if it has major model issues. We recommend the user always run the -\code{check_diagnostics()} function on the \code{diagnostic_summary} as part of any +\code{check_diagnostics()} function on the \code{parameter_diagnostics} as part of any pipeline to ensure model convergence. + +\itemize{ +\item The print method prints out information about the model and +returns the object invisibly. +} + +\itemize{ +\item The summary method returns the outcome from the +\verb{$summary} (\code{\link[cmdstanr:fit-method-summary]{cmdstanr::summary()}}) function. +} } \description{ Provides a user friendly interface around package functionality @@ -91,3 +108,81 @@ getting started vignette for an example model specifications fitting COVID-19 hospital admissions from a hypothetical state and wasteawter concentration data from multiple sites within that state. } +\examples{ +\dontrun{ +ww_data <- tibble::tibble( + date = rep(seq( + from = lubridate::ymd("2023-08-01"), + to = lubridate::ymd("2023-11-01"), + by = "weeks" + ), 2), + site = c(rep(1, 14), rep(2, 14)), + lab = c(rep(1, 28)), + conc = abs(rnorm(28, mean = 500, sd = 50)), + lod = c(rep(20, 14), rep(15, 14)), + site_pop = c(rep(2e5, 14), rep(4e5, 14)) +) + +ww_data_preprocessed <- preprocess_ww_data(ww_data, + conc_col_name = "conc", + lod_col_name = "lod" +) +input_ww_data <- indicate_ww_exclusions(ww_data_preprocessed) + +hosp_data <- tibble::tibble( + date = seq( + from = lubridate::ymd("2023-07-01"), + to = lubridate::ymd("2023-10-30"), + by = "days" + ), + daily_admits = sample(5:70, 122, replace = TRUE), + state_pop = rep(1e6, 122) +) + +input_count_data <- preprocess_count_data( + hosp_data, + "daily_admits", + "state_pop" +) + +generation_interval <- to_simplex(c(0.01, 0.2, 0.3, 0.2, 0.1, 0.1, 0.01)) +inf_to_count_delay <- to_simplex(c( + rep(0.01, 12), rep(0.2, 4), + rep(0.01, 10) +)) +infection_feedback_pmf <- generation_interval + +params <- get_params( + system.file("extdata", "example_params.toml", + package = "wwinference" + ) +) +forecast_date <- "2023-11-06" +calibration_time <- 90 +forecast_horizon <- 28 +include_ww <- 1 +ww_fit <- wwinference(input_ww_data, + input_count_data, + model_spec = get_model_spec( + forecast_date = forecast_date, + calibration_time = calibration_time, + forecast_horizon = forecast_horizon, + generation_interval = generation_interval, + inf_to_count_delay = inf_to_coutn_delay, + infection_feedback_pmf = infection_feedback_pmf, + params = params + ), + fit_opts = get_mcmc_options( + iter_warmup = 250, + iter_sampling = 250, + n_chains = 2 + ) +) +} +} +\seealso{ +Other diagnostics: +\code{\link{get_model_diagnostic_flags}()}, +\code{\link{parameter_diagnostics}()} +} +\concept{diagnostics} diff --git a/tests/testthat/test_get_stan_data.R b/tests/testthat/test_get_stan_data.R index 81975339..65c0d5a9 100644 --- a/tests/testthat/test_get_stan_data.R +++ b/tests/testthat/test_get_stan_data.R @@ -1,3 +1,5 @@ +seed <- 123 + ww_data <- tibble::tibble( date = rep(seq( from = lubridate::ymd("2023-08-01"), diff --git a/tests/testthat/test_preprocess_ww_data.R b/tests/testthat/test_preprocess_ww_data.R index 8ebd7a1b..05bd90f9 100644 --- a/tests/testthat/test_preprocess_ww_data.R +++ b/tests/testthat/test_preprocess_ww_data.R @@ -46,7 +46,7 @@ test_that("LOD column is renamed correctly", { lod_col_name = "LOD" ) - checkmate::assert_names(names(processed), + checkmate::expect_names(names(processed), must.include = "lod", disjunct.from = "LOD" ) diff --git a/tests/testthat/test_wwinference.R b/tests/testthat/test_wwinference.R new file mode 100644 index 00000000..6abf6ab5 --- /dev/null +++ b/tests/testthat/test_wwinference.R @@ -0,0 +1,79 @@ +# Generate test data +ww_data <- tibble::tibble( + date = rep(seq( + from = lubridate::ymd("2023-08-01"), + to = lubridate::ymd("2023-11-01"), + by = "weeks" + ), 2), + site = c(rep(1, 14), rep(2, 14)), + lab = c(rep(1, 28)), + conc = abs(rnorm(28, mean = 500, sd = 50)), + lod = c(rep(20, 14), rep(15, 14)), + site_pop = c(rep(2e5, 14), rep(4e5, 14)) +) + +ww_data_preprocessed <- preprocess_ww_data(ww_data, + conc_col_name = "conc", + lod_col_name = "lod" +) +input_ww_data <- indicate_ww_exclusions(ww_data_preprocessed) + +hosp_data <- tibble::tibble( + date = seq( + from = lubridate::ymd("2023-07-01"), + to = lubridate::ymd("2023-10-30"), + by = "days" + ), + daily_admits = sample(5:70, 122, replace = TRUE), + state_pop = rep(1e6, 122) +) + +input_count_data <- preprocess_count_data( + hosp_data, + "daily_admits", + "state_pop" +) + +generation_interval <- to_simplex(c(0.01, 0.2, 0.3, 0.2, 0.1, 0.1, 0.01)) +inf_to_count_delay <- to_simplex(c( + rep(0.01, 12), rep(0.2, 4), + rep(0.01, 10) +)) +infection_feedback_pmf <- generation_interval + +params <- get_params( + system.file("extdata", "example_params.toml", + package = "wwinference" + ) +) +forecast_date <- "2023-11-06" +calibration_time <- 90 +forecast_horizon <- 28 +include_ww <- 1 + + +test_that("wwinference model can compile", { + expect_no_error(compile_model()) +}) + +test_that("Function to get mcmc options produces the expected outputs", { + mcmc_options <- get_mcmc_options() + expected_names <- c( + "iter_warmup", "iter_sampling", + "n_chains", "seed", "adapt_delta", "max_treedepth", + "compute_likelihood" + ) + # Checkmade doesn't work here for a list, says it must be a character vector + expect_true(all(names(mcmc_options) %in% expected_names)) +}) + +test_that("Function to get model specs produces expected outputs", { + model_spec <- get_model_spec() + expected_names <- c( + "generation_interval", "inf_to_count_delay", + "infection_feedback_pmf", "include_ww", + "compute_likelihood", "params" + ) + # Checkmade doesn't work here for a list, says it must be a character vector + expect_true(all(names(model_spec) %in% expected_names)) +}) diff --git a/vignettes/wwinference.Rmd b/vignettes/wwinference.Rmd index 69f956f4..3aa14143 100644 --- a/vignettes/wwinference.Rmd +++ b/vignettes/wwinference.Rmd @@ -14,9 +14,11 @@ vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- -```{r echo=FALSE} + +```{r setup, echo=FALSE} knitr::opts_chunk$set(dev = "svg") ``` + # Quick start In this quick start, we demonstrate using `wwinference` to specify and fit a @@ -31,7 +33,7 @@ interested in fitting the `wwinference` model to their own data. In this quick start, we also use `dplyr` `tidybayes` and `ggplot2` packages. These are installed as dependencies when `wwinference` is installed. -```{r warning=FALSE, message=FALSE} +```{r load-pkgs, warning=FALSE, message=FALSE} library(wwinference) library(dplyr) library(ggplot2) @@ -79,9 +81,7 @@ process the sample, in natural scale - a site population size (column `site_pop`): the population size covered by the wastewater catchment area of that site - - -```{r} +```{r load-data} hosp_data <- wwinference::hosp_data hosp_data_eval <- wwinference::hosp_data_eval ww_data <- wwinference::ww_data @@ -91,6 +91,7 @@ head(hosp_data) ``` # Pre-processing + The user will need to provide data that is in a similar format to the package data, as described above. This represents the bare minimum required data for a single location and a single forecast date. We will need to do some @@ -99,10 +100,12 @@ able apply features such as outlier exclusion and censoring of values below the limit of detection. ## Parameters + Get the default parameters from the package. Note that some of these are COVID specific, others are more general to the model. This is indicated in the .toml file. -```{r} + +```{r get-params} params <- get_params( system.file("extdata", "example_params.toml", package = "wwinference" @@ -129,7 +132,8 @@ name of the column containing the limit of detection for each measurement. The function assumes that the original data contains the columns `date`, `site`, and `lab`, and will return a dataframe with the column names needed to pass to the downstream model fitting functions. -```{r} + +```{r preprocess-ww-data} ww_data_preprocessed <- wwinference::preprocess_ww_data( ww_data, conc_col_name = "genome_copies_per_ml", @@ -137,8 +141,8 @@ ww_data_preprocessed <- wwinference::preprocess_ww_data( ) ``` - ## Hospital admissions data pre-processing + The `preprocess_hosp_data` function standardizes the column names of the resulting datafame. The user must specify the name of the column containing the daily hospital admissions counts and the population size that the hospital @@ -146,7 +150,8 @@ admissions are coming from (from in this case, a hypothetical US state). The function assumes that the original data contains the column `date`, and will return a dataframe with the column names needed to pass to the downstream model fitting functions. -```{r} + +```{r preprocess-hosp-data} hosp_data_preprocessed <- wwinference::preprocess_count_data( hosp_data, count_col_name = "daily_hosp_admits", @@ -154,10 +159,9 @@ hosp_data_preprocessed <- wwinference::preprocess_count_data( ) ``` - We'll make some plots of the data just to make sure it looks like what we'd expect: -```{r, out.width='100%'} +```{r time-series-fig, out.width='100%'} ggplot(ww_data_preprocessed) + geom_point( aes( @@ -196,12 +200,14 @@ ggplot(hosp_data_preprocessed) + ``` ## Data exclusion + As an optional additional pre-processing step, the user can decide to exclude certain data points from being included in the model fit procedure. For example, we recommend excluding the flagged wastewater concentration outliers. To do so we will use the `indicate_ww_exclusions()` function, which will add the flagged outliers to the exclude column where indicated. -```{r} + +```{r indicate-ww-exclusions} ww_data_to_fit <- wwinference::indicate_ww_exclusions( ww_data_preprocessed, outlier_col_name = "flag_as_ww_outlier", @@ -209,8 +215,8 @@ ww_data_to_fit <- wwinference::indicate_ww_exclusions( ) ``` - # Model specification: + We will need to set some metadata to facilitate model specification. This includes: - forecast date (the date we are making a forecast) - number of days to calibrate the model for @@ -219,8 +225,8 @@ We will need to set some metadata to facilitate model specification. This includ - specification of the delay from infection to the count data, in this case from infection to COVID-19 hospital admission - ## Calibration time and forecast time + The calibration time represents the number of days to calibrate the count data to. This must be less than or equal to the number of rows in `hosp_data`. The forecast horizon represents the number of days from the forecast date to @@ -229,13 +235,15 @@ data will not be complete up until the forecast date, and we will refer to the time between the last hospital admissions data point and the forecast date as the nowcast time. The model will "forecast" this period, in addition to the specified forecast horizon. -```{r} + +```{r set-forecast-params} forecast_date <- "2023-12-06" calibration_time <- 90 forecast_horizon <- 28 ``` ## Delay distributions + We will pass in some probabiltiy mass functions (pmfs) that are specific to COVID, and to the delay from infections to hospital admissions, the count data we are using to fit th emodel. If using a different pathogen or a @@ -248,24 +256,29 @@ high incident infections results in negative feedback on future infections (due to susceptibility, behavior changes, policies to reduce transmission, etc.). We by default set this as the generation interval, but this can be modified as long as the values sum to 1. -```{r} + +```{r set-delay-distributions} generation_interval <- wwinference::default_covid_gi inf_to_hosp <- wwinference::default_covid_inf_to_hosp # Assign infection feedback equal to the generation interval infection_feedback_pmf <- generation_interval ``` + We will pass these to the `model_spec()` function of the `wwinference()` model, along with the other specified parameters above. - # Precompiling the model + As `wwinference` uses `cmdstan` to fit its models, it is necessary to first compile the model. This can be done using the compile_model() function. -```{r} + +```{r compile-model} model <- wwinference::compile_model() ``` + # Fitting the model + We're now ready to fit the model using the “No-U-Turn Sampler Markov chain Monte Carlo” method. This is a type of Hamiltonian Monte Carlo (HMC) algorithm and is the core fitting method used by `cmdstan`. The user can adjust the MCMC @@ -283,9 +296,8 @@ set the MCMC settings using `get_mcmc_options()`, and pass in our pre-compiled model(`model`) to `wwinference()` where they are combined and used to fit the model. - -```{r warning=FALSE, message=FALSE} -fit <- wwinference::wwinference( +```{r fitting-model, warning=FALSE, message=FALSE} +ww_fit <- wwinference::wwinference( ww_data = ww_data_to_fit, count_data = hosp_data_preprocessed, forecast_date = forecast_date, @@ -297,33 +309,75 @@ fit <- wwinference::wwinference( infection_feedback_pmf = infection_feedback_pmf, params = params ), - mcmc_options = get_mcmc_options(), + fit_opts = get_mcmc_options(), compiled_model = model ) ``` -# The `wwinference` object -The `wwinference()` function returns a `wwinference` object which includes -a `draws_df`, the underlying `CmdStan` object (`raw_fit_obj`), and three -"spines" that map the stan indices to the data which include:a -`date_time_spine`, `lab_site_spine`, and `subpop_spine`. The `draws_df` is -intended to provide an easy to work with tibble of posterior draws of -the estimated, nowcasted, and forecasted expected observed hospital admissions -and wastewater concentrations, as well as the latent variables of interest -including the site-level R(t) estimates and the state-level R(t) estimate. -```{r} -head(fit) +# The `wwinference_fit` object + +The `wwinference()` function returns a `wwinference_fit` object which includes +the underlying and the underlying +[`CmdStanModel` object](https://mc-stan.org/cmdstanr/reference/CmdStanModel.html) + (`fit`), a list of the two sources of input +data (`raw_input_data`), the list of the arguments passed to stan +(`stan_data_list`), and the list of the MCMC options (`fit_opts`) passed to +stan. We show how to generate downstream elements from a `wwinference_fit` +object. + +`wwinference_fit` objects currently have the following methods available: + +```{r show-methods} +methods(class = "wwinference_fit") +``` + +The `print` and `summary` methods can provide some information about the model. In particular, the `summary` method is a wrapper for `cmdstanr::summary()`: + +```{r print-and-summary} +print(ww_fit) +summary(ww_fit) +``` + +## Extracting the posterior predictions + +Working with the posterior predictions alongside the input data can be useful +to check that your model is fitting the data well and that the +nowcasted/forecast quantities look reasonable. + +We will generate a dataframe that we'll call `draws_df`, that contains +the posterior draws of the estimated, nowcasted, and forecasted expected +observed hospital admissions and wastewater concentrations, as well as the +latent variables of interest including the site-level R(t) estimates and the +state-level R(t) estimate. + +We can generate this directly on the output of `wwinference()` using: +```{r extracting-draws} +draws_df <- get_draws_df(ww_fit) +``` + +### Using explicit passed arguments rather than S3 methods + +Rather than using S3 methods supplied for `wwinference()`, the elements in the +`wwinference_fit` object can also be used directly to create this dataframe. +This is demonstrated below: + +```{r extracting-draws-explicit} +draws_df_explicit <- get_draws_df( + x = ww_fit$raw_input_data$input_ww_data, + count_data = ww_fit$raw_input_data$input_count_data, + stan_data_list = ww_fit$stan_data_list, + fit_obj = ww_fit$fit +) ``` -# Summarizing and plotting the model fit -The `draws_df` object is intended to be used to easily plot relevant model -outputs against data. This can be useful to get a sense of if your model is -fitting the data well, and if the nowcasted/forecast quantities look reasonable. -We can create the plots using the fitting wrapper functions (figures can -also created directly using the `draws_df`) -```{r, out.width='100%'} -draws_df <- fit$draws_df +## Plotting the outputs + +We can create plots of the outputs using `draws_df` and +the fitting wrapper functions. + +```{r generating-figures, out.width='100%'} +draws_df <- get_draws_df(ww_fit) plot_hosp <- get_plot_forecasted_counts( draws = draws_df, @@ -344,34 +398,69 @@ plot_subpop_rt ``` ## Diagnostics -While the `wwinference()` function will print out messaging if any of the -diagnostics flags fail, we recommend running diagnostics as a separate -post-processing step on the `CmdStan` fit object. Start by running function -`get_model_diagnostic_flags()` on the stan fit object. Then, we recommend -looking at the `raw_fit_obj$summary()` which will show the diagnostic -metrics for each parameter in the model and can help identify which parameters -are likely to be driving any convergence issues. We have set default thresholds -on the model diagnostics for production-level runs, we recommend adjusting -as needed. For further information on troubleshooting the model diagnostics, + +We strongly recommend running diagnostics as a post-processing step on the +model outputs. + +This can be done by passing the output of +`wwinference()` into the `get_model_diagnostic_flags()`, `parameter_diagnostics()`, +and `parameter_diagnostics()` functions. + +`get_model_diagnostic_flags()` will print out a table of any flags, if any of +these are TRUE, it will print out a warning. +We have set default thresholds on the model diagnostics for production-level +runs, we recommend adjusting as needed (see below) + +To further troubleshoot, you can look at +the diagnostic summary and the diagnostics of the individual parameters using +the `parameter_diagnostics()` function. + +```{r diagnostics-using-S3-methods} +convergence_flag_df <- get_model_diagnostic_flags(ww_fit) +print(convergence_flag_df) +parameter_diagnostics(ww_fit) +``` + +This can also be done explicitly by parsing the elements of the +`wwinference_fit` object into the custom functions we built / directly calling +`CmdStan`'s built in functions. + +Start by passing the stan fit object(`ww_fit$fit$result`) into the +`get_model_diagnostic_flags()` and adjusting the thresholds if desired. + +Then, we recommend looking at the diagnostics summary provided by `CmdStan`, +which we had wrapped into the `parameter_diagnostics()` call above. Lastly, +we recommend looking at the individual model parameters provided by `CmdStan` +to identify which components of the model might be driving the convergence +issues. + +For further information on troubleshooting the model diagnostics, we recommend the (bayesplot tutorial)[https://mc-stan.org/bayesplot/articles/visual-mcmc-diagnostics.html]. -```{r} -convergence_flag_df <- wwinference::get_model_diagnostic_flags( - stan_fit_obj = - fit$raw_fit_obj + +```{r diagnostics-explicit} +convergence_flag_df <- get_model_diagnostic_flags( + x = ww_fit$fit$result, + ebmfi_tolerance = 0.2, + divergences_tolerance = 0.01, + frac_high_rhat_tolerance = 0.05, + rhat_tolerance = 1.05, + max_tree_depth_tol = 0.01 ) -parameter_diagnostics <- fit$raw_fit_obj$summary() -diagnostic_summary <- fit$raw_fit_obj$diagnostic_summary(quiet = TRUE) +# Get the tables using the CmdStan functions via wrappers +summary(ww_fit) +parameter_diagnostics(ww_fit, quiet = TRUE) head(convergence_flag_df) ``` ## Fit to only hospital admissions data + The package also has functionality to fit the model without wastewater data. This can be useful when doing comparisons of the impact the wastewater data has on the forecast, or as a part of a pipeline where one might choose to rely on the admissions only model if there are covergence or known data issues with the wastewater data. -```{r warning=FALSE, message=FALSE} +```{r fit-hosp-only, warning=FALSE, message=FALSE} fit_hosp_only <- wwinference::wwinference( ww_data = ww_data_to_fit, count_data = hosp_data_preprocessed, @@ -385,13 +474,13 @@ fit_hosp_only <- wwinference::wwinference( include_ww = FALSE, params = params ), - mcmc_options = get_mcmc_options(), + fit_opts = get_mcmc_options(), compiled_model = model ) ``` -```{r, out.width='100%'} -draws_df_hosp_only <- fit_hosp_only$draws_df +```{r plot-hosp-only, out.width='100%'} +draws_df_hosp_only <- get_draws_df(fit_hosp_only) plot_hosp_hosp_only <- get_plot_forecasted_counts( draws = draws_df_hosp_only, count_data_eval = hosp_data_eval, From 257587b2ef711fde193f3b59c2583c441ef7e91a Mon Sep 17 00:00:00 2001 From: "George G. Vega Yon" Date: Tue, 3 Sep 2024 16:35:53 -0600 Subject: [PATCH 02/46] Addressing R CMD check notes due to tidyeval syntax (#108) * Starting to use .data and others * Removing more warnings * Think almost all issues are now solved * License warning and passing params as expected * Removing prefix * Fixing note on license and news file * Using str2lang in spread_draws * Update R/get_draws_df.R Co-authored-by: Dylan H. Morris * Fixing R CMD check * fixed intercept in figures * Update R/generate_simulated_data.R Co-authored-by: Dylan H. Morris * Apply suggestions from code review by @dylanhmorris Co-authored-by: Dylan H. Morris * Update R/preprocessing.R Co-authored-by: Dylan H. Morris * Update R/get_stan_data.R Co-authored-by: Dylan H. Morris * Update R/preprocessing.R Co-authored-by: Dylan H. Morris * Update R/preprocessing.R Co-authored-by: Dylan H. Morris * Update R/preprocessing.R Co-authored-by: Dylan H. Morris * Update R/preprocessing.R Co-authored-by: Dylan H. Morris * Update R/preprocessing.R Co-authored-by: Dylan H. Morris * remove call to utils::globalVariables() * Update R/preprocessing.R * Update R/generate_simulated_data.R Co-authored-by: Dylan H. Morris * Update R/preprocessing.R Co-authored-by: Dylan H. Morris * Update R/get_stan_data.R Co-authored-by: Dylan H. Morris --------- Co-authored-by: Dylan H. Morris Co-authored-by: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Co-authored-by: kaitejohnson --- .Rbuildignore | 12 +++ DESCRIPTION | 2 +- NAMESPACE | 6 ++ NEWS.md | 2 +- R/checkers.R | 6 +- R/compile_model.R | 2 +- R/delay_distribs.R | 2 +- R/figures.R | 53 +++++++------ R/generate_simulated_data.R | 7 +- R/get_draws_df.R | 64 ++++++++-------- R/get_stan_data.R | 39 +++++----- R/model_component_fwd_sim.R | 27 ++++--- R/preprocessing.R | 85 +++++++++++---------- R/wwinference-package.R | 5 +- R/wwinference.R | 6 +- man/compile_model.Rd | 2 +- man/simulate_double_censored_pmf.Rd | 2 +- tests/testthat/test_preprocess_count_data.R | 2 +- tests/testthat/test_preprocess_ww_data.R | 2 +- 19 files changed, 177 insertions(+), 149 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index dbbb7267..a5978129 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -4,3 +4,15 @@ ^\.github$ ^.*\.Rproj$ ^\.Rproj\.user$ + +# Misc +^data-raw$ +^model_definition\.md$ +^scratch$ + +# Hidden files/folders +^\..+ + +# Because R doesn't like having a copy of this +# type of license in the package. +LICENSE diff --git a/DESCRIPTION b/DESCRIPTION index deff51fc..9ddbbe64 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -63,6 +63,7 @@ Suggests: testthat (>= 3.0.0), bookdown, knitr, + withr, rcmdcheck Config/testthat/edition: 3 LazyData: true @@ -77,7 +78,6 @@ Imports: tidybayes, tidyr, purrr, - withr, cmdstanr (>= 0.8.0), rlang, scales, diff --git a/NAMESPACE b/NAMESPACE index 060fd288..6906d367 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -60,6 +60,7 @@ importFrom(dplyr,select) importFrom(dplyr,ungroup) importFrom(fs,path_package) importFrom(ggplot2,aes) +importFrom(ggplot2,element_text) importFrom(ggplot2,facet_grid) importFrom(ggplot2,facet_wrap) importFrom(ggplot2,geom_bar) @@ -67,6 +68,7 @@ importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_ribbon) +importFrom(ggplot2,geom_step) importFrom(ggplot2,geom_vline) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggtitle) @@ -76,9 +78,13 @@ importFrom(ggplot2,scale_fill_discrete) importFrom(ggplot2,scale_x_date) importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,theme) +importFrom(ggplot2,theme_bw) +importFrom(ggplot2,xlab) +importFrom(ggplot2,ylab) importFrom(lubridate,ymd) importFrom(posterior,as_draws_list) importFrom(posterior,subset_draws) +importFrom(rlang,.data) importFrom(rlang,sym) importFrom(stats,dnbinom) importFrom(stats,dweibull) diff --git a/NEWS.md b/NEWS.md index 55500fe1..79e938d3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# wwinference +# wwinference 0.0.0.9000 (dev) This will serve as our change-log diff --git a/R/checkers.R b/R/checkers.R index cf023f21..2c43a405 100644 --- a/R/checkers.R +++ b/R/checkers.R @@ -582,10 +582,10 @@ assert_equivalent_indexing <- function(first_data, call = rlang::caller_env(), add_err_msg = "") { first_index <- first_data |> - dplyr::distinct(date, t) + dplyr::distinct(.data$date, .data$t) second_index <- second_data |> - dplyr::distinct(date, t) |> - dplyr::rename(second_t = t) + dplyr::distinct(.data$date, .data$t) |> + dplyr::rename("second_t" = "t") test_df <- first_index |> diff --git a/R/compile_model.R b/R/compile_model.R index e9245151..bed751dd 100644 --- a/R/compile_model.R +++ b/R/compile_model.R @@ -5,7 +5,7 @@ #' This function reads in and optionally compiles a Stan model. #' It is written to search the installed package `stan` directory #' for additional source files to include. Within each stan file, -#' use #include {path to your file with the `stan` directory}.stan +#' use `#include {path to your file with the stan directory}.stan` #' #' #' @details The code for this function has been adapted diff --git a/R/delay_distribs.R b/R/delay_distribs.R index 14f5d53e..b46345a6 100644 --- a/R/delay_distribs.R +++ b/R/delay_distribs.R @@ -1,4 +1,4 @@ -#' Simulate daily double censored PMF. From {epinowcast}: +#' Simulate daily double censored PMF. From epinowcast: #' https://package.epinowcast.org/dev/reference/simulate_double_censored_pmf.html #nolint #' #' This function simulates the probability mass function of a daily diff --git a/R/figures.R b/R/figures.R index 47efd10a..c87f84fc 100644 --- a/R/figures.R +++ b/R/figures.R @@ -33,21 +33,23 @@ get_plot_forecasted_counts <- function(draws, sampled_draws <- sample(1:max(draws$draw), n_draws_to_plot) draws_to_plot <- draws |> dplyr::filter( - name == "pred_counts", - draw %in% !!sampled_draws + .data$name == "pred_counts", + .data$draw %in% !!sampled_draws ) p <- ggplot(draws_to_plot) + - geom_line(aes(x = date, y = pred_value, group = draw), + geom_line( + aes(x = .data$date, y = .data$pred_value, group = .data$draw), color = "red4", alpha = 0.1, linewidth = 0.2 ) + geom_point( data = count_data_eval, - aes(x = date, y = .data[[count_data_eval_col_name]]), + aes(x = .data$date, y = .data[[count_data_eval_col_name]]), shape = 21, color = "black", fill = "white" ) + - geom_point(aes(x = date, y = observed_value)) + - geom_vline(aes(xintercept = lubridate::ymd(forecast_date)), + geom_point(aes(x = .data$date, y = .data$observed_value)) + + geom_vline( + xintercept = lubridate::ymd(forecast_date), linetype = "dashed" ) + xlab("") + @@ -95,8 +97,8 @@ get_plot_ww_conc <- function(draws, draws_to_plot <- draws |> dplyr::filter( - name == "pred_ww", - draw %in% !!sampled_draws + .data$name == "pred_ww", + .data$draw %in% !!sampled_draws ) |> dplyr::mutate( site_lab_name = glue::glue("{subpop}, Lab: {lab}") @@ -105,18 +107,19 @@ get_plot_ww_conc <- function(draws, p <- ggplot(draws_to_plot) + geom_line( aes( - x = date, y = log(pred_value), - color = subpop, - group = draw + x = .data$date, y = log(.data$pred_value), + color = .data$subpop, + group = .data$draw ), alpha = 0.1, linewidth = 0.2, show.legend = FALSE ) + - geom_point(aes(x = date, y = log(observed_value)), + geom_point(aes(x = .data$date, y = log(.data$observed_value)), color = "black", show.legend = FALSE ) + facet_wrap(~site_lab_name, scales = "free") + - geom_vline(aes(xintercept = lubridate::ymd(forecast_date)), + geom_vline( + xintercept = lubridate::ymd(forecast_date), linetype = "dashed" ) + xlab("") + @@ -163,17 +166,18 @@ get_plot_global_rt <- function(draws, sampled_draws <- sample(1:max(draws$draw), n_draws_to_plot) draws_to_plot <- draws |> dplyr::filter( - name == "global R(t)", - draw %in% !!sampled_draws + .data$name == "global R(t)", + .data$draw %in% !!sampled_draws ) # R(t) timeseries p <- ggplot(draws_to_plot) + - ggplot2::geom_step( - aes(x = date, y = pred_value, group = draw), + geom_step( + aes(x = .data$date, y = .data$pred_value, group = .data$draw), color = "blue4", alpha = 0.1, linewidth = 0.2 ) + - geom_vline(aes(xintercept = lubridate::ymd(forecast_date)), + geom_vline( + xintercept = lubridate::ymd(forecast_date), linetype = "dashed" ) + geom_hline(aes(yintercept = 1), linetype = "dashed") + @@ -221,20 +225,21 @@ get_plot_subpop_rt <- function(draws, sampled_draws <- sample(1:max(draws$draw), n_draws_to_plot) draws_to_plot <- draws |> dplyr::filter( - name == "subpop R(t)", - draw %in% !!sampled_draws + .data$name == "subpop R(t)", + .data$draw %in% !!sampled_draws ) p <- ggplot(draws_to_plot) + - ggplot2::geom_step( + geom_step( aes( - x = date, y = pred_value, group = draw, - color = subpop + x = .data$date, y = .data$pred_value, group = .data$draw, + color = .data$subpop ), alpha = 0.1, linewidth = 0.2, show.legend = FALSE ) + - geom_vline(aes(xintercept = lubridate::ymd(forecast_date)), + geom_vline( + xintercept = lubridate::ymd(forecast_date), linetype = "dashed", show.legend = FALSE ) + diff --git a/R/generate_simulated_data.R b/R/generate_simulated_data.R index f7301aef..0a3bf3a8 100644 --- a/R/generate_simulated_data.R +++ b/R/generate_simulated_data.R @@ -186,8 +186,8 @@ generate_simulated_data <- function(r_in_weeks = # nolint ) forecast_date <- date_df |> - dplyr::filter(t == ot + nt) |> - dplyr::pull(date) + dplyr::filter(.data$t == !!ot + !!nt) |> + dplyr::pull("date") # Set the lab-site multiplier presumably from lab measurement processes log_m_lab_sites <- rnorm(n_lab_sites, @@ -419,8 +419,7 @@ generate_simulated_data <- function(r_in_weeks = # nolint date_df = date_df ) |> dplyr::rename( - daily_hosp_admits_for_eval = - daily_hosp_admits + "daily_hosp_admits_for_eval" = "daily_hosp_admits" ) # Global R(t) diff --git a/R/get_draws_df.R b/R/get_draws_df.R index 9db33ac1..914159bb 100644 --- a/R/get_draws_df.R +++ b/R/get_draws_df.R @@ -80,11 +80,11 @@ get_draws_df.data.frame <- function(x, dplyr::mutate(t = row_number()) # Lab-site index to corresponding lab, site, and site population size lab_site_spine <- x |> - dplyr::distinct(site, lab, lab_site_index, site_pop) + dplyr::distinct(.data$site, .data$lab, .data$lab_site_index, .data$site_pop) # Site index to corresponding site and subpopulation size subpop_spine <- x |> - dplyr::distinct(site, site_index, site_pop) |> - dplyr::mutate(site = as.factor(site)) |> + dplyr::distinct(.data$site, .data$site_index, .data$site_pop) |> + dplyr::mutate(site = as.factor(.data$site)) |> dplyr::bind_rows(tibble::tibble( site = "remainder of pop", site_index = max(x$site_index) + 1, @@ -95,21 +95,21 @@ get_draws_df.data.frame <- function(x, count_draws <- draws |> - tidybayes::spread_draws(pred_hosp[t]) |> - dplyr::rename(pred_value = pred_hosp) |> + tidybayes::spread_draws(!!str2lang("pred_hosp[t]")) |> + dplyr::rename("pred_value" = "pred_hosp") |> dplyr::mutate( - draw = `.draw`, + draw = .data$`.draw`, name = "pred_counts" ) |> - dplyr::select(name, t, pred_value, draw) |> + dplyr::select("name", "t", "pred_value", "draw") |> dplyr::left_join(date_time_spine, by = "t") |> dplyr::left_join( count_data |> - dplyr::select(-t), + dplyr::select(-"t"), by = "date" ) |> dplyr::ungroup() |> - dplyr::rename(observed_value = count) |> + dplyr::rename("observed_value" = "count") |> dplyr::mutate( observation_type = "count", type_of_quantity = "global", @@ -122,53 +122,53 @@ get_draws_df.data.frame <- function(x, flag_as_ww_outlier = NA, exclude = NA ) |> - dplyr::select(-t) + dplyr::select(-"t") ww_draws <- draws |> - tidybayes::spread_draws(pred_ww[lab_site_index, t]) |> - dplyr::rename(pred_value = pred_ww) |> + tidybayes::spread_draws(!!str2lang("pred_ww[lab_site_index, t]")) |> + dplyr::rename("pred_value" = "pred_ww") |> dplyr::mutate( - draw = `.draw`, + draw = .data$`.draw`, name = "pred_ww", - pred_value = exp(pred_value) + pred_value = exp(.data$pred_value) ) |> - dplyr::select(name, lab_site_index, t, pred_value, draw) |> + dplyr::select("name", "lab_site_index", "t", "pred_value", "draw") |> dplyr::left_join(date_time_spine, by = "t") |> dplyr::left_join(lab_site_spine, by = "lab_site_index") |> dplyr::left_join( x |> - dplyr::select(-t), + dplyr::select(-"t"), by = c( "lab_site_index", "date", "lab", "site", "site_pop" ) ) |> dplyr::ungroup() |> - dplyr::mutate(observed_value = genome_copies_per_ml) |> + dplyr::mutate(observed_value = .data$genome_copies_per_ml) |> dplyr::mutate( observation_type = "genome copies per mL", type_of_quantity = "local", total_pop = NA, subpop = glue::glue("Site: {site}") ) |> - dplyr::select(colnames(count_draws), -t) + dplyr::select(colnames(count_draws), -"t") global_rt_draws <- draws |> - tidybayes::spread_draws(rt[t]) |> - dplyr::rename(pred_value = rt) |> + tidybayes::spread_draws(!!str2lang("rt[t]")) |> + dplyr::rename("pred_value" = "rt") |> dplyr::mutate( - draw = `.draw`, + draw = .data$`.draw`, name = "global R(t)" ) |> - dplyr::select(name, t, pred_value, draw) |> + dplyr::select("name", "t", "pred_value", "draw") |> dplyr::left_join(date_time_spine, by = "t") |> dplyr::left_join( count_data |> - dplyr::select(-t), + dplyr::select(-"t"), by = "date" ) |> dplyr::ungroup() |> - dplyr::rename(observed_value = count) |> + dplyr::rename("observed_value" = "count") |> dplyr::mutate( observed_value = NA, observation_type = "latent variable", @@ -182,17 +182,17 @@ get_draws_df.data.frame <- function(x, flag_as_ww_outlier = NA, exclude = NA ) |> - dplyr::select(-t) + dplyr::select(-"t") site_level_rt_draws <- draws |> - tidybayes::spread_draws(r_site_t[site_index, t]) |> - dplyr::rename(pred_value = r_site_t) |> + tidybayes::spread_draws(!!str2lang("r_site_t[site_index, t]")) |> + dplyr::rename("pred_value" = "r_site_t") |> dplyr::mutate( - draw = `.draw`, + draw = .data$`.draw`, name = "subpop R(t)", - pred_value = pred_value + pred_value = .data$pred_value ) |> - dplyr::select(name, site_index, t, pred_value, draw) |> + dplyr::select("name", "site_index", "t", "pred_value", "draw") |> dplyr::left_join(date_time_spine, by = "t") |> dplyr::left_join(subpop_spine, by = "site_index") |> dplyr::ungroup() |> @@ -207,11 +207,11 @@ get_draws_df.data.frame <- function(x, observation_type = "latent variable", type_of_quantity = "local", total_pop = NA, - subpop = ifelse(site != "remainder of pop", + subpop = ifelse(.data$site != "remainder of pop", glue::glue("Site: {site}"), "remainder of pop" ) ) |> - dplyr::select(colnames(count_draws), -t) + dplyr::select(colnames(count_draws), -"t") draws_df <- dplyr::bind_rows( count_draws, diff --git a/R/get_stan_data.R b/R/get_stan_data.R index 0d51e9e4..89082077 100644 --- a/R/get_stan_data.R +++ b/R/get_stan_data.R @@ -14,7 +14,7 @@ get_input_count_data_for_stan <- function(preprocessed_count_data, input_count_data_filtered <- preprocessed_count_data |> dplyr::filter( - date > last_count_data_date - lubridate::days(calibration_time) + .data$date > last_count_data_date - lubridate::days(!!calibration_time) ) count_data <- add_time_indexing(input_count_data_filtered) @@ -68,11 +68,11 @@ get_input_ww_data_for_stan <- function(preprocessed_ww_data, # data. Arrange data for indexing. This is what will be returned. ww_data <- preprocessed_ww_data |> dplyr::filter( - exclude != 1, - date > last_count_data_date - - lubridate::days(calibration_time) + .data$exclude != 1, + .data$date > !!last_count_data_date - + lubridate::days(!!calibration_time) ) |> - dplyr::arrange(date, lab_site_index) + dplyr::arrange(.data$date, .data$lab_site_index) ww_data_sizes <- get_ww_data_sizes( ww_data, @@ -239,9 +239,8 @@ get_stan_data <- function(input_count_data, # Get the total pop, coming from the larger population generating the # count data pop <- input_count_data |> - dplyr::select(total_pop) |> - unique() |> - dplyr::pull(total_pop) + dplyr::distinct(.data$total_pop) |> + dplyr::pull() assert_single_value(pop, arg = "global population", @@ -270,7 +269,7 @@ get_stan_data <- function(input_count_data, # Returns the vectors of indices you need to map latent variables to # observations ww_indices <- get_ww_data_indices( - input_ww_data |> dplyr::select(-t), + input_ww_data |> dplyr::select(-"t"), first_count_data_date, owt = ww_data_sizes$owt, lod_col_name = "below_lod" @@ -537,10 +536,10 @@ get_ww_data_indices <- function(ww_data, dplyr::mutate(ind_rel_to_sampled_times = dplyr::row_number()) ww_censored <- ww_data_with_index |> dplyr::filter(.data[[lod_col_name]] == 1) |> - dplyr::pull(ind_rel_to_sampled_times) + dplyr::pull(.data$ind_rel_to_sampled_times) ww_uncensored <- ww_data_with_index |> dplyr::filter(.data[[lod_col_name]] == 0) |> - dplyr::pull(ind_rel_to_sampled_times) + dplyr::pull(.data$ind_rel_to_sampled_times) stopifnot( "Length of censored vectors incorrect" = length(ww_censored) + length(ww_uncensored) == owt @@ -576,10 +575,10 @@ get_ww_data_indices <- function(ww_data, # Need a vector of indices indicating the site for each lab-site lab_site_to_site_map <- ww_data |> - dplyr::select(lab_site_index, site_index) |> - dplyr::arrange(lab_site_index, "desc") |> + dplyr::select("lab_site_index", "site_index") |> + dplyr::arrange(.data$lab_site_index, "desc") |> dplyr::distinct() |> - dplyr::pull(site_index) + dplyr::pull(.data$site_index) ww_data_indices <- list( ww_censored = ww_censored, @@ -651,11 +650,11 @@ get_ww_values <- function(ww_data, # so just take the average across the populations reported for each # observation pop_ww <- ww_data |> - dplyr::select(site_index, {{ ww_site_pop_col_name }}) |> - dplyr::group_by(site_index) |> + dplyr::select("site_index", {{ ww_site_pop_col_name }}) |> + dplyr::group_by(.data$site_index) |> dplyr::summarise(pop_avg = mean(.data[[ww_site_pop_col_name]])) |> - dplyr::arrange(site_index, "desc") |> - dplyr::pull(pop_avg) + dplyr::arrange(.data$site_index, "desc") |> + dplyr::pull(.data$pop_avg) } else { # Want a vector of length of the number of observations, corresponding to # the population at that time @@ -670,7 +669,7 @@ get_ww_values <- function(ww_data, log_conc = (log(.data[[ww_measurement_col_name]] + padding_value)) ) |> - dplyr::pull(log_conc) + dplyr::pull(.data$log_conc) ww_values <- list( ww_lod = ww_lod, @@ -715,7 +714,7 @@ add_time_indexing <- function(input_count_data) { count_data <- input_count_data |> dplyr::left_join(date_df, by = "date") |> - dplyr::arrange(date) + arrange(.data$date) return(count_data) } diff --git a/R/model_component_fwd_sim.R b/R/model_component_fwd_sim.R index 63153e64..e2e9e1a1 100644 --- a/R/model_component_fwd_sim.R +++ b/R/model_component_fwd_sim.R @@ -355,7 +355,7 @@ format_ww_data <- function(log_obs_conc_lab_site, values_to = "log_conc" ) |> dplyr::mutate( - lab_site = as.integer(lab_site) + lab_site = as.integer(.data$lab_site) ) |> dplyr::left_join(date_df, by = "t") |> dplyr::left_join(site_lab_map, @@ -371,18 +371,21 @@ format_ww_data <- function(log_obs_conc_lab_site, dplyr::mutate( lod_sewage = dplyr::case_when( - is.na(log_conc) ~ NA, - !is.na(log_conc) ~ lod_sewage + is.na(.data$log_conc) ~ NA, + !is.na(.data$log_conc) ~ .data$lod_sewage ) ) |> dplyr::mutate( - genome_copies_per_ml = exp(log_conc), - lod = exp(lod_sewage) + genome_copies_per_ml = exp(.data$log_conc), + lod = exp(.data$lod_sewage) ) |> - dplyr::filter(!is.na(genome_copies_per_ml)) |> - dplyr::rename(site_pop = ww_pop) |> - dplyr::arrange(site, lab, date) |> - dplyr::select(date, site, lab, genome_copies_per_ml, lod, site_pop) + dplyr::filter(!is.na(.data$genome_copies_per_ml)) |> + dplyr::rename("site_pop" = "ww_pop") |> + dplyr::arrange(.data$site, .data$lab, .data$date) |> + dplyr::select( + "date", "site", "lab", "genome_copies_per_ml", "lod", + "site_pop" + ) return(ww_data) } @@ -417,9 +420,9 @@ format_hosp_data <- function(pred_obs_hosp, by = "t" ) |> dplyr::select( - date, - daily_hosp_admits, - state_pop + "date", + "daily_hosp_admits", + "state_pop" ) return(hosp_data) } diff --git a/R/preprocessing.R b/R/preprocessing.R index 316ec5f1..9398e30d 100644 --- a/R/preprocessing.R +++ b/R/preprocessing.R @@ -52,7 +52,7 @@ preprocess_ww_data <- function(ww_data, ww_data_add_cols <- ww_data |> dplyr::left_join( ww_data |> - dplyr::distinct(lab, site) |> + dplyr::distinct(.data$lab, .data$site) |> dplyr::mutate( lab_site_index = dplyr::row_number() ), @@ -60,17 +60,17 @@ preprocess_ww_data <- function(ww_data, ) |> dplyr::left_join( ww_data |> - dplyr::distinct(site) |> - dplyr::mutate(site_index = dplyr::row_number()), + dplyr::distinct(.data$site) |> + dplyr::mutate("site_index" = dplyr::row_number()), by = "site" ) |> dplyr::rename( - lod = {{ lod_col_name }}, - genome_copies_per_ml = {{ conc_col_name }} + "lod" = {{ lod_col_name }}, + "genome_copies_per_ml" = {{ conc_col_name }} ) |> dplyr::mutate( lab_site_name = glue::glue("Site: {site}, Lab: {lab}"), - below_lod = ifelse(genome_copies_per_ml <= lod, 1, 0) + below_lod = ifelse(.data$genome_copies_per_ml <= .data$lod, 1, 0) ) # Get an extra column that identifies the wastewater outliers using the @@ -125,8 +125,8 @@ preprocess_count_data <- function(count_data, count_data_preprocessed <- count_data |> dplyr::rename( - count = {{ count_col_name }}, - total_pop = {{ pop_size_col_name }} + "count" = {{ count_col_name }}, + "total_pop" = {{ pop_size_col_name }} ) return(count_data_preprocessed) @@ -166,8 +166,8 @@ flag_ww_outliers <- function(ww_data, log_conc_threshold = 3, threshold_n_dps = 1) { n_dps <- ww_data |> - dplyr::filter(below_lod == 0) |> - dplyr::group_by(lab_site_index) |> + dplyr::filter(.data$below_lod == 0) |> + dplyr::group_by(.data$lab_site_index) |> dplyr::summarise(n_data_points = dplyr::n()) # Get the ww statistics we need for outlier detection @@ -178,20 +178,20 @@ flag_ww_outliers <- function(ww_data, # exclude below LOD from z scoring and remove lab-sites with too # few data points dplyr::filter( - below_lod == 0, - n_data_points > threshold_n_dps + .data$below_lod == 0, + .data$n_data_points > !!threshold_n_dps ) |> - dplyr::group_by(lab_site_index) |> - dplyr::arrange(date, "desc") |> + dplyr::group_by(.data$lab_site_index) |> + dplyr::arrange(.data$date, "desc") |> dplyr::mutate( - log_conc = log(!!rlang::sym(conc_col_name)), - prev_log_conc = dplyr::lag(log_conc, 1), - prev_date = dplyr::lag(date, 1), - diff_log_conc = log_conc - prev_log_conc, - diff_time = as.numeric(difftime(date, prev_date)), - rho = diff_log_conc / diff_time + log_conc = log(.data[[conc_col_name]]), + prev_log_conc = dplyr::lag(.data$log_conc, 1), + prev_date = dplyr::lag(.data$date, 1), + diff_log_conc = .data$log_conc - .data$prev_log_conc, + diff_time = as.numeric(difftime(.data$date, .data$prev_date)), + rho = .data$diff_log_conc / .data$diff_time ) |> - dplyr::select(date, lab_site_index, rho) |> + dplyr::select("date", "lab_site_index", "rho") |> dplyr::distinct() # Combine stats with ww data @@ -202,40 +202,41 @@ flag_ww_outliers <- function(ww_data, ww_z_scored <- ww_rho |> dplyr::left_join( ww_rho |> - dplyr::group_by(lab_site_index) |> + dplyr::group_by(.data$lab_site_index) |> dplyr::summarise( - mean_rho = mean(rho, na.rm = TRUE), - std_rho = sd(rho, na.rm = TRUE), - mean_conc = mean(!!rlang::sym(conc_col_name), na.rm = TRUE), - std_conc = sd(!!rlang::sym(conc_col_name), na.rm = TRUE) + mean_rho = mean(.data$rho, na.rm = TRUE), + std_rho = sd(.data$rho, na.rm = TRUE), + mean_conc = mean(.data[[conc_col_name]], na.rm = TRUE), + std_conc = sd(.data[[conc_col_name]], na.rm = TRUE) ), by = "lab_site_index" ) |> - dplyr::group_by(lab_site_index) |> - mutate( - z_score_conc = (!!rlang::sym(conc_col_name) - mean_conc) / std_conc, - z_score_rho = (rho - mean_rho) / std_rho + dplyr::group_by(.data$lab_site_index) |> + dplyr::mutate( + z_score_conc = (.data[[conc_col_name]] - .data$mean_conc) / + .data$std_conc, + z_score_rho = (.data$rho - .data$mean_rho) / .data$std_rho ) |> dplyr::mutate( - z_score_rho_t_plus_1 = dplyr::lead(z_score_rho, 1), + z_score_rho_t_plus_1 = dplyr::lead(.data$z_score_rho, 1), flagged_for_removal_conc = dplyr::case_when( - abs(z_score_conc) >= log_conc_threshold ~ 1, - is.na(z_score_conc) ~ 0, + abs(.data$z_score_conc) >= !!log_conc_threshold ~ 1, + is.na(.data$z_score_conc) ~ 0, TRUE ~ 0 ), flagged_for_removal_rho = dplyr::case_when( ( - abs(z_score_rho) >= rho_threshold & - (abs(z_score_rho_t_plus_1) >= rho_threshold) & - sign(z_score_rho != sign(z_score_rho_t_plus_1)) + abs(.data$z_score_rho) >= !!rho_threshold & + (abs(.data$z_score_rho_t_plus_1) >= !!rho_threshold) & + sign(.data$z_score_rho != sign(.data$z_score_rho_t_plus_1)) ) ~ 1, - is.na(z_score_rho) ~ NA, + is.na(.data$z_score_rho) ~ NA, TRUE ~ 0 ) ) |> dplyr::mutate(flag_as_ww_outlier = dplyr::case_when( - flagged_for_removal_rho == 1 ~ 1, - flagged_for_removal_conc == 1 ~ 1, + .data$flagged_for_removal_rho == 1 ~ 1, + .data$flagged_for_removal_conc == 1 ~ 1, TRUE ~ 0 )) |> dplyr::ungroup() |> @@ -246,8 +247,8 @@ flag_ww_outliers <- function(ww_data, ww_w_outliers_flagged <- ww_z_scored |> dplyr::select( colnames(ww_data), - flag_as_ww_outlier, - exclude + "flag_as_ww_outlier", + "exclude" ) return(ww_w_outliers_flagged) @@ -295,7 +296,7 @@ indicate_ww_exclusions <- function(data, # Port over the outliers flagged to the exclude column data_w_exclusions <- data |> dplyr::mutate( - exclude = ifelse(.data[[outlier_col_name]] == 1, 1, exclude) + exclude = ifelse(.data[[outlier_col_name]] == 1, 1, .data$exclude) ) } else { data_w_exclusions <- data diff --git a/R/wwinference-package.R b/R/wwinference-package.R index 1cba7c6c..bdac6131 100644 --- a/R/wwinference-package.R +++ b/R/wwinference-package.R @@ -8,11 +8,12 @@ #' @importFrom tidyr pivot_wider pivot_longer #' @importFrom ggplot2 ggplot facet_wrap geom_line geom_hline geom_point #' geom_bar theme scale_y_continuous scale_colour_discrete scale_fill_discrete -#' geom_ribbon scale_x_date facet_grid geom_vline labs aes ggtitle +#' geom_ribbon scale_x_date facet_grid geom_vline labs aes ggtitle xlab ylab +#' theme_bw element_text geom_step #' @importFrom cmdstanr cmdstan_model #' @importFrom posterior subset_draws as_draws_list #' @importFrom fs path_package -#' @importFrom rlang sym +#' @importFrom rlang sym .data #' @importFrom stats dnbinom dweibull ecdf plogis qlogis rlnorm rnbinom rnorm #' rt sd time #' @importFrom tibble tibble diff --git a/R/wwinference.R b/R/wwinference.R index a69dc144..428def85 100644 --- a/R/wwinference.R +++ b/R/wwinference.R @@ -192,7 +192,10 @@ wwinference <- function(ww_data, if (generate_initial_values) { init_lists <- c() for (i in 1:fit_opts$n_chains) { - init_lists[[i]] <- get_inits_for_one_chain(stan_data_list, params) + init_lists[[i]] <- get_inits_for_one_chain( + stan_data = stan_data_list, + params = model_spec$params + ) } } @@ -208,7 +211,6 @@ wwinference <- function(ww_data, ) if (!is.null(fit$error)) { # If the model errors, return the error message - return(fit$error) } else { convergence_flag_df <- get_model_diagnostic_flags(fit$result) diff --git a/man/compile_model.Rd b/man/compile_model.Rd index 3b15a9ee..d6bc1cea 100644 --- a/man/compile_model.Rd +++ b/man/compile_model.Rd @@ -58,7 +58,7 @@ of \code{\link[cmdstanr:cmdstan_model]{cmdstanr::cmdstan_model()}}. This function reads in and optionally compiles a Stan model. It is written to search the installed package \code{stan} directory for additional source files to include. Within each stan file, -use #include {path to your file with the \code{stan} directory}.stan +use \verb{#include \{path to your file with the stan directory\}.stan} } \details{ The code for this function has been adapted diff --git a/man/simulate_double_censored_pmf.Rd b/man/simulate_double_censored_pmf.Rd index 81845c3e..bcaf91b6 100644 --- a/man/simulate_double_censored_pmf.Rd +++ b/man/simulate_double_censored_pmf.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/delay_distribs.R \name{simulate_double_censored_pmf} \alias{simulate_double_censored_pmf} -\title{Simulate daily double censored PMF. From {epinowcast}: +\title{Simulate daily double censored PMF. From epinowcast: https://package.epinowcast.org/dev/reference/simulate_double_censored_pmf.html #nolint} \usage{ simulate_double_censored_pmf( diff --git a/tests/testthat/test_preprocess_count_data.R b/tests/testthat/test_preprocess_count_data.R index 716c4ab3..1ea3a2ef 100644 --- a/tests/testthat/test_preprocess_count_data.R +++ b/tests/testthat/test_preprocess_count_data.R @@ -91,7 +91,7 @@ test_that("Population size column is renamed correctly", { }) test_that("Function handles missing columns with an error", { - incomplete_hosp_data <- hosp_data |> dplyr::select(-daily_admits) + incomplete_hosp_data <- hosp_data |> dplyr::select(-"daily_admits") expect_error(preprocess_count_data(incomplete_hosp_data, diff --git a/tests/testthat/test_preprocess_ww_data.R b/tests/testthat/test_preprocess_ww_data.R index 05bd90f9..f7eff727 100644 --- a/tests/testthat/test_preprocess_ww_data.R +++ b/tests/testthat/test_preprocess_ww_data.R @@ -40,7 +40,7 @@ test_that("Concentration column is renamed correctly", { # Test that LOD column is renamed correctly test_that("LOD column is renamed correctly", { ww_data_test <- ww_data |> - dplyr::rename(LOD = lod) + dplyr::rename("LOD" = "lod") processed <- preprocess_ww_data(ww_data_test, conc_col_name = "conc", lod_col_name = "LOD" From 3a26b38e2c6e7365f8444f89f7db1e096826b372 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Tue, 3 Sep 2024 19:11:41 -0400 Subject: [PATCH 03/46] update hierarchical estimate of sigma_site in `model_definition` (#120) * add a space * update hierarchical estimate of sigma_site * update prior table * run pre-commit * update comment when transforming to site level standard deviations * add to change log * Update inst/stan/wwinference.stan Co-authored-by: Dylan H. Morris * Update model_definition.md Co-authored-by: Dylan H. Morris * Update model_definition.md Co-authored-by: Dylan H. Morris * Update model_definition.md Co-authored-by: Dylan H. Morris * update notation for mode and sd of stdevs * Update model_definition.md Co-authored-by: Dylan H. Morris * Update model_definition.md Co-authored-by: Dylan H. Morris * Update model_definition.md Co-authored-by: Dylan H. Morris * tweaks to formatting * Update model_definition.md Co-authored-by: Dylan H. Morris --------- Co-authored-by: Dylan H. Morris --- NEWS.md | 1 + inst/stan/wwinference.stan | 3 ++- model_definition.md | 13 ++++++++++++- 3 files changed, 15 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 79e938d3..3f8ec69a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,3 +9,4 @@ This will serve as our change-log - 2024-08-22: Update `generate_simulated_data()` function to modularize the model components, adding additional forward simulation functions. - 2024-08-23: Added new `wwinference_fit` class with corresponding print and summary methods. +- 2024-08-30: Fix bug in how hierarchical standard deviation in the wastewater observation model was being estimated. Update model definition. diff --git a/inst/stan/wwinference.stan b/inst/stan/wwinference.stan index f80a41e1..0440fdde 100644 --- a/inst/stan/wwinference.stan +++ b/inst/stan/wwinference.stan @@ -265,7 +265,8 @@ transformed parameters { exp_obs_log_v = exp_obs_log_v_true + ww_site_mod[ww_sampled_lab_sites]; // Option to add a population offset here at some point log(model_V) + site_level_multiplier+ pop_ww[ww_sampled_sites] - // Get the transformed lab-site level error (NCP for sigma_site ~ n(mean_sigma_site, sigma_sigma_ww_site)) + // Get the transformed lab-site level error + // log(sigma_site) ~ Normal(log(mode_sigma_site), sd_log_sigma_site) sigma_ww_site = exp( log(mode_sigma_ww_site) + sd_log_sigma_ww_site * eta_log_sigma_ww_site); diff --git a/model_definition.md b/model_definition.md index 65399bb7..f7b1a34f 100644 --- a/model_definition.md +++ b/model_definition.md @@ -204,7 +204,15 @@ Genome concentration measurements can vary between sites, and even within a site $$\log[c_{ijt}] \sim \mathrm{Normal}(\log[M_{ij} C_i(t)], \sigma_{cij})$$ -Both $M_{ij}$ and $\sigma_{cij}$ are modeled as site-level random effects. +Both $M_{ij}$ and $\sigma_{cij}$ are estimated hierarchically such that: + +$$\log(M_{ij}) \sim \mathrm{Normal}(0, \sigma_m)$$ + +such that $M_{ij}$ is centered around 1 and + +$$\log(\sigma_{cij}) \sim \mathrm{Normal}(\log(\hat{\sigma}\_c), \sigma\_{\log \sigma\_c})$$ + +See [Prior Distributions](#prior-distributions) for priors on $\sigma_m$, $\hat{\sigma}\_c$ and $\sigma\_{\log \sigma\_c}$. In the rare cases when a site submits multiple concentrations for a single date and lab method, we treat each record as an independent observation. @@ -249,6 +257,9 @@ We use informative priors for parameters that have been well characterized in th | Initial exponential growth rate | $r \sim \mathrm{Normal}(0, 0.01)$ | Chosen to assume flat dynamics prior to observations | | Infection feedback term | $\gamma \sim \mathrm{logNormal}(6.37, 0.4)$ | Weakly informative prior chosen to have a mode of 500 in natural scale, based on posterior estimates of peaks from prior seasons in a few jurisdictions | | Day of the week effects | $\frac{\vec{\omega}}{7} \sim \mathrm{Dirichlet}(5, 5, 5, 5, 5, 5, 5)$ | Weakly informative prior with a mode at even daily reporting (no effects) | +| Standard deviation of the log of the site-lab level multiplier $M_{ij}$ | $\sigma_m \sim \mathrm{Normal}(0, 0.25) $ | Weakly informative prior chosen to allow average magnitude of concentrations to be either similar or different among individual sites, depending on data | +| Modal site-level observation standard deviation | $\hat{\sigma}\_c \sim \mathrm{Normal}(1,1)$ | Weakly informative prior chosen to allow the mode to be either small or large | +| Standard deviation of the Normal distribution of individual log observation standard deviations $\log(\sigma\_{cij})$ (site-lab combination specific, with an inferred modal s.d. $\hat{\sigma}\_c$) | $\sigma\_{\log \sigma\_c} \sim \mathrm{Normal}(0, \log(2))$ | Weakly informative prior which allows for individual s.d.s to be either clustered around the mode or more dispersed | ### Scalar parameters From 03c903010169dc4d96852ec618651591bb7ec9e5 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Wed, 4 Sep 2024 17:07:28 -0400 Subject: [PATCH 04/46] Vignette tweaks (#141) * fix typo in indicate ww exclusions documentation * fix typos/language in vignette * Update R/preprocessing.R Co-authored-by: Chirag Kumar * update docs --------- Co-authored-by: Chirag Kumar --- R/preprocessing.R | 3 ++- man/indicate_ww_exclusions.Rd | 3 ++- vignettes/wwinference.Rmd | 33 ++++++++++++++++++++------------- 3 files changed, 24 insertions(+), 15 deletions(-) diff --git a/R/preprocessing.R b/R/preprocessing.R index 9398e30d..0e80fa5e 100644 --- a/R/preprocessing.R +++ b/R/preprocessing.R @@ -258,7 +258,8 @@ flag_ww_outliers <- function(ww_data, #' @description This function takes in a dataframe which contains an outlier #' column name specified by the `outlier_col_name`. #' -#' @param data A dataframe of preprocessed data to be used to fit the o +#' @param data A dataframe containing a column indicating outliers, called +#' `outlier_col_name`. #' @param outlier_col_name A character string indicating the name of the column #' containing the outlier indicator, must contain only 0 or 1 #' @param remove_outliers A boolean indicating whether or not to exclude the diff --git a/man/indicate_ww_exclusions.Rd b/man/indicate_ww_exclusions.Rd index bb7d7c49..0df75dee 100644 --- a/man/indicate_ww_exclusions.Rd +++ b/man/indicate_ww_exclusions.Rd @@ -11,7 +11,8 @@ indicate_ww_exclusions( ) } \arguments{ -\item{data}{A dataframe of preprocessed data to be used to fit the o} +\item{data}{A dataframe containing a column indicating outliers, called +\code{outlier_col_name}.} \item{outlier_col_name}{A character string indicating the name of the column containing the outlier indicator, must contain only 0 or 1} diff --git a/vignettes/wwinference.Rmd b/vignettes/wwinference.Rmd index 3aa14143..6cfd6754 100644 --- a/vignettes/wwinference.Rmd +++ b/vignettes/wwinference.Rmd @@ -25,6 +25,9 @@ In this quick start, we demonstrate using `wwinference` to specify and fit a minimal model using daily COVID-19 hospital admissions from a "global" population and viral concentrations in wastewater from a few "local" wastewater treatment plants, which come from subsets of the larger population. +In this context, when we say "global", we are referring to a larger +population e.g. a state, and when we say "local" we are referring to a smaller +subset of that population, e.g. a municipality within that state. This is intended to be used as a reference for those interested in fitting the `wwinference` model to their own data. @@ -47,8 +50,8 @@ from the larger "global" population, and wastewater concentration data from wastewater treatment plants whose catchment areas are contained within the larger "global" population. For this quick start, we will use simulated data, modeled after a hypothetical US state with 4 wastewater -treatmentplants (also referred to as sites) reporting data on viral -concentrations of SARS-COV-2, processed in 3 different labs, covering about 70% +treatment plants (also referred to as sites) reporting data on viral +concentrations of SARS-COV-2, processed in 3 different labs, covering about 25% of the state's population. This simulated data contains daily counts of the total hospital admissions in a hypothetical US state from September 1, 2023 to November 29, 2023. It contains wastewater concentration data spanning from @@ -99,11 +102,12 @@ pre-processing to add some additional variables that the model will need to be able apply features such as outlier exclusion and censoring of values below the limit of detection. + ## Parameters -Get the default parameters from the package. Note that some of these are COVID -specific, others are more general to the model. This is indicated in the -.toml file. +Get the example parameters from the package, which we will use here. +Note that some of these are COVID specific, others are more general to the +model, as indicated in the .toml file. ```{r get-params} params <- get_params( @@ -121,7 +125,7 @@ the unique combinations of labs and sites, since this is the unit we will use for estimating the observation error in the reported measurements. Second it adds a column `below_lod` which is an indicator of whether the reported concentration is above or below the limit of detection (LOD). If the -point is below the LOD, the model will treat this observation as censored. +observation is below the LOD, the model will treat this observation as censored. Third, it adds a column `flag_as_ww_outlier` that indicates whether the measurement is identified as an outlier by our algorithm and the default thresholds. While the default choice will be to exclude the measurements flagged @@ -199,10 +203,13 @@ ggplot(hosp_data_preprocessed) + theme_bw() ``` +The closed circles indicate the data the model will be calibrated to, while +the open circles indicate data we later observe after the forecast date. + ## Data exclusion As an optional additional pre-processing step, the user can decide to exclude -certain data points from being included in the model fit procedure. For example, +certain data points in the model fit procedure. For example, we recommend excluding the flagged wastewater concentration outliers. To do so we will use the `indicate_ww_exclusions()` function, which will add the flagged outliers to the exclude column where indicated. @@ -220,7 +227,7 @@ ww_data_to_fit <- wwinference::indicate_ww_exclusions( We will need to set some metadata to facilitate model specification. This includes: - forecast date (the date we are making a forecast) - number of days to calibrate the model for -- number of days to forecast +- number of days to forecast beyond the forecast date - specification of the generation interval, in this case for COVID-19 - specification of the delay from infection to the count data, in this case from infection to COVID-19 hospital admission @@ -244,18 +251,18 @@ forecast_horizon <- 28 ## Delay distributions -We will pass in some probabiltiy mass functions (pmfs) that are specific to +We will pass in probability mass functions (PMFs) that are specific to COVID, and to the delay from infections to hospital admissions, the count -data we are using to fit th emodel. If using a different pathogen or a -different count dataset, these pmfs need to be replaced. We provide them as -package data here. These are both vectors of simplexes (they must sum to 1). +data we are using to fit the model. If using a different pathogen or a +different count dataset, these PMFs need to be replaced. We provide them as +package data here. The model expects that these are discrete daily PMFs. Additionally, the model requires specifying a delay distribution for the infection feedback term, which essentially describes the delay at which high incident infections results in negative feedback on future infections (due to susceptibility, behavior changes, policies to reduce transmission, etc.). We by default set this as the generation interval, but this can be -modified as long as the values sum to 1. +modified with any discrete daily PMF. ```{r set-delay-distributions} generation_interval <- wwinference::default_covid_gi From 4dc56d51760f9f48cbcaade877184ed2f2ab8135 Mon Sep 17 00:00:00 2001 From: kaitejohnson Date: Thu, 5 Sep 2024 14:02:48 -0400 Subject: [PATCH 05/46] actually set seed --- tests/testthat/test_get_stan_data.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test_get_stan_data.R b/tests/testthat/test_get_stan_data.R index 65c0d5a9..d2d9928f 100644 --- a/tests/testthat/test_get_stan_data.R +++ b/tests/testthat/test_get_stan_data.R @@ -1,4 +1,4 @@ -seed <- 123 +set.seed(123) ww_data <- tibble::tibble( date = rep(seq( From 80ea140d4c0ab46ce496ce57f3e3920745bf11d5 Mon Sep 17 00:00:00 2001 From: "Dylan H. Morris" Date: Thu, 5 Sep 2024 14:32:17 -0400 Subject: [PATCH 06/46] Set seeds in test_get_stan_data (#146) Co-authored-by: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> --- tests/testthat/test_get_stan_data.R | 101 +++++++++++++++------------- 1 file changed, 53 insertions(+), 48 deletions(-) diff --git a/tests/testthat/test_get_stan_data.R b/tests/testthat/test_get_stan_data.R index d2d9928f..ed72da11 100644 --- a/tests/testthat/test_get_stan_data.R +++ b/tests/testthat/test_get_stan_data.R @@ -1,17 +1,17 @@ -set.seed(123) - -ww_data <- tibble::tibble( - date = rep(seq( - from = lubridate::ymd("2023-08-01"), - to = lubridate::ymd("2023-11-01"), - by = "weeks" - ), 2), - site = c(rep(1, 14), rep(2, 14)), - lab = c(rep(1, 28)), - conc = abs(rnorm(28, mean = 500, sd = 50)), - lod = c(rep(20, 14), rep(15, 14)), - site_pop = c(rep(2e5, 14), rep(4e5, 14)) -) +withr::with_seed(123, { + ww_data <- tibble::tibble( + date = rep(seq( + from = lubridate::ymd("2023-08-01"), + to = lubridate::ymd("2023-11-01"), + by = "weeks" + ), 2), + site = c(rep(1, 14), rep(2, 14)), + lab = c(rep(1, 28)), + conc = abs(rnorm(28, mean = 500, sd = 50)), + lod = c(rep(20, 14), rep(15, 14)), + site_pop = c(rep(2e5, 14), rep(4e5, 14)) + ) +}) ww_data_preprocessed <- preprocess_ww_data(ww_data, conc_col_name = "conc", @@ -19,16 +19,17 @@ ww_data_preprocessed <- preprocess_ww_data(ww_data, ) ww_data_filtered <- indicate_ww_exclusions(ww_data_preprocessed) - -hosp_data <- tibble::tibble( - date = seq( - from = lubridate::ymd("2023-07-01"), - to = lubridate::ymd("2023-10-30"), - by = "days" - ), - daily_admits = sample(5:70, 122, replace = TRUE), - state_pop = rep(1e6, 122) -) +withr::with_seed(123, { + hosp_data <- tibble::tibble( + date = seq( + from = lubridate::ymd("2023-07-01"), + to = lubridate::ymd("2023-10-30"), + by = "days" + ), + daily_admits = sample(5:70, 122, replace = TRUE), + state_pop = rep(1e6, 122) + ) +}) count_data <- preprocess_count_data( hosp_data, @@ -109,18 +110,20 @@ test_that(paste0( "expected" ), { # Make wastewater data outside of scope of admissions data - recent_ww_data <- tibble::tibble( - date = rep(seq( - from = lubridate::ymd("2024-08-01"), - to = lubridate::ymd("2024-11-01"), - by = "weeks" - ), 2), - site = c(rep(1, 14), rep(2, 14)), - lab = c(rep(1, 28)), - conc = abs(rnorm(28, mean = 500, sd = 50)), - lod = c(rep(20, 14), rep(15, 14)), - site_pop = c(rep(2e5, 14), rep(4e5, 14)) - ) + withr::with_seed(123, { + recent_ww_data <- tibble::tibble( + date = rep(seq( + from = lubridate::ymd("2024-08-01"), + to = lubridate::ymd("2024-11-01"), + by = "weeks" + ), 2), + site = c(rep(1, 14), rep(2, 14)), + lab = c(rep(1, 28)), + conc = abs(rnorm(28, mean = 500, sd = 50)), + lod = c(rep(20, 14), rep(15, 14)), + site_pop = c(rep(2e5, 14), rep(4e5, 14)) + ) + }) recent_ww_data_preprocessed <- preprocess_ww_data(recent_ww_data, conc_col_name = "conc", @@ -149,18 +152,20 @@ test_that(paste0( )) # Make wastewater data outside of scope of admissions data - old_ww_data <- tibble::tibble( - date = rep(seq( - from = lubridate::ymd("2022-08-01"), - to = lubridate::ymd("2022-11-01"), - by = "weeks" - ), 2), - site = c(rep(1, 14), rep(2, 14)), - lab = c(rep(1, 28)), - conc = abs(rnorm(28, mean = 500, sd = 50)), - lod = c(rep(20, 14), rep(15, 14)), - site_pop = c(rep(2e5, 14), rep(4e5, 14)) - ) + withr::with_seed(123, { + old_ww_data <- tibble::tibble( + date = rep(seq( + from = lubridate::ymd("2022-08-01"), + to = lubridate::ymd("2022-11-01"), + by = "weeks" + ), 2), + site = c(rep(1, 14), rep(2, 14)), + lab = c(rep(1, 28)), + conc = abs(rnorm(28, mean = 500, sd = 50)), + lod = c(rep(20, 14), rep(15, 14)), + site_pop = c(rep(2e5, 14), rep(4e5, 14)) + ) + }) old_ww_data_preprocessed <- preprocess_ww_data(old_ww_data, conc_col_name = "conc", From e7d2b9ad62ab55b8a1f3ac527e99f501b4af63b1 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Thu, 5 Sep 2024 18:03:13 -0400 Subject: [PATCH 07/46] Modify package to expect log scale concentration values and LODs (#122) --- NEWS.md | 4 +- R/data.R | 27 +++++----- R/figures.R | 12 ++--- R/generate_simulated_data.R | 17 ++++++- R/get_draws_df.R | 22 ++++----- R/get_stan_data.R | 35 +++++-------- R/model_component_fwd_sim.R | 26 ++++------ R/preprocessing.R | 39 +++++++-------- R/validate.R | 25 ++++------ R/wwinference.R | 14 +++--- data/hosp_data.rda | Bin 561 -> 526 bytes data/hosp_data_eval.rda | Bin 655 -> 615 bytes data/true_global_rt.rda | Bin 2169 -> 2187 bytes data/ww_data.rda | Bin 1680 -> 1613 bytes man/flag_ww_outliers.Rd | 2 +- man/format_ww_data.Rd | 4 +- man/generate_simulated_data.Rd | 2 +- man/get_ww_values.Rd | 10 ++-- man/preprocess_ww_data.Rd | 24 ++++----- man/ww_data.Rd | 27 +++++----- man/wwinference.Rd | 14 +++--- scratch/sim_data_script.R | 2 +- tests/testthat/test_flag_as_ww_outliers.R | 23 +++++---- tests/testthat/test_preprocess_ww_data.R | 8 +-- vignettes/wwinference.Rmd | 57 ++++++++++++++++------ 25 files changed, 210 insertions(+), 184 deletions(-) diff --git a/NEWS.md b/NEWS.md index 3f8ec69a..615a2837 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,7 +6,7 @@ This will serve as our change-log - 2024-07-19: Add an example in the vignette to fit the model to only the hospital admissions. Plus a few small tweaks to the vignette. - 2024-08-05: Add input data validation with informative error messaging - 2024-08-09: Add testing and additional validation of the data being passed into the model -- 2024-08-22: Update `generate_simulated_data()` function to modularize the model components, adding additional -forward simulation functions. +- 2024-08-22: Update `generate_simulated_data()` function to modularize the model components, adding additional forward simulation functions. - 2024-08-23: Added new `wwinference_fit` class with corresponding print and summary methods. +- 2024-08-30: Switch from asking users to pass in natural scale wastewater concentration data to asking them to pass in log scale data - 2024-08-30: Fix bug in how hierarchical standard deviation in the wastewater observation model was being estimated. Update model definition. diff --git a/R/data.R b/R/data.R index 3563a85f..1353776e 100644 --- a/R/data.R +++ b/R/data.R @@ -1,12 +1,13 @@ #' Example wastewater dataset. #' #' A dataset containing the simulated wastewater concentrations -#' (labeled here as `genome_copies_per_ml`) by sample collection date (`date`), -#' the site where the sample was collected (`site`) and the lab where the -#' samples were processed (`lab`). Additional columns that are required -#' attributes needed for the model are the limit of detection for that lab on -#' each day (labeled here as `lod`) and the population size of the wastewater -#' catchment area represented by the wastewater concentrations in each `site`. +#' (labeled here as `log_genome_copies_per_ml`) by sample collection date +#' (`date`), the site where the sample was collected (`site`) and the lab +#' where the samples were processed (`lab`). Additional columns that are +#' required attributes needed for the model are the limit of detection for +#' that lab on each day (labeled here as `log_lod`) and the population size of +#' the wastewater catchment area represented by the wastewater concentrations +#' in each `site`. #' #' This data is generated via the default values in the #' `generate_simulated_data()` function. They represent the bare minumum @@ -22,13 +23,13 @@ #' YYYY-MM-DD} #' \item{site}{The wastewater treatment plant where the sample was collected} #' \item{lab}{The lab where the sample was processed} -#' \item{genome_copies_per_ml}{The wastewater concentration measured on the -#' date specified, collected in the site specified, and processed in the lab -#' specified. The default parameters assume that this quantity is reported -#' as the genome copies per mL, on a natural scale.} -#' \item{lod}{The limit of detection in the site and lab on a particular day -#' of the quantification device (e.g. PCR). This is also by default reported -#' in terms of the genome copies per mL.} +#' \item{log_genome_copies_per_ml}{The natural log of the wastewater +#' concentration measured on the date specified, collected in the site +#' specified, and processed in the lab specified. The package expects +#' this quantity in units of log estimated genome copies per mL.} +#' \item{log_lod}{The log of the limit of detection in the site and lab on a +#' particular day of the quantification device (e.g. PCR). This should be in +#' units of log estimated genome copies per mL.} #' \item{site_pop}{The population size of the wastewater catchment area #' represented by the site variable} #' } diff --git a/R/figures.R b/R/figures.R index c87f84fc..ee6b95ae 100644 --- a/R/figures.R +++ b/R/figures.R @@ -33,7 +33,7 @@ get_plot_forecasted_counts <- function(draws, sampled_draws <- sample(1:max(draws$draw), n_draws_to_plot) draws_to_plot <- draws |> dplyr::filter( - .data$name == "pred_counts", + .data$name == "predicted counts", .data$draw %in% !!sampled_draws ) @@ -97,7 +97,7 @@ get_plot_ww_conc <- function(draws, draws_to_plot <- draws |> dplyr::filter( - .data$name == "pred_ww", + .data$name == "predicted wastewater", .data$draw %in% !!sampled_draws ) |> dplyr::mutate( @@ -107,14 +107,14 @@ get_plot_ww_conc <- function(draws, p <- ggplot(draws_to_plot) + geom_line( aes( - x = .data$date, y = log(.data$pred_value), + x = .data$date, y = .data$pred_value, color = .data$subpop, group = .data$draw ), alpha = 0.1, linewidth = 0.2, show.legend = FALSE ) + - geom_point(aes(x = .data$date, y = log(.data$observed_value)), + geom_point(aes(x = .data$date, y = .data$observed_value), color = "black", show.legend = FALSE ) + facet_wrap(~site_lab_name, scales = "free") + @@ -123,7 +123,7 @@ get_plot_ww_conc <- function(draws, linetype = "dashed" ) + xlab("") + - ylab("Log(Genome copies/mL)") + + ylab("Log genome copies/mL") + ggtitle("Lab-site level wastewater concentration") + scale_x_date( date_breaks = "2 weeks", @@ -225,7 +225,7 @@ get_plot_subpop_rt <- function(draws, sampled_draws <- sample(1:max(draws$draw), n_draws_to_plot) draws_to_plot <- draws |> dplyr::filter( - .data$name == "subpop R(t)", + .data$name == "subpopulation R(t)", .data$draw %in% !!sampled_draws ) diff --git a/R/generate_simulated_data.R b/R/generate_simulated_data.R index 0a3bf3a8..f2883407 100644 --- a/R/generate_simulated_data.R +++ b/R/generate_simulated_data.R @@ -115,7 +115,7 @@ generate_simulated_data <- function(r_in_weeks = # nolint sd_reporting_freq = 1 / 20, mean_reporting_latency = 7, sd_reporting_latency = 3, - mean_log_lod = 3.8, + mean_log_lod = 5, sd_log_lod = 0.2, global_rt_sd = 0.03, sigma_eps = 0.05, @@ -382,6 +382,7 @@ generate_simulated_data <- function(r_in_weeks = # nolint ) + # Global adjusted R(t) -------------------------------------------------- # I(t)/convolve(I(t), g(t)) #nolint # This is not used directly, but we want to have it for comparing to the @@ -405,6 +406,20 @@ generate_simulated_data <- function(r_in_weeks = # nolint lod_lab_site = lod_lab_site ) + # Artificially add values below the LOD---------------------------------- + # Replace it with an NA, will be used as an example of how to format data + # properly. + min_ww_val <- min(ww_data$log_genome_copies_per_ml) + ww_data <- ww_data |> + dplyr::mutate( + "log_genome_copies_per_ml" = + dplyr::case_when( + .data$log_genome_copies_per_ml == + !!min_ww_val ~ 0.5 * .data$log_lod, + TRUE ~ .data$log_genome_copies_per_ml + ) + ) + # Make a hospital admissions dataframe for model calibration hosp_data <- format_hosp_data(pred_obs_hosp, diff --git a/R/get_draws_df.R b/R/get_draws_df.R index 914159bb..60d2eebe 100644 --- a/R/get_draws_df.R +++ b/R/get_draws_df.R @@ -99,7 +99,7 @@ get_draws_df.data.frame <- function(x, dplyr::rename("pred_value" = "pred_hosp") |> dplyr::mutate( draw = .data$`.draw`, - name = "pred_counts" + name = "predicted counts" ) |> dplyr::select("name", "t", "pred_value", "draw") |> dplyr::left_join(date_time_spine, by = "t") |> @@ -118,7 +118,7 @@ get_draws_df.data.frame <- function(x, lab = NA, site_pop = NA, below_lod = NA, - lod = NA, + log_lod = NA, flag_as_ww_outlier = NA, exclude = NA ) |> @@ -129,8 +129,7 @@ get_draws_df.data.frame <- function(x, dplyr::rename("pred_value" = "pred_ww") |> dplyr::mutate( draw = .data$`.draw`, - name = "pred_ww", - pred_value = exp(.data$pred_value) + name = "predicted wastewater", ) |> dplyr::select("name", "lab_site_index", "t", "pred_value", "draw") |> dplyr::left_join(date_time_spine, by = "t") |> @@ -144,9 +143,9 @@ get_draws_df.data.frame <- function(x, ) ) |> dplyr::ungroup() |> - dplyr::mutate(observed_value = .data$genome_copies_per_ml) |> + dplyr::mutate(observed_value = .data$log_genome_copies_per_ml) |> dplyr::mutate( - observation_type = "genome copies per mL", + observation_type = "log genome copies per mL", type_of_quantity = "local", total_pop = NA, subpop = glue::glue("Site: {site}") @@ -178,7 +177,7 @@ get_draws_df.data.frame <- function(x, lab = NA, site_pop = NA, below_lod = NA, - lod = NA, + log_lod = NA, flag_as_ww_outlier = NA, exclude = NA ) |> @@ -189,7 +188,7 @@ get_draws_df.data.frame <- function(x, dplyr::rename("pred_value" = "r_site_t") |> dplyr::mutate( draw = .data$`.draw`, - name = "subpop R(t)", + name = "subpopulation R(t)", pred_value = .data$pred_value ) |> dplyr::select("name", "site_index", "t", "pred_value", "draw") |> @@ -201,7 +200,7 @@ get_draws_df.data.frame <- function(x, lab_site_index = NA, lab = NA, below_lod = NA, - lod = NA, + log_lod = NA, flag_as_ww_outlier = NA, exclude = NA, observation_type = "latent variable", @@ -213,12 +212,13 @@ get_draws_df.data.frame <- function(x, ) |> dplyr::select(colnames(count_draws), -"t") - draws_df <- dplyr::bind_rows( + all_draws_df <- dplyr::bind_rows( count_draws, ww_draws, global_rt_draws, site_level_rt_draws ) - return(draws_df) + + return(all_draws_df) } diff --git a/R/get_stan_data.R b/R/get_stan_data.R index 89082077..7bfbb4e3 100644 --- a/R/get_stan_data.R +++ b/R/get_stan_data.R @@ -60,8 +60,8 @@ get_input_ww_data_for_stan <- function(preprocessed_ww_data, # Test for presence of needed column names check_req_ww_cols_present(preprocessed_ww_data, - conc_col_name = "genome_copies_per_ml", - lod_col_name = "lod" + conc_col_name = "log_genome_copies_per_ml", + lod_col_name = "log_lod" ) # Filter out wastewater outliers, and remove extra wastewater @@ -256,23 +256,18 @@ get_stan_data <- function(input_count_data, # order of the site index, a vector of observations of the log of # the genome copies per ml ww_values <- get_ww_values( - input_ww_data, - ww_measurement_col_name = "genome_copies_per_ml", - ww_lod_value_col_name = "lod", - ww_site_pop_col_name = "site_pop" + input_ww_data ) # Returns a list with the numbers of elements needed for the stan model ww_data_sizes <- get_ww_data_sizes( - input_ww_data, - lod_col_name = "below_lod" + input_ww_data ) # Returns the vectors of indices you need to map latent variables to # observations ww_indices <- get_ww_data_indices( input_ww_data |> dplyr::select(-"t"), first_count_data_date, - owt = ww_data_sizes$owt, - lod_col_name = "below_lod" + owt = ww_data_sizes$owt ) # Ensure that both datasets have overlap with one another, are sufficient # in length for the specified calibration time, and have proper time indexing @@ -609,10 +604,10 @@ get_ww_data_indices <- function(ww_data, #' per observation, with outliers already removed #' @param ww_measurement_col_name A string representing the name of the column #' in the input_ww_data that indicates the wastewater measurement value in -#' natural scale, default is `genome_copies_per_ml` +#' log scale, default is `log_genome_copies_per_ml` #' @param ww_lod_value_col_name A string representing the name of the column -#' in the ww_data that indicates the value of the LOD in natural scale, -#' default is `lod` +#' in the ww_data that indicates the value of the LOD in log scale, +#' default is `log_lod` #' @param ww_site_pop_col_name A string representing the name of the column in #' the ww_data that indicates the number of people represented by that #' wastewater catchment, default is `site_pop` @@ -631,8 +626,8 @@ get_ww_data_indices <- function(ww_data, #' log_conc: a vector of the log of the wastewater concentration observation #' @export get_ww_values <- function(ww_data, - ww_measurement_col_name = "genome_copies_per_ml", - ww_lod_value_col_name = "lod", + ww_measurement_col_name = "log_genome_copies_per_ml", + ww_lod_value_col_name = "log_lod", ww_site_pop_col_name = "site_pop", one_pop_per_site = TRUE, padding_value = 1e-8) { @@ -641,8 +636,7 @@ get_ww_values <- function(ww_data, if (isTRUE(ww_data_present)) { # Get the vector of log LOD values corresponding to each observation ww_lod <- ww_data |> - dplyr::pull({{ ww_lod_value_col_name }}) |> - log() + dplyr::pull({{ ww_lod_value_col_name }}) # Get a vector of population sizes if (isTRUE(one_pop_per_site)) { @@ -665,12 +659,7 @@ get_ww_values <- function(ww_data, # Get the vector of log wastewater concentrations log_conc <- ww_data |> - dplyr::mutate( - log_conc = - (log(.data[[ww_measurement_col_name]] + padding_value)) - ) |> - dplyr::pull(.data$log_conc) - + dplyr::pull({{ ww_measurement_col_name }}) ww_values <- list( ww_lod = ww_lod, pop_ww = pop_ww, diff --git a/R/model_component_fwd_sim.R b/R/model_component_fwd_sim.R index e2e9e1a1..c0d032f8 100644 --- a/R/model_component_fwd_sim.R +++ b/R/model_component_fwd_sim.R @@ -338,8 +338,8 @@ downsample_ww_obs <- function(log_conc_lab_site, #' @param lod_lab_site vector of numerics indicating the LOD in each lab and #' site combination #' -#' @return a tidy dataframe containing the observed wastewater concentrations -#' in each site and lab at each time point +#' @return a tidy dataframe containing observed wastewater concentrations +#' in log genome copies per mL for each site and lab at each time point format_ww_data <- function(log_obs_conc_lab_site, ot, ht, @@ -367,24 +367,18 @@ format_ww_data <- function(log_obs_conc_lab_site, lod_sewage = lod_lab_site ), by = c("lab_site") - ) |> # Remove below LOD values - dplyr::mutate( - lod_sewage = - dplyr::case_when( - is.na(.data$log_conc) ~ NA, - !is.na(.data$log_conc) ~ .data$lod_sewage - ) ) |> - dplyr::mutate( - genome_copies_per_ml = exp(.data$log_conc), - lod = exp(.data$lod_sewage) + dplyr::rename( + "log_lod" = "lod_sewage", + "log_genome_copies_per_ml" = "log_conc", + "site_pop" = "ww_pop" ) |> - dplyr::filter(!is.na(.data$genome_copies_per_ml)) |> - dplyr::rename("site_pop" = "ww_pop") |> + # Remove missing values + dplyr::filter(!is.na(.data$log_genome_copies_per_ml)) |> dplyr::arrange(.data$site, .data$lab, .data$date) |> dplyr::select( - "date", "site", "lab", "genome_copies_per_ml", "lod", - "site_pop" + "date", "site", "lab", "log_genome_copies_per_ml", + "log_lod", "site_pop" ) return(ww_data) diff --git a/R/preprocessing.R b/R/preprocessing.R index 0e80fa5e..2822ff42 100644 --- a/R/preprocessing.R +++ b/R/preprocessing.R @@ -4,16 +4,16 @@ #' date, site_pop, a column for concentration, and a column for the #' limit of detection #' @param conc_col_name string indicating the name of the column containing -#' the concentration measurements in the wastewater data, default is -#' `genome_copies_per_ml` +#' virus genome concentration measurements in log genome copies per mL, +#' default is `log_genome_copies_per_ml` #' @param lod_col_name string indicating the name of the column containing -#' the concentration measurements in the wastewater data, default is -#' `genome_copies_per_ml`. Note that any values in the `conc_col_name` +#' the limits of detection for each wastewater measurement, default is +#' `log_lod_sewage`. Note that any values in the `conc_col_name` #' equal to the limit of detection will be treated as below the limit of #' detection. #' @return a dataframe containing the same columns as ww_data except -#' the `conc_col_name` will be replaced with `genome_copies_per_ml` and -#' the `lod_col_name` will be replaced with `lod` plus the following +#' the `conc_col_name` will be replaced with `log_genome_copies_per_ml` and +#' the `lod_col_name` will be replaced with `log_lod_sewage` plus the following #' additional columns needed for the stan model: #' lab_site_index, site_index, flag_as_ww_outlier, below_lod, lab_site_name, #' exclude @@ -24,17 +24,17 @@ #' date = lubridate::ymd(rep(c("2023-11-01", "2023-11-02"), 2)), #' site = c(rep(1, 2), rep(2, 2)), #' lab = c(1, 1, 1, 1), -#' conc = c(345.2, 784.1, 401.5, 681.8), -#' lod = c(20, 20, 15, 15), +#' log_conc = log(c(345.2, 784.1, 401.5, 681.8)), +#' log_lod = log(c(20, 20, 15, 15)), #' site_pop = c(rep(2e5, 2), rep(4e5, 2)) #' ) #' ww_data_preprocessed <- preprocess_ww_data(ww_data, -#' conc_col_name = "conc", -#' lod_col_name = "lod" +#' conc_col_name = "log_conc", +#' lod_col_name = "log_lod" #' ) preprocess_ww_data <- function(ww_data, - conc_col_name = "genome_copies_per_ml", - lod_col_name = "lod") { + conc_col_name = "log_genome_copies_per_ml", + lod_col_name = "log_lod") { check_req_ww_cols_present( ww_data, conc_col_name, @@ -61,28 +61,29 @@ preprocess_ww_data <- function(ww_data, dplyr::left_join( ww_data |> dplyr::distinct(.data$site) |> - dplyr::mutate("site_index" = dplyr::row_number()), + dplyr::mutate(site_index = dplyr::row_number()), by = "site" ) |> dplyr::rename( - "lod" = {{ lod_col_name }}, - "genome_copies_per_ml" = {{ conc_col_name }} + "log_lod" = {{ lod_col_name }}, + "log_genome_copies_per_ml" = {{ conc_col_name }} ) |> dplyr::mutate( lab_site_name = glue::glue("Site: {site}, Lab: {lab}"), - below_lod = ifelse(.data$genome_copies_per_ml <= .data$lod, 1, 0) + below_lod = ifelse(.data$log_genome_copies_per_ml <= .data$log_lod, 1, 0) ) # Get an extra column that identifies the wastewater outliers using the # default parameters ww_preprocessed <- flag_ww_outliers(ww_data_add_cols, - conc_col_name = "genome_copies_per_ml" + conc_col_name = "log_genome_copies_per_ml" ) return(ww_preprocessed) } + #' Pre-process hospital admissions data, converting column names to those #' that [get_stan_data()] expects. #' @param count_data dataframe containing the following columns: date, @@ -161,7 +162,7 @@ preprocess_count_data <- function(count_data, #' ww_data_preprocessed <- wwinference::preprocess_ww_data(ww_data) #' ww_data_outliers_flagged <- flag_ww_outliers(ww_data_preprocessed) flag_ww_outliers <- function(ww_data, - conc_col_name = "genome_copies_per_ml", + conc_col_name = "log_genome_copies_per_ml", rho_threshold = 2, log_conc_threshold = 3, threshold_n_dps = 1) { @@ -184,7 +185,7 @@ flag_ww_outliers <- function(ww_data, dplyr::group_by(.data$lab_site_index) |> dplyr::arrange(.data$date, "desc") |> dplyr::mutate( - log_conc = log(.data[[conc_col_name]]), + log_conc = .data[[conc_col_name]], prev_log_conc = dplyr::lag(.data$log_conc, 1), prev_date = dplyr::lag(.data$date, 1), diff_log_conc = .data$log_conc - .data$prev_log_conc, diff --git a/R/validate.R b/R/validate.R index 70159001..482e8c62 100644 --- a/R/validate.R +++ b/R/validate.R @@ -19,13 +19,15 @@ validate_ww_conc_data <- function(ww_data, conc_col_name }) arg <- conc_col_name - assert_non_missingness(ww_conc, arg, call) - assert_elements_non_neg(ww_conc, arg, call, - add_err_msg = paste0( - "Note that the model expects natural ", - "scale concentration values, ", - "which must be non-negative" - ) + assert_non_missingness(ww_conc, arg, call, + add_err_msg = + c( + "Package expects that there are no missing", + " values in wastewater concentration data.", + "Observations below the limit of detection must", + " indicate a numeric value less than the limit", + "of detection" + ) ) checkmate::assert_vector(ww_conc) @@ -33,14 +35,7 @@ validate_ww_conc_data <- function(ww_data, lod_col_name }) arg <- "lod_col_name" - assert_non_missingness(ww_lod, arg, ) - assert_elements_non_neg(ww_lod, arg, call, - add_err_msg = paste0( - "Note that the model expects natural ", - "scale LOD values, which must be ", - "non-negative" - ) - ) + assert_non_missingness(ww_lod, arg, call) checkmate::assert_vector(ww_lod) # Wastewater date column should be of date type! diff --git a/R/wwinference.R b/R/wwinference.R index 428def85..547d132a 100644 --- a/R/wwinference.R +++ b/R/wwinference.R @@ -5,9 +5,9 @@ #' Provides a user friendly interface around package functionality #' to produce estimates, nowcasts, and forecasts pertaining to user-specified #' delay distributions, set parameters, and priors that can be modified to -#' handledifferent types of "global" count data and "local" wastewater -#' concentrationdata using a Bayesian hierarchical framework applied to the two -#' distinctdata sources. By default the model assumes a fixed generation +#' handle different types of "global" count data and "local" wastewater +#' concentration data using a Bayesian hierarchical framework applied to the two +#' distinct data sources. By default the model assumes a fixed generation #' interval and delay from infection to the event that is counted. See the #' getting started vignette for an example model specifications fitting #' COVID-19 hospital admissions from a hypothetical state and wasteawter @@ -15,8 +15,8 @@ #' #' @param ww_data A dataframe containing the pre-processed, site-level #' wastewater concentration data for a model run. The dataframe must contain -#' the following columns: `date`, `site`, `lab`, `genome_copies_per_ml`, -#' `lab_site_index`, `lod`, `below_lod`, `site_pop` `exclude` +#' the following columns: `date`, `site`, `lab`, `log_genome_copies_per_ml`, +#' `lab_site_index`, `log_lod`, `below_lod`, `site_pop` `exclude` #' @param count_data A dataframe containing the pre-procssed, "global" (e.g. #' state) daily count data, pertaining to the number of events that are being #' counted on that day, e.g. number of daily cases or daily hospital admissions. @@ -74,8 +74,8 @@ #' ), 2), #' site = c(rep(1, 14), rep(2, 14)), #' lab = c(rep(1, 28)), -#' conc = abs(rnorm(28, mean = 500, sd = 50)), -#' lod = c(rep(20, 14), rep(15, 14)), +#' conc = log(abs(rnorm(28, mean = 500, sd = 50))), +#' lod = log(c(rep(20, 14), rep(15, 14))), #' site_pop = c(rep(2e5, 14), rep(4e5, 14)) #' ) #' diff --git a/data/hosp_data.rda b/data/hosp_data.rda index b81da007ba388fbbfe8e8a79b2aea48d3057bc71..a967a8fb195c34b51fafee0638f4a9b2c13a559c 100644 GIT binary patch literal 526 zcmZ>Y%CIzaj8qGbd>eFm7Xyph|Lgyab6CRv|NmFdA`tLD{mudh21W)41`Z%(U_8Ji zcyQhB2^T}oDs!;)%ryVCiXoBB|Ek3QP@nm)7BDbK^w23uPS2lEvM z#%28)?fOjM+Ga2aHX1H#U|`@CPQL(?gVK!FLdn8sJl)IVe0yi# zj;@})`}QC49~C=3Bu>kocqdd^XKmoa&Bhlk&tE^txjoB^Pq?`o7u07s+xXl627AtE8DAjBYJ!FP_i;o%K0i=@CNB@wTvA3q;D9q-z3D=qH@ z=So%;PEHk-Nk#^ZT3Y9`-CP6|92%KeIG~iIq@>oW4o%1EEi3jc(lpD9-Sk%K`!>6l zh?Vh{FBe)qjoh%={PvnCV`t~!;PnTu^GJ!m<==R2{aUB(K98N%dMn>AcSt|;C};lW z*iLIYXVt@m~5oqo*H0LLijW#&h_GL7MO;Pr-kBPr3>gD&AVU GyaWIOSKA-} literal 561 zcmZ>Y%CIzaj8qGbyf{hJjDbbr|MmaI84T?I|NpN4|M$cH^g9b27#JBG7&w5Cf$;#7 z;DM(*6omv1xV8DH^)kEvTh-Rs{5M3+!6YLs*zr{*hi! zt8BTa?c&L)msA4YALW(Up0?0$^X~aaif*2b+OuOtlZRF=ivrVZhUh=Wr)Hm-cj^0v z^DnPCOyXL7VBz`{Ca8Lqo+^*SsO%$5yi%n63~>JGU)C|!4b_@iX8x!TIgug^Uyd42M)j@I`JOPT!I zK6&pqYH`at<{20jC+OY+mDwBMLfP{be?QL`7<{wG!>FBMM{`3E`)T`7sezEO4 opD#S#uK^8m#(9&qwkR!H#S#+g@47NjdO_?-k%vysZXO{w05sd-WB>pF diff --git a/data/hosp_data_eval.rda b/data/hosp_data_eval.rda index 559fb6e0db88ba36a5fae2fbcbf89e4618889e57..4380d9110f7ea36bf1884750b5a71704e8602bb4 100644 GIT binary patch literal 615 zcmZ>Y%CIzaj8qGbTyk&W7Y5e#|BwGS_6Z694+Ja%4*%2dE_lG;z`y~742%buCe4u& zYcg56h{1%}ZI;>cf2(Gim|T3hDDy?b-&ZRbm@f&MuL}7e!0WhjL6SiOvjYPI1FsaH zk;%!<1t%wSE^|1M!OOVJmxo~%Ge^j>uFM4t%nrP~KqZU|G8n3Q}Gq>9XBgZg=Js+$dP_x}2GTzbjN;?p*Q7hdm$umON(vEvdA4%kQ(&mRxojjOCwK z@9f|Dw}qwL)=FuM*k|jNd~ZD+oID*1`BV+O=DnLH>mO%%c{XE*u!n$wzyU`_0pXhZ z88L@hS_HBZ3^sTI`7E+CZ_b^07YGkGTsm|{_mD??%Y|vz_Pb1&C7kg5XfxZrd)pVE z-+JN1bY%CIzaj8qGbG{4@whkcHn7T?7*YIxPU>@B*~zG!DXsi@K=ruwuX}nC;PG~U*gH&Two;8 z)9_a_>+1&wtblJzvcxfMi5|yAS{p;VIGQdr$#j{lys~<7wAS8k%gUKMZ~l_93fuD4 zG&?){_QtfHTSZwHW^K4W-K%){nJHT|{gvN1G%YcbJ-Aiz!pHa9!rq?ki8A_Ix;Zv` z2JfxS>Dl?!vzK-C?ftMY6xGT)DZ|G3bJ^0!xDji~8-~UNMb23swlR zC^#{=ajXk*1;L_4TDuSKoH={r8q=_Bser4Sxs9E#i|$x-=IhJqy~gu*%)I<-^O{L4 z5=k>Ax;9Pa6jNbwP;zMG=m=<3ahb7UVq57!ub?SQHBpEq$6MAIp3dE|@m5EtlGfgR zUhcA?37s!GUe{>-e17p?*6o$8p}Cg!5#G9<`YK!d&Pi`x;;=ckGca()uiJ6uZXx?- z7@GF)?{{A;yO@<=qIAW`}M(l1^_{uAeR6D diff --git a/data/true_global_rt.rda b/data/true_global_rt.rda index 399520388d6873a1278e61be94909519651c969b..749f9dc000ca8476a94fdcb686f3c7555d86144f 100644 GIT binary patch literal 2187 zcmaKmc{J3G8pnS###kpLUNiPBgt81-!VI#G7Za5&k!7YVQ<99SJ7Vl(#y+7MhRIG% zwi1OaBxX>SDD}#crn1(H^7fv4&OPUzd(Zux=bz{MJ)iSDw!S!XL$uGq6F$nytBU~S z`rd!>Wp8J%>+f{uUlmtyck!4~htE*>4V_BXxvrN|)%o02WELZ<7>8$uY$8ES-bZK( z6=p=FB5@mudFpOR5p*Ff1+7_xT^!ee0$GJty3 zd<+C*Sq9SQ*m9CS!QjiFg?(3HfF0w^UW z0sxE-ys6ei0z4K9frBQY1k}}0yc{NA2ml~98Q_)C5g`B<{`Uf+b9-?B4uNL^@-7-O z@=jJNcxJCrqyx>(u}Z=NA>qtiJ8$JcwXz#mqK~0JDwVN|!$wuCP;0m8I4jhc17s74 z|M<(sA#g<63Dl-(I!k>V%2+R60RA^#HBkjFHA{k@^tlEe1bP#9RZ1_oe9FOrlTD=2 zTWb=2JsGazo#sFW^qU(@5=Bpax5FS^p_;4!po42~D&1t6Tw!a7F6<{%mz90u{oAI| z&jtlU4gTY*zhttiH~3nV!#pbI-@j zY*o2qT;kKw8q*k%;FTRnZh%)hnqwaKk93pD_!x$8b)7x?&;^)R#H{+G3xV|%;qW@! z2{D~;ylSziKLi~--EEywC~eY$&d#H>b_mzTWj%XkUl$6~o6*bQXD*8D&Rlq#;Fr;N z=7az19_R1ziJn?VudP~7ne8^&fpdAE+v8;{w=T-IJ%%m5HP#k{_Pu_QW2C4J?E(F? zz2>a~9aP)`J3~$Pb@Bv~v#*Nl;%D7Q;ach!kGP^m+JUx=>FJz?tBBN~;ohH#{a?`~ zDfg-oe}Ymgu(a_HnS=ot2b^zS2qUzVi$Zq@^c9a4du4j&D*%W+y21 zl{$CdMUhq;JwuOkn*BrEn}*pw^6kO-j{0Fbx?Lc*IxEfkjIv|2{dTeR`bz4tr779H zA8^6}7ArNR`(h5ZL8UQ^ny(9&ZB;54MS57kR(z5tbbrbl*Kp(8^@)>Jypy2 zz)rYSpJ4uu`CK_#$>M2C=Z(8NTJ5E2nSpKdIwg7d!INPUVtvT3eRhOUMi*)JlGO?v zG88u5SQn-D;>}eLc^b6mX~WiSN|B>wRsb1W<1G3h_gRvJz*yN zgA_Hy4+rqqw}Zf%hzaO^na{2>nmNl-6n@Eo@%->auCbh#n$#F1q2$7{C-+rSid3z4 z9h!(+qZEoc=iv%GRJ=CgZsOU+gan-^i?Mp=s1Y9f`(?N|H9}kgQ!D>}@%N|StDx;) zV~*d&!Td+Ne-9J%imI==%TW||?fIlqcSpQ;PA;L-j?{E)&q8F(GVJhsn?!&he-&wX zg!738?R9BoF+dvC@K4s1RZKpNJ|%-->fY zD{PULO%_=90av``FlpqBb~i?HHkx(iZLlfUXZq-2TiL;3%fj@Y5O?QTEfGUyAz#XY zy4M;v%8P*B+cqA?iZe^UsT-A2svR^>4;Np1Z`Td~M%0+{&6N!pX;gD`{gJ+>tkC-4 zOXbg8_oh$TkJ`-=$e=HVgxpIGtr+|9UZ~J1U9WqwVR{1stC9Kj-Abq9xo?6Cw48ED zn-Z_;3IK>v^R46xNyC&5>OfLT&2YT*siGvOx29+B;I!yiWp(&hLBSeQp(!?14|Iba zs}GhsJ*Eh985+mG{%44$Qy{==K5w7o@~+0lQbv|vSKbdKujeF2eBD2H&va* zf4ETtyI`V8)vb1ws6UA$CW?e39F44P`MpM+cM|HgPrhG- z*zq|sX3wxPY(j9XdF!~}>8mG!>Cwjd#yBjvCe_SkGP1P_x~soURLjW5M%x*cf=5_A zSU@APFCuXl96J}?zdJJ6M%f)Q?mY7c!`Q3ndH9Eibi#ls~w7Es7EGVW$M+s}BT z!p9f_rV#F2?@Ka{8)^W{nm6sdoItYHAgAU+-3O3 z2Iv$~E)+n|gx?8_HXrCyh$-gt8+j6Phrp-3mZH(<@&aG!tpXo}{#Pm6nN(`Fm+o%Q3@q8hs-{cb%$6rSaf1 zF+k0?ns}d}ydSk4D!E&8S!Gui0fQf|faWF7mxfHp^M>wwla+F8ghfRAJQk$6b07FJ zvrxU*)o-0)aOdZhn=e7PM)Au#ofqiOKbH!9Ar?`Y-(vhGJy&{2=tq0+Kw{VVbGa_t z+`3P)8i&5hnlTy5$bO+B@ge&hXs#c}L0s+uUo7k?8q%r8FsqiNL>l?q>!P+-Wr7;2 zYoCK|?LtO`KGPzkm<8)5L*C;cPH$p(6pb@rnr?NXXNx z3~{p*j4_#SjKRR@1Xs-11JVqc9K{F5*t70VoC@{kmRZ|5vXOCGE0f8|Zoz~xBz}^j zhQo+tB0wij8yQp54OQ3bDI7!v?--h0fkNejFhdey1oUpp7!3u$!C@!{#xMh5h#LZM zwW+zP3a6YxZ-*8N2UV$vs>1M$#GzCihBwBc@epKy2P&~8&=3j$nFnehFcctoHY~#x zMk8YoWJ=L3X-?_yG@dvB%g2G(00IGsBLD;j-~j-P1{`v@1R%CJ2#zccC?JuQD(vk_ z7@fw4WgNbsaPZeSGyui`5U`9nqeg&?Fh0D&02B@bgMbidkQg$E&6{b;d*4{>g#7<1 z`4cL(o7VmL{Hymn3rDB6Bn*iGCK;Jo6!D{RIsfW4?*jm1pVUseG@uf^z*_$>bumr5 z$tYaxlE$;9$HJpKS_5Of7zE7FhFkdEUr6@fDBa43!)7*j=-D~JA)&Cp%lrrE(4h%1 zg={1}0LW4MyvC8)sMFDBH0Q{a7}Ub^my1jDU$9vIxVd?s#dqb}H!30h1_^}&&6`W- z_Cb>{kt0&F2-SW`nc}?B^7IpL00}#1p}V;tx^un_UJbVD7*W?%Wab>%R&5T#*??(6 zG&MEQx(yEM<&jmC%>_Ug`~@@=#;7-UEz`y|AsFn+t`7}N8_pqLz3(Q_dfdFbWWN0* z&7bKAk781Wk~~lX2q$>8k+r&8icq6=9^O%Hqo8Ri~ z>(+$PMTL%c*4*j-a@Mj}t0)@dys4mF-IXLZHnQvxI>Ey$kuHCHm=91nI^l^a-hnyL ze5Hi#SK-SBxs&&3H3Hc|c|Y&T3s$&@MxA>)Q052(S=dY}B*4}eei2ocwO<<|Qj)Ap zKFfoXhAX&HqHBJmneS5I-LdL<1-5IkIP*>ujZMX9NC;O;E43jcVTl&2g6Ex5*6@K} zX>YE8jy#&nU+7-yHvU%Z4gRpkP`_0cT|azERPn;cp7jUS*S#kzgzrMR!IvVcGk*a~ zy3PCVi}KXGv+|L+^a0ll->xxy%4;t`HpQiWWMiInBL!_MaZ29(T$pT+4qg#;Z$(Td zCa^?see%v})|C4V)n0c)18i->R}p!6_e^Ca__X6j#lC4J5d^Ve&1r|5eby5B^4cL~ znbq}G!mg$Lt&!DP*@>U}$4+ge#x=@4b7|mD)$gxQ$R)-Zu0IT6+AcX+hnrx_hS>UF zeGQ;TL_BY|=+`OS^Z(8#-8vBv=*%xRfXZA*fC}b_jki(Nth+;ezT&C0bB#sDhB1(5>P+S1$=^sp}sp8tUv^>`kVL1 zIS>VFJ>HWP^lPM|wK6;VP#vwI2u|P-d`B}i)zq>%fbY#6A-@+6d3~kJprknwbO-AF z6KUx{j`b)z@km^~)Gki%h(9Fv8CuUTBt>y#km+)bKcj=QM}FP&_9_l5Y;^Boe|2c~ z0L%BPisc;pYxb0#+7y`6l(OZwD|*F7ag-iS z^q#cB$(uf&Pw+mp+-Ch8nYPL?_G05}>csVbE<);A7OY5F@z3%UIEZMMr{q|t%kol% zN(n<^^)?OQ`SGiB+FgD}oy_%SHuln38qd_+CcOsVDa?R9VZpMQ*&am|=T1I)(%UiE zV0JQSOU@cAaI^i!@tbA^^#;D+G27`-`YWtbGIzYP6+Ts5-JwJ9{K(QRU`phP>qIQ_anA=mgj`1Lp z*_j^`51wZSUv=@L*Y5_+y3;PQV3Lc&_84_5SM$BjP2{BqvA-5trEiu4YnG3G{fCpp zk$%6MmVPKUbS?4tcwEg;FX&-gbi4q5e058zyVqaCUogTJ$pX)6Ab_|vN10NAgz9k~ za`!b!8gM<3`}U)gL6Q0`wW#3Z{?q9LoLws=a^}9tZ|t(h+0hr_gg_|nysNgdJ~*1~ zWS_nQvDBj`1;#6{An$laR}p4RedF^6bWOICc_QDKK7f`Rgz`j&tRjK{pWsdO$Lh8Z%#m463QcXuwtTZD9@C;S&4#?IE^3WL)yCwA3jOc;QGZUPqzra z#4sQUoe|ra#V*r14qQcK)u;#sSBT z?0Y>JRgLem9OTJX&oxfV+oJ>nR{92eBB>aYBZogbhcez#4;1G-;8eLn9L!fXRvEO%G9%Kxi606Gnq* zn^Q(inKaslOpP9+N2K)uk)vpaMvVZ(^coWh>S)MmnoQ6_6e!bB(4M9GN3skJoTs69_mX`zv_jXg)GJpfFNq75-HCYXkUAoT!xfHX20FqoM% z$kRuuh-ffkQc30000D00000000001d>rEjWRURqaf2DGynh^ z0002cGz}U6(?9?K8X5oq00000&;S4c8UO$Swj|OBBgqJ$l3>Z0Fi0c!(Wl2cGZCqNJ{W@*^)^EreNeDDZ>Z^ zL%nbyh9<0>F+F6_lP9pqN#D28m#U3RDcl*;w_OfVQd)} zhAgZEn;xbFP1@3jwHL%K{s$ZZBN&Oxq6Avzb}kMNnj=Jvpa5Z@NCGd(k+!qMb^F$c zdeD+>xsgOZCK_}fl-kx z8l=QXR(IG}MBR}=WD-{=VLA>u>{{9tqTig1w^I80^dCDstHl6FqeR-Xhz@Qa3V>!v zMn^qRktebye1jV@qKyQJp^zXUrSZcslEgEB24FxzXpo57N(Aa+0pdxcz#iD5U-kT7 zPPVKl7;=miaF77aHWHN%O2L$bE<;ElW39SCZ1PzwFAz_Zi{aq}fQmp25_A|c0HKnq zL9gNJlgxS|xz+P>R;j#vrYcny=3$=OaUBSAG*j=(*%<%2%3`u6Heo0lG6@7yAtF*B zq*6$PfC&JRNCJ^a1c5!qIOnkjDWq3c)bO9M9DA^;5!|CM*k9B(gU+^-^PuBAW$$@you`>o8<0uWp4 z=W5+~u`nB$V`(%hg_TnC(<-^ru$f?u253WJX_G)q8wg%@0FJftQ-4lRTSInaAQ#=8?&>-@A7(vClme!u{bE#L$|2zlewuFWzDC?njnJPYgQjA(11yqI45gK&k^1M5GUug zNT7rSr|{sk#{vPXbJZfSeK{2kf90AG7Wo&8vH>yr>paDV77CorjFU6W% zONK`fS9@_7aU_N2V8ih(i00`-XW-E+gA}kkYjU^EP7O$|K zbaWLgc7A9VNG1#ec#=0*uk2p@RbYTkfCCmmjl6&c6SwEn{~;9BO&;|*8e9S(b$V^> zqA(E=|HyxyQk+pD;aSy-E;Xn0TgLz+}l4fBr7y Lig2MJs+Wf1F#& zrqDs5pbZ9q+JTS&0BH2lG|*^d(=|ONhC>K6#)KbXLm?jaXk3&G7qtx;mnKF8SJfkP5$N{5636ZoWCYYHpjGm^9f$9%Q z>K>qC1|o^-ff&dpYA_l`37VTpr=SGH$aw)Y$$=RdBLDy+1k(VT4492FWW>bN0%XE4 zModFS4FobU353anKmZy50000000Te)pa1{>10VnZ003wJ0000D000000000;lu*(m z${5rSPTgjnC% zY2?6j(*Yo;7d%YDN|2BgY^Sh!e6XD4nuFb-_tQ#FC+nnnb;Z9bFt6iTLH^&05R503(?| zMopxwZ9WWauB-mE0aa!7lpbxp#kKtPYjm-t)zT!SDa?AUT|Nikg-lB*kgDyy@FaL6Ll9t0Cpcen_S)9Wp0Y=_W^13+tf}MPVV3I^^JT@9Vc%FLENyM z#B3U;ckLsiuhB@or{y~^6?6u9stgoydbs5nTG&-cuo}^_(^0x@GTk~R7qu{rBb)N1 zqa>2kL;#s$(et%qj>lnhI-F*k7jt{p)8NuWXhC1%)K+pwjW*PpJlU3;mc${@a zYm#jMG?HvdEeAv;-%@xY2uU6y0*nPD>&~}BagnCCq?R0e_xcB`kxaqX-lzz@I1Qu` zVi%7fCx1q|!0$Ugi2&$;2#`bsM8<^LX{6d3U=6m$Hj`W4hn2a`>azMtf&pN#$O_bz zGe|QU{Qn2oUR-E2v>+;vcLVREjuL`_0rj-}tzyZg+Z7hk2mqsN?4PMrE2z%5ydPYq zG>8N!9VOq~lHT(iW&Vk4NvnNd3iDMH`m<+iaF6}R*1~FFR--{6xIAUso2-Gf!O+Nd z*6{Y2;9hGEJ-+0a!}4f&)?-dXat+fd!#JY~(OBPobHGkW`LqigoE~b~ZOGu31vQ#9FyK^Nt7r zR&3i>FERU|qscsM6-`VA?S+fE?scL?EI#{T(^dUCgRXCj-F2=-x29!%m&T-1Jnz72 z*s+=JZ&?x|T-XmH0C4H?+C&h<KMx0nEDNc~gZnoN^iN3PFp!;?ebG`jY3W&(@pH64$?`O~3 zHPq%a^S~i>4~F{~mb&zS0eu#n@uoTzv>*UU?^XH4~+N&?ZX-`cRHhZU+9)I zMsZRGEZ%qSJgU@L1@>9#!@H_`*V8B5)3UUXgw^o5|Kp!EqyPuGqZ5DtM)|nE8EeN? z0Emesi;T46=MfX#@Bmh?R?`rC$Vv|@x7xA|H~_BrX@-yOU_5Php8Ic3O(m28PUWiI aPo+q@t!_TP`rM!Y#oUoj6eKeC7^6TvmlEax diff --git a/man/flag_ww_outliers.Rd b/man/flag_ww_outliers.Rd index 3fc27d1b..45a0fbff 100644 --- a/man/flag_ww_outliers.Rd +++ b/man/flag_ww_outliers.Rd @@ -6,7 +6,7 @@ \usage{ flag_ww_outliers( ww_data, - conc_col_name = "genome_copies_per_ml", + conc_col_name = "log_genome_copies_per_ml", rho_threshold = 2, log_conc_threshold = 3, threshold_n_dps = 1 diff --git a/man/format_ww_data.Rd b/man/format_ww_data.Rd index 518f61b0..acc22f22 100644 --- a/man/format_ww_data.Rd +++ b/man/format_ww_data.Rd @@ -34,8 +34,8 @@ population size of the site} site combination} } \value{ -a tidy dataframe containing the observed wastewater concentrations -in each site and lab at each time point +a tidy dataframe containing observed wastewater concentrations +in log genome copies per mL for each site and lab at each time point } \description{ Format the wastewater data as a tidy data frame diff --git a/man/generate_simulated_data.Rd b/man/generate_simulated_data.Rd index ecee6d53..802b77e7 100644 --- a/man/generate_simulated_data.Rd +++ b/man/generate_simulated_data.Rd @@ -24,7 +24,7 @@ generate_simulated_data( sd_reporting_freq = 1/20, mean_reporting_latency = 7, sd_reporting_latency = 3, - mean_log_lod = 3.8, + mean_log_lod = 5, sd_log_lod = 0.2, global_rt_sd = 0.03, sigma_eps = 0.05, diff --git a/man/get_ww_values.Rd b/man/get_ww_values.Rd index d417c788..4498a6b3 100644 --- a/man/get_ww_values.Rd +++ b/man/get_ww_values.Rd @@ -6,8 +6,8 @@ \usage{ get_ww_values( ww_data, - ww_measurement_col_name = "genome_copies_per_ml", - ww_lod_value_col_name = "lod", + ww_measurement_col_name = "log_genome_copies_per_ml", + ww_lod_value_col_name = "log_lod", ww_site_pop_col_name = "site_pop", one_pop_per_site = TRUE, padding_value = 1e-08 @@ -19,11 +19,11 @@ per observation, with outliers already removed} \item{ww_measurement_col_name}{A string representing the name of the column in the input_ww_data that indicates the wastewater measurement value in -natural scale, default is \code{genome_copies_per_ml}} +log scale, default is \code{log_genome_copies_per_ml}} \item{ww_lod_value_col_name}{A string representing the name of the column -in the ww_data that indicates the value of the LOD in natural scale, -default is \code{lod}} +in the ww_data that indicates the value of the LOD in log scale, +default is \code{log_lod}} \item{ww_site_pop_col_name}{A string representing the name of the column in the ww_data that indicates the number of people represented by that diff --git a/man/preprocess_ww_data.Rd b/man/preprocess_ww_data.Rd index 4761d2d4..81e4f360 100644 --- a/man/preprocess_ww_data.Rd +++ b/man/preprocess_ww_data.Rd @@ -7,8 +7,8 @@ potential outliers} \usage{ preprocess_ww_data( ww_data, - conc_col_name = "genome_copies_per_ml", - lod_col_name = "lod" + conc_col_name = "log_genome_copies_per_ml", + lod_col_name = "log_lod" ) } \arguments{ @@ -17,19 +17,19 @@ date, site_pop, a column for concentration, and a column for the limit of detection} \item{conc_col_name}{string indicating the name of the column containing -the concentration measurements in the wastewater data, default is -\code{genome_copies_per_ml}} +virus genome concentration measurements in log genome copies per mL, +default is \code{log_genome_copies_per_ml}} \item{lod_col_name}{string indicating the name of the column containing -the concentration measurements in the wastewater data, default is -\code{genome_copies_per_ml}. Note that any values in the \code{conc_col_name} +the limits of detection for each wastewater measurement, default is +\code{log_lod_sewage}. Note that any values in the \code{conc_col_name} equal to the limit of detection will be treated as below the limit of detection.} } \value{ a dataframe containing the same columns as ww_data except -the \code{conc_col_name} will be replaced with \code{genome_copies_per_ml} and -the \code{lod_col_name} will be replaced with \code{lod} plus the following +the \code{conc_col_name} will be replaced with \code{log_genome_copies_per_ml} and +the \code{lod_col_name} will be replaced with \code{log_lod_sewage} plus the following additional columns needed for the stan model: lab_site_index, site_index, flag_as_ww_outlier, below_lod, lab_site_name, exclude @@ -43,12 +43,12 @@ ww_data <- tibble::tibble( date = lubridate::ymd(rep(c("2023-11-01", "2023-11-02"), 2)), site = c(rep(1, 2), rep(2, 2)), lab = c(1, 1, 1, 1), - conc = c(345.2, 784.1, 401.5, 681.8), - lod = c(20, 20, 15, 15), + log_conc = log(c(345.2, 784.1, 401.5, 681.8)), + log_lod = log(c(20, 20, 15, 15)), site_pop = c(rep(2e5, 2), rep(4e5, 2)) ) ww_data_preprocessed <- preprocess_ww_data(ww_data, - conc_col_name = "conc", - lod_col_name = "lod" + conc_col_name = "log_conc", + lod_col_name = "log_lod" ) } diff --git a/man/ww_data.Rd b/man/ww_data.Rd index ee2bebde..6a4e5e9a 100644 --- a/man/ww_data.Rd +++ b/man/ww_data.Rd @@ -13,13 +13,13 @@ A tibble with 102 rows and 6 columns YYYY-MM-DD} \item{site}{The wastewater treatment plant where the sample was collected} \item{lab}{The lab where the sample was processed} -\item{genome_copies_per_ml}{The wastewater concentration measured on the -date specified, collected in the site specified, and processed in the lab -specified. The default parameters assume that this quantity is reported -as the genome copies per mL, on a natural scale.} -\item{lod}{The limit of detection in the site and lab on a particular day -of the quantification device (e.g. PCR). This is also by default reported -in terms of the genome copies per mL.} +\item{log_genome_copies_per_ml}{The natural log of the wastewater +concentration measured on the date specified, collected in the site +specified, and processed in the lab specified. The package expects +this quantity in units of log estimated genome copies per mL.} +\item{log_lod}{The log of the limit of detection in the site and lab on a +particular day of the quantification device (e.g. PCR). This should be in +units of log estimated genome copies per mL.} \item{site_pop}{The population size of the wastewater catchment area represented by the site variable} } @@ -33,12 +33,13 @@ ww_data } \description{ A dataset containing the simulated wastewater concentrations -(labeled here as \code{genome_copies_per_ml}) by sample collection date (\code{date}), -the site where the sample was collected (\code{site}) and the lab where the -samples were processed (\code{lab}). Additional columns that are required -attributes needed for the model are the limit of detection for that lab on -each day (labeled here as \code{lod}) and the population size of the wastewater -catchment area represented by the wastewater concentrations in each \code{site}. +(labeled here as \code{log_genome_copies_per_ml}) by sample collection date +(\code{date}), the site where the sample was collected (\code{site}) and the lab +where the samples were processed (\code{lab}). Additional columns that are +required attributes needed for the model are the limit of detection for +that lab on each day (labeled here as \code{log_lod}) and the population size of +the wastewater catchment area represented by the wastewater concentrations +in each \code{site}. } \details{ This data is generated via the default values in the diff --git a/man/wwinference.Rd b/man/wwinference.Rd index 094202ef..7af7f11b 100644 --- a/man/wwinference.Rd +++ b/man/wwinference.Rd @@ -27,8 +27,8 @@ wwinference( \arguments{ \item{ww_data}{A dataframe containing the pre-processed, site-level wastewater concentration data for a model run. The dataframe must contain -the following columns: \code{date}, \code{site}, \code{lab}, \code{genome_copies_per_ml}, -\code{lab_site_index}, \code{lod}, \code{below_lod}, \code{site_pop} \code{exclude}} +the following columns: \code{date}, \code{site}, \code{lab}, \code{log_genome_copies_per_ml}, +\code{lab_site_index}, \code{log_lod}, \code{below_lod}, \code{site_pop} \code{exclude}} \item{count_data}{A dataframe containing the pre-procssed, "global" (e.g. state) daily count data, pertaining to the number of events that are being @@ -100,9 +100,9 @@ returns the object invisibly. Provides a user friendly interface around package functionality to produce estimates, nowcasts, and forecasts pertaining to user-specified delay distributions, set parameters, and priors that can be modified to -handledifferent types of "global" count data and "local" wastewater -concentrationdata using a Bayesian hierarchical framework applied to the two -distinctdata sources. By default the model assumes a fixed generation +handle different types of "global" count data and "local" wastewater +concentration data using a Bayesian hierarchical framework applied to the two +distinct data sources. By default the model assumes a fixed generation interval and delay from infection to the event that is counted. See the getting started vignette for an example model specifications fitting COVID-19 hospital admissions from a hypothetical state and wasteawter @@ -118,8 +118,8 @@ ww_data <- tibble::tibble( ), 2), site = c(rep(1, 14), rep(2, 14)), lab = c(rep(1, 28)), - conc = abs(rnorm(28, mean = 500, sd = 50)), - lod = c(rep(20, 14), rep(15, 14)), + conc = log(abs(rnorm(28, mean = 500, sd = 50))), + lod = log(c(rep(20, 14), rep(15, 14))), site_pop = c(rep(2e5, 14), rep(4e5, 14)) ) diff --git a/scratch/sim_data_script.R b/scratch/sim_data_script.R index b5b8873f..af84d369 100644 --- a/scratch/sim_data_script.R +++ b/scratch/sim_data_script.R @@ -63,7 +63,7 @@ ggplot(test) + ) + geom_line(aes(x = t, y = rt_stan), color = "red") -plot(new_i_over_n) + new_i_test <- rt_r * (convolve(new_i_over_n, rev(generation_interval), type = "open")[1:(ot + ht)]) # nolint plot(new_i_test) diff --git a/tests/testthat/test_flag_as_ww_outliers.R b/tests/testthat/test_flag_as_ww_outliers.R index 261013ac..c1c71f7e 100644 --- a/tests/testthat/test_flag_as_ww_outliers.R +++ b/tests/testthat/test_flag_as_ww_outliers.R @@ -4,7 +4,10 @@ dummy_data <- tibble::tibble( lab = rep("Lab1", 10), lab_site_index = rep(1, 10), date = as.Date("2021-01-01") + 0:9, - genome_copies_per_ml = c(100, 150, 100, 200, 270, 200, NA, 400, 20, 600), + log_genome_copies_per_ml = log(c( + 100, 150, 100, 200, 270, 200, + NA, 400, 20, 600 + )), below_lod = c(0, 0, 0, 0, 0, 0, 0, 0, 1, 0) ) @@ -23,14 +26,16 @@ test_that("function flags outliers correctly", { lab = rep("Lab1", 12), lab_site_index = rep(1, 12), date = as.Date("2021-01-01") + 0:11, - genome_copies_per_ml = c( + log_genome_copies_per_ml = log(c( 100, 120, 100, 110, 115, 130, 110, 200, NA, 100, 20, 500000 - ), + )), below_lod = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0) ) - result <- flag_ww_outliers(dummy_data) + result <- flag_ww_outliers(dummy_data, + log_conc_threshold = 1 + ) # Check if the known outlier is flagged correctly testthat::expect_true(sum(result$flag_as_ww_outlier) > 0) @@ -45,16 +50,16 @@ test_that("function does not flag non-outliers", { lab = rep("Lab1", 12), lab_site_index = rep(1, 12), date = as.Date("2021-01-01") + 0:11, - genome_copies_per_ml = c( + log_genome_copies_per_ml = log(c( 100, 120, 100, 110, 115, 130, 110, 200, NA, 100, 20, 150 - ), + )), below_lod = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0) ) result <- flag_ww_outliers(dummy_data) - # Check if their is no outlier to be flagged + # Check that there is no outlier to be flagged testthat::expect_true(sum(result$flag_as_ww_outlier) == 0) # Check that this hasn't yet been labeled for exclusion testthat::expect_true(sum(result$exclude) == 0) @@ -67,7 +72,7 @@ test_that("function handles NA values appropriately", { lab = rep("Lab1", 12), lab_site_index = rep(1, 12), date = as.Date("2021-01-01") + 0:11, - genome_copies_per_ml = c( + log_genome_copies_per_ml = c( NA, 120, 100, 110, NA, 130, 110, 200, NA, 100, 20, 150 ), @@ -88,7 +93,7 @@ test_that("rho_threshold and log_conc threshold parameters works as expected", { lab = rep("Lab1", 12), lab_site_index = rep(1, 12), date = as.Date("2021-01-01") + 0:11, - genome_copies_per_ml = c( + log_genome_copies_per_ml = c( 100, 120, 100, 110, 115, 1000, 110, 100, NA, 100, 20, 100 ), diff --git a/tests/testthat/test_preprocess_ww_data.R b/tests/testthat/test_preprocess_ww_data.R index f7eff727..9da1e350 100644 --- a/tests/testthat/test_preprocess_ww_data.R +++ b/tests/testthat/test_preprocess_ww_data.R @@ -16,8 +16,8 @@ test_that("Function returns dataframe with correct columns", { ) expected_cols <- c( - "date", "site", "lab", "genome_copies_per_ml", - "lod", "site_pop", "lab_site_index", "site_index", + "date", "site", "lab", "log_genome_copies_per_ml", + "log_lod", "site_pop", "lab_site_index", "site_index", "flag_as_ww_outlier", "lab_site_name", "below_lod" ) @@ -32,7 +32,7 @@ test_that("Concentration column is renamed correctly", { ) checkmate::expect_names( names(processed), - must.include = "genome_copies_per_ml", + must.include = "log_genome_copies_per_ml", disjunct.from = "conc" ) }) @@ -47,7 +47,7 @@ test_that("LOD column is renamed correctly", { ) checkmate::expect_names(names(processed), - must.include = "lod", + must.include = "log_lod", disjunct.from = "LOD" ) }) diff --git a/vignettes/wwinference.Rmd b/vignettes/wwinference.Rmd index 6cfd6754..c61de39d 100644 --- a/vignettes/wwinference.Rmd +++ b/vignettes/wwinference.Rmd @@ -50,13 +50,13 @@ from the larger "global" population, and wastewater concentration data from wastewater treatment plants whose catchment areas are contained within the larger "global" population. For this quick start, we will use simulated data, modeled after a hypothetical US state with 4 wastewater -treatment plants (also referred to as sites) reporting data on viral +treatment plants (also referred to as sites) reporting data on log scale viral concentrations of SARS-COV-2, processed in 3 different labs, covering about 25% of the state's population. This simulated data contains daily counts of the total hospital admissions in a hypothetical US state from September 1, 2023 to -November 29, 2023. It contains wastewater concentration data spanning from -September 1, 2023 to December 1, 2023, with varying sampling frequencies. We -will be using this data to produce a forecast of COVID-19 hospital admissions +November 29, 2023. It contains wastewater log genome concentration data +from September 1, 2023 to December 1, 2023, with varying sampling frequencies. +We will be using this data to produce a forecast of COVID-19 hospital admissions as of December 6, 2023. These data are provided as part of the package data. These data are already in a format that can be used for `wwinference`. For the @@ -72,18 +72,25 @@ Additionally, we provide the `hosp_data_eval` dataset which contains the simulated hospital admissions 28 days ahead of the forecast date, which can be used to evaluate the model. -For the wastewater data, it contains: +For the wastewater data, the expcted format is a table of observations with the +following columns. The wastewater data should not contain `NA` values for days with +missing observations, instead these should be excluded: - a date (column `date`): the date the sample was collected - a site indicator (column `site`): the unique identifier for the wastewater treatment plant that the sample was collected from - a lab indicator (column `lab`): the unique identifier for the lab where the sample was processed -- a concentration (column `genome_copies_mL`): the measured genome copies per mL from -the sample collected, in natural scale -- a limit of detection (column `lod`): the limit of detection of the assay used to -process the sample, in natural scale +- a concentration (column `log_genome_copies_ml`): the measured +log genome copies per mL for the given sample. This column should not +contain `NA` values, even if the observation for that sample is below the limit of +detection. +- a limit of detection (column `log_lod`): the natural log of the limit +of detection of the assay used to process the sample. Units should be the same +units as the concentration column. - a site population size (column `site_pop`): the population size covered by the wastewater catchment area of that site + + ```{r load-data} hosp_data <- wwinference::hosp_data hosp_data_eval <- wwinference::hosp_data_eval @@ -140,10 +147,15 @@ pass to the downstream model fitting functions. ```{r preprocess-ww-data} ww_data_preprocessed <- wwinference::preprocess_ww_data( ww_data, - conc_col_name = "genome_copies_per_ml", - lod_col_name = "lod" + conc_col_name = "log_genome_copies_per_ml", + lod_col_name = "log_lod" ) ``` +Note that this function assumes that there are no missing values in the +concentration column. The package expects observations below the LOD will +be replaced with a numeric value below the LOD. If there are `NA` values in your dataset +when observations are below the LOD, we suggest replacing them with a value +below the LOD in upstream pre-processing. ## Hospital admissions data pre-processing @@ -169,17 +181,19 @@ We'll make some plots of the data just to make sure it looks like what we'd expe ggplot(ww_data_preprocessed) + geom_point( aes( - x = date, y = genome_copies_per_ml, + x = date, y = log_genome_copies_per_ml, color = as.factor(lab_site_name) ), show.legend = FALSE ) + geom_point( - data = ww_data_preprocessed |> filter(genome_copies_per_ml <= lod), - aes(x = date, y = genome_copies_per_ml, color = "red"), + data = ww_data_preprocessed |> filter( + log_genome_copies_per_ml <= log_lod + ), + aes(x = date, y = log_genome_copies_per_ml, color = "red"), show.legend = FALSE ) + - geom_hline(aes(yintercept = lod), linetype = "dashed") + + geom_hline(aes(yintercept = log_lod), linetype = "dashed") + facet_wrap(~lab_site_name, scales = "free") + xlab("") + ylab("Genome copies/mL") + @@ -360,7 +374,16 @@ state-level R(t) estimate. We can generate this directly on the output of `wwinference()` using: ```{r extracting-draws} draws_df <- get_draws_df(ww_fit) + +cat( + "Variables in dataframe: ", + sprintf("%s", paste(unique(draws_df$name), collapse = ", ")) +) ``` +Note that by default the `get_draws_df()` function will return a tidy long +dataframe with all of the posterior draws joined to applicable data for each of +the included variables. To examine a particular variable (e.g. `"predicted counts"` for posterior +predicted hospital admissions), filter the data frame based on the `name` column. ### Using explicit passed arguments rather than S3 methods @@ -381,7 +404,9 @@ draws_df_explicit <- get_draws_df( ## Plotting the outputs We can create plots of the outputs using `draws_df` and -the fitting wrapper functions. +the fitting wrapper functions. Note that by default, these plots will not +visualize data that was below the LOD (even though the fit incorporated +them via the censored observation process.) ```{r generating-figures, out.width='100%'} draws_df <- get_draws_df(ww_fit) From 6df32c560329c34a8a48de65a203b604c3ee9a1c Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Fri, 6 Sep 2024 10:56:48 -0400 Subject: [PATCH 08/46] Tweaks to model definition (#134) --- model_definition.md | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/model_definition.md b/model_definition.md index f7b1a34f..88af1da4 100644 --- a/model_definition.md +++ b/model_definition.md @@ -22,7 +22,9 @@ See the [notation](#appendix-notation) section for an overview of the mathematic #### Renewal process for incident infections This component assumes that latent (unobserved) _expected_ incident infections per capita $I(t)$ are generated from a renewal [^Cori][^EpiNow2][^Epidemia] process described by: + $$I(t) = \mathcal{R}(t) \sum_{\tau = 1}^{T_g} I(t-\tau) g(\tau)$$ + Where $g(\tau)$ is the discrete generation interval, which describes the distribution of times from incident infection to secondary infection (i.e. infectiousness profile) and $\mathcal{R}(t)$ is the instantaneous reproduction number, representing the expected number of secondary infections occurring at time $t$, divided by the number of currently infected individuals, each scaled by their relative infectiousness at time $t$ [^Gostic2020]. $T_g$ is the maximum generation interval, which is the maximum time from infection to secondary infection that we consider, and is set to 15 days. This process is initialized by estimating an initial exponential growth[^EpiNow2] of infections for 50 days prior to the calibration start time $t_0$: @@ -46,7 +48,7 @@ We bound $\beta$ to be between 0 and 1 so that any changes in trend in $\mathcal The damping term we use is based on Asher et al. 2018[^Asher2018] but extended to be applicable to a renewal process. It assumes that the instantaneous reproduction number is damped by recent infections weighted by the generation interval. This is a simple way to account for the fact that the instantaneous reproduction number is likely to decrease when there are many infections in the population, due to factors such as immunity, behavioral changes, and public health interventions. The damping term is defined as: -$$ \mathcal{R}(t) = \mathcal{R}^\mathrm{u}(t) \exp \left( -\gamma \sum_{\tau = 1}^{T_f}I(t-\tau)g(\tau) \right) $$ +$$ \mathcal{R}(t) = \mathcal{R}^\mathrm{u}(t) \exp \left( -\gamma \sum_{\tau = 1}^{T_g}I(t-\tau)g(\tau) \right) $$ where $\gamma$ is the _infection feedback term_ controlling the strength of the damping on $\mathcal{R}(t)$, and the summation is analogous to the "force of infection." See [Prior Distributions](#prior-distributions) below for description of prior choice on $\gamma$. @@ -66,8 +68,7 @@ The total number of subpopulations is then $K_\mathrm{total} = K_\mathrm{sites} This amounts to modeling the wastewater catchments populations as approximately non-overlapping; every infected individual either does not contribute to measured wastewater or contributes principally to one wastewater catchment. This approximation is reasonable if we restrict our analyses to primary wastewaster treatment plants, which avoids the possibility that an individual might be sampled once in a sample taken upstream and then sampled again in a more aggregated sample taken further downstream. - -If the sum of the wastewater site catchment populations meets or exceeds the reported jurisdiction population ($\sum\nolimits_{k=1}^{K_\mathrm{sites}} n_k \ge n$) we do not use a final subpopulation without sampled wastewater. In that case, the total number of subpopulations $K_\mathrm{total} = K_\mathrm{sites}$. +If the sum of the wastewater site catchment populations meets or exceeds the reported jurisdiction population ($\sum\nolimits_{k=1}^{K_\mathrm{sites}} n_k \ge n$) the model does not use a final subpopulation without sampled wastewater. In that case, the total number of subpopulations $K_\mathrm{total} = K_\mathrm{sites}$. When converting from predicted per capita incident hospital admissions $H(t)$ to predicted hospitalization counts, we use the jurisdiction population size $n$, even in the case where $\sum n_k > n$. From 6aed488efaf45fa795cb14e39cfbda096908c522 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Fri, 6 Sep 2024 11:03:15 -0400 Subject: [PATCH 09/46] Fix check for required wastewater columns (#127) --- R/checkers.R | 33 +++++------ R/get_stan_data.R | 2 +- R/preprocessing.R | 2 +- R/utils.R | 2 +- ...esent.Rd => assert_req_ww_cols_present.Rd} | 6 +- tests/testthat/test_checkers.R | 56 ++++++++++++++++--- 6 files changed, 68 insertions(+), 33 deletions(-) rename man/{check_req_ww_cols_present.Rd => assert_req_ww_cols_present.Rd} (93%) diff --git a/R/checkers.R b/R/checkers.R index 2c43a405..4e28959b 100644 --- a/R/checkers.R +++ b/R/checkers.R @@ -292,22 +292,18 @@ throw_type_error <- function(object, #' traceback. #' #' @return NULL, invisibly -check_req_ww_cols_present <- function(ww_data, - conc_col_name, - lod_col_name, - add_req_col_names = c( - "date", "site", - "lab", "site_pop" - ), - call = rlang::caller_env()) { +assert_req_ww_cols_present <- function(ww_data, + conc_col_name, + lod_col_name, + add_req_col_names = c( + "date", "site", + "lab", "site_pop" + ), + call = rlang::caller_env()) { column_names <- colnames(ww_data) expected_col_names <- c( - { - conc_col_name - }, - { - lod_col_name - }, + {{ conc_col_name }}, + {{ lod_col_name }}, add_req_col_names ) @@ -317,10 +313,11 @@ check_req_ww_cols_present <- function(ww_data, ) if (!isTRUE(name_check_result)) { cli::cli_abort( - message = c( - "Required columns are missing from the wastewater data. ", - autoescape_brackets(name_check_result) - ), + message = + c( + "Required columns are missing from the wastewater data. ", + autoescape_brackets(name_check_result) + ), class = "wwinference_input_data_error", call = call ) diff --git a/R/get_stan_data.R b/R/get_stan_data.R index 7bfbb4e3..95a61fa5 100644 --- a/R/get_stan_data.R +++ b/R/get_stan_data.R @@ -59,7 +59,7 @@ get_input_ww_data_for_stan <- function(preprocessed_ww_data, } # Test for presence of needed column names - check_req_ww_cols_present(preprocessed_ww_data, + assert_req_ww_cols_present(preprocessed_ww_data, conc_col_name = "log_genome_copies_per_ml", lod_col_name = "log_lod" ) diff --git a/R/preprocessing.R b/R/preprocessing.R index 2822ff42..db622e95 100644 --- a/R/preprocessing.R +++ b/R/preprocessing.R @@ -35,7 +35,7 @@ preprocess_ww_data <- function(ww_data, conc_col_name = "log_genome_copies_per_ml", lod_col_name = "log_lod") { - check_req_ww_cols_present( + assert_req_ww_cols_present( ww_data, conc_col_name, lod_col_name diff --git a/R/utils.R b/R/utils.R index 496b5947..89f577fb 100644 --- a/R/utils.R +++ b/R/utils.R @@ -161,5 +161,5 @@ to_simplex <- function(vector) { #' @return A string vector where all single brackets are replaced with double #' brackets autoescape_brackets <- function(string) { - return(gsub("\\{(.*)\\}", "{{\\1}}", string)) + return(gsub("\\{|\\}", "", string)) } diff --git a/man/check_req_ww_cols_present.Rd b/man/assert_req_ww_cols_present.Rd similarity index 93% rename from man/check_req_ww_cols_present.Rd rename to man/assert_req_ww_cols_present.Rd index 833e0f85..e1c5dede 100644 --- a/man/check_req_ww_cols_present.Rd +++ b/man/assert_req_ww_cols_present.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/checkers.R -\name{check_req_ww_cols_present} -\alias{check_req_ww_cols_present} +\name{assert_req_ww_cols_present} +\alias{assert_req_ww_cols_present} \title{Check that the input wastewater data contains all the required column names} \usage{ -check_req_ww_cols_present( +assert_req_ww_cols_present( ww_data, conc_col_name, lod_col_name, diff --git a/tests/testthat/test_checkers.R b/tests/testthat/test_checkers.R index 0c501895..b1d97ba3 100644 --- a/tests/testthat/test_checkers.R +++ b/tests/testthat/test_checkers.R @@ -79,14 +79,14 @@ test_that( date = lubridate::ymd("2024-01-01"), site = 1, lab = 2, - genome_copies_per_ml = 4, + log_genome_copies_per_ml = 4, lod = 6, site_pop = 100, test_col = 4 ) - conc_col_name <- "genome_copies_per_ml" + conc_col_name <- "log_genome_copies_per_ml" lod_col_name <- "lod" - expect_no_error(check_req_ww_cols_present( + expect_no_error(assert_req_ww_cols_present( x, conc_col_name, lod_col_name @@ -97,13 +97,13 @@ test_that( date = lubridate::ymd("2024-01-01"), site = 1, lab = 2, - genome_copies_per_ml = 4, + log_genome_copies_per_ml = 4, lod = 6, site_pop = 100 ) - conc_col_name <- "genome_copies_per_ml" + conc_col_name <- "log_genome_copies_per_ml" lod_col_name <- "LOD" - expect_error(assert_req_ww_columns_present( + expect_error(assert_req_ww_cols_present( x, conc_col_name, lod_col_name @@ -114,13 +114,51 @@ test_that( date = lubridate::ymd("2024-01-01"), site = 1, lab = 2, - genome_copies_per_ml = 4, + log_genome_copies_per_ml = 4, lod = 6, site_pops = 100 ) - conc_col_name <- "genome_copies_per_ml" + conc_col_name <- "log_genome_copies_per_ml" lod_col_name <- "lod" - expect_error(assert_req_ww_columns_present( + expect_error(assert_req_ww_cols_present( + x, + conc_col_name, + lod_col_name + )) + + # Site is missing, expect error + x <- tibble::tibble( + date = lubridate::ymd("2024-01-01"), + lab = 2, + log_genome_copies_per_ml = 4, + lod = 6, + site_pop = 100, + loc = "example" + ) + conc_col_name <- "log_genome_copies_per_ml" + lod_col_name <- "lod" + expect_error( + assert_req_ww_cols_present( + x, + conc_col_name, + lod_col_name + ) + ) + + + # Expect no error + x <- tibble::tibble( + date = lubridate::ymd("2024-01-01"), + site = 1, + lab = 2, + log_genome_copies_per_ml = 4, + lod = 6, + site_pop = 100, + loc = "example" + ) + conc_col_name <- "log_genome_copies_per_ml" + lod_col_name <- "lod" + expect_no_error(assert_req_ww_cols_present( x, conc_col_name, lod_col_name From 978c9514c82745aac2dce40353bdbf0ab9759c64 Mon Sep 17 00:00:00 2001 From: "Dylan H. Morris" Date: Fri, 6 Sep 2024 12:45:32 -0400 Subject: [PATCH 10/46] Switch to placing prior on and inferring `i/n` at the first observed timepoint (#85) --- R/generate_simulated_data.R | 2 +- R/get_stan_data.R | 30 +++++++--- R/initialization.R | 19 ++++--- R/sysdata.rda | Bin 27077 -> 37855 bytes R/utils.R | 1 - data-raw/test_data.R | 66 +++++++++------------- data/default_covid_inf_to_hosp.rda | Bin 637 -> 640 bytes data/hosp_data.rda | Bin 526 -> 509 bytes data/hosp_data_eval.rda | Bin 615 -> 593 bytes data/true_global_rt.rda | Bin 2187 -> 2189 bytes data/ww_data.rda | Bin 1613 -> 1545 bytes inst/extdata/example_params.toml | 15 +++-- inst/stan/wwinference.stan | 77 +++++++++++++------------- tests/testthat/test_helper.R | 4 +- tests/testthat/test_ihr_transform.R | 11 ++-- tests/testthat/test_pmfs_normalized.R | 10 ++-- tests/testthat/test_rt_assembly.R | 11 ++-- tests/testthat/test_ww_model.R | 25 +++++---- 18 files changed, 143 insertions(+), 128 deletions(-) diff --git a/R/generate_simulated_data.R b/R/generate_simulated_data.R index f2883407..c3582bd5 100644 --- a/R/generate_simulated_data.R +++ b/R/generate_simulated_data.R @@ -294,7 +294,7 @@ generate_simulated_data <- function(r_in_weeks = # nolint ht = ht, unadj_r_site = unadj_r_site, initial_growth = initial_growth, - initial_growth_prior_sd = params$initial_growth_prior_sd, + initial_growth_prior_sd = params$mean_initial_exp_growth_rate_prior_sd, i0_over_n = i0_over_n, sd_i0_over_n = sd_i0_over_n, generation_interval = generation_interval, diff --git a/R/get_stan_data.R b/R/get_stan_data.R index 95a61fa5..3e72d953 100644 --- a/R/get_stan_data.R +++ b/R/get_stan_data.R @@ -337,7 +337,10 @@ get_stan_data <- function(input_count_data, ) # Estimate of number of initial infections - i0 <- mean(count_values$count[1:7], na.rm = TRUE) / params$p_hosp_mean + i_first_obs_est <- ( + mean(count_values$count[1:7], na.rm = TRUE) / + params$p_hosp_mean + ) # package up parameters for stan data object viral_shedding_pars <- c( @@ -400,11 +403,22 @@ get_stan_data <- function(input_count_data, r_prior_sd = params$r_prior_sd, log10_g_prior_mean = params$log10_g_prior_mean, log10_g_prior_sd = params$log10_g_prior_sd, - i0_over_n_prior_a = 1 + params$i0_certainty * (i0 / pop), - i0_over_n_prior_b = 1 + params$i0_certainty * (1 - (i0 / pop)), - hosp_wday_effect_prior_alpha = params$hosp_wday_effect_prior_alpha, - initial_growth_prior_mean = params$initial_growth_prior_mean, - initial_growth_prior_sd = params$initial_growth_prior_sd, + i_first_obs_over_n_prior_a = 1 + + params$i_first_obs_certainty * + (i_first_obs_est / pop), + i_first_obs_over_n_prior_b = 1 + + params$i_first_obs_certainty * + (1 - (i_first_obs_est / pop)), + hosp_wday_effect_prior_alpha = + params$hosp_wday_effect_prior_alpha, + mean_initial_exp_growth_rate_prior_mean = + params$mean_initial_exp_growth_rate_prior_mean, + mean_initial_exp_growth_rate_prior_sd = + params$mean_initial_exp_growth_rate_prior_sd, + sigma_initial_exp_growth_rate_prior_mode = + params$sigma_initial_exp_growth_rate_prior_mode, + sigma_initial_exp_growth_rate_prior_sd = + params$sigma_initial_exp_growth_rate_prior_sd, mode_sigma_ww_site_prior_mode = params$mode_sigma_ww_site_prior_mode, mode_sigma_ww_site_prior_sd = params$mode_sigma_ww_site_prior_sd, sd_log_sigma_ww_site_prior_mode = @@ -412,8 +426,8 @@ get_stan_data <- function(input_count_data, sd_log_sigma_ww_site_prior_sd = params$sd_log_sigma_ww_site_prior_sd, eta_sd_sd = params$eta_sd_sd, - sigma_i0_prior_mode = params$sigma_i0_prior_mode, - sigma_i0_prior_sd = params$sigma_i0_prior_sd, + sigma_i_first_obs_prior_mode = params$sigma_i_first_obs_prior_mode, + sigma_i_first_obs_prior_sd = params$sigma_i_first_obs_prior_sd, p_hosp_prior_mean = params$p_hosp_mean, p_hosp_sd_logit = params$p_hosp_sd_logit, p_hosp_w_sd_sd = params$p_hosp_w_sd_sd, diff --git a/R/initialization.R b/R/initialization.R index 760903cf..c420d5eb 100644 --- a/R/initialization.R +++ b/R/initialization.R @@ -21,7 +21,11 @@ get_inits_for_one_chain <- function(stan_data, params, stdev = 0.01) { n_subpops <- as.numeric(stan_data$n_subpops) n_ww_lab_sites <- as.numeric(stan_data$n_ww_lab_sites) # Estimate of number of initial infections - i0 <- mean(stan_data$hosp[1:7], na.rm = TRUE) / params$p_hosp_mean + i_first_obs_est <- ( + mean(stan_data$hosp[1:7], na.rm = TRUE) / params$p_hosp_mean + ) + + logit_i_frac_est <- stats::qlogis(i_first_obs_est / pop) n_subpops <- as.numeric(stan_data$n_subpops) n_ww_lab_sites <- as.numeric(stan_data$n_ww_lab_sites) @@ -29,10 +33,10 @@ get_inits_for_one_chain <- function(stan_data, params, stdev = 0.01) { init_list <- list( w = stats::rnorm(n_weeks - 1, 0, stdev), eta_sd = abs(stats::rnorm(1, 0, stdev)), - eta_i0 = abs(stats::rnorm(n_subpops, 0, stdev)), - sigma_i0 = abs(stats::rnorm(1, 0, stdev)), - eta_growth = abs(stats::rnorm(n_subpops, 0, stdev)), - sigma_growth = abs(stats::rnorm(1, 0, stdev)), + eta_i_first_obs = abs(stats::rnorm(n_subpops, 0, stdev)), + sigma_i_first_obs = abs(stats::rnorm(1, 0, stdev)), + eta_initial_exp_growth_rate = abs(stats::rnorm(n_subpops, 0, stdev)), + sigma_initial_exp_growth_rate = abs(stats::rnorm(1, 0, stdev)), autoreg_rt = abs(stats::rnorm( 1, params$autoreg_rt_a / (params$autoreg_rt_a + params$autoreg_rt_b), @@ -54,8 +58,9 @@ get_inits_for_one_chain <- function(stan_data, params, stdev = 0.01) { autoreg_rt_site = abs(stats::rnorm(1, 0.5, 0.05)), autoreg_p_hosp = abs(stats::rnorm(1, 1 / 100, 0.001)), sigma_rt = abs(stats::rnorm(1, 0, stdev)), - i0_over_n = stats::plogis(stats::rnorm(1, stats::qlogis(i0 / pop), 0.05)), - initial_growth = stats::rnorm(1, 0, stdev), + i_first_obs_over_n = + stats::plogis(stats::rnorm(1, logit_i_frac_est), 0.05), + mean_initial_exp_growth_rate = stats::rnorm(1, 0, stdev), inv_sqrt_phi_h = 1 / sqrt(200) + stats::rnorm(1, 1 / 10000, 1 / 10000), mode_sigma_ww_site = abs(stats::rnorm( 1, params$mode_sigma_ww_site_prior_mode, diff --git a/R/sysdata.rda b/R/sysdata.rda index 11f4dc49efc956be59296d7ae7df4626e477c767..8011a7ee48e0683bee366bd7fa21a3aa5533dc7e 100644 GIT binary patch literal 37855 zcmdS9WmsIx5;i(WkOY_D8k_(@f_rdxcL~AW-62?T_uv-X9fG^N>)%s5O0M8JAJ{Wn^T)1uLK58E9DKt*Vp z=b{uYP*o?Z3ylH*Sk;*VuPHM=s<#22iMb*6X5ouBqZNQd(oVC1SIWU! z=IDrj_W4mL`NV36_uo*m&}F`rB)vu#6{M6y3l{h)N}SIxNBk|S5DB&zU64vCHdbyr zvpgsVoKhiJunOBuSCUb+3NrFFwusLc25bNTMh7{U7yemZ7~sq37s^$5DDTLO2?jlZ6Ba|Qkt|K7?t^)vL>e2zgW-#a(^mzrK3WZ@p=Itv|k(|m_kOjb2 zb7oJ@zZ(Sze+NvwlYnF}_RdJckrW~d&HzA#`XaR@Vl%jel7+#;p-M;u@cB)QLBY6$ z0YUJlpgj(i_Q>a&ys+JgHm^OxZ#4(ggtj{bk@kK-#oLSQKSeKlj+Y7H*cHH5EK3_gq{wFIykQFwOqgvpR)T=9g zVo|i&?oUP-biH?l$u)S6$r=H+T(;N;jpj2Jrg0keF50RzOV!(tvBKdq?x4^SjJPMd zH1$P;v-?gKqkbn&w)@iT0k(}6RS)xxdk)@m(JKfFg;=)p!+zAr&AsFV1d-WTv2GZY zbnaM`uHD&*Y?T5n&NC7*aHvgHq#rlikYwB)VK}}h^wBCm6Nw>WS7jOTC4#-z{Ps1X z-w1D8H{AAdCQUH8_y+3n`4^eZLhQ$Lh`;dOK56>s|a?ErbVP3p^cOG zqiPu2N#iBsQ-yRCD`sto1s5rQ=jO&P>!LoP=^S1_5=*MMXutGT)?B56xMOMoO_r9q zwBq&K8~$~5Svt~ERuaKlN}abbGZCL6eboJEh>Vr?>@ol=YSoJBO8F26^B}4WB5|d{ zAg;L+X4B<~O>1WX^$SP1_reJ$Us`c!Y^tdN0AxTt$yZ3IgS=xREZ6W&gryMA`K4{r zA_fP2eTMwG__EQ5lAgjJ7{7oXl&NmV|4oqIvLaUD4Plrq%VgnK zB3nehH}>TS!!Wt;!DQ(K9r3^$1nt+}E&)w440I^8`2;Q1+S|%yU`?j@KI!<>)$9_- znZ4adPh=BYZgl@5$nb-Kh2kp)F`5sc4hhXz4LnR0?& zKQ48G)1^CVfi%f|YX-EM+P8c}+F@1&LqRwI>yZe6Wu~WR6*b=thYw!((P6G-D zvaX13E^m4wt8OdI5-u&{l4OXF$GM^X#a?Tt05orY*s>;K_Z-E)v>tBWMao7Ei&=A5|;g|JQhN0a6*Xk(1NVY zNH17o@D51MyOVP^cLX}^>uRX@qBd6P`+F^I-=$ryJU69*jCxXJHXQ0;2e-b<$2Wce z8a^+WgsZ?t2yk@LAi}I*+d|Ts0?LNLy>=vcegd!ZMh$gNsN7-S3T;w?FCweXzHvgV z4cAy;IPHqGPz-Mgt^+wsEWjqNc!Ho77qx^0xb;&Dt$Hfz!AY@RnMR(BillK;reA<~czaRX81Vrib1@v!A5N-! z-p>v0>g}mvx%CB3eJ)eIvkbB6OMh@W>7ATph(rbqQ?PSjRF-C56me+@OxslX1f#Bv zsmoVvie$O$V%C10SWju|!SyR#7ipN%Z`5B7Cf1VwEypk1Xk450m}iI;-7~cCnix_*01y@J+_}mKw!-w`V)vti$<-$XAQbA;K3h!6 z^<}K3&#inyArRC=ObwNh(QyC)ka0f94)auyPvF`7xn_fdAw8&R?x1%Gb z*^sMWS5BFlmYTpcdGaOH>T(wRI(#F~u0UVsFpLgN~$_Wkvv#nsS7up40ceODR!L3hrfdMjj+q_*}hkeYs z?QFI~#)+KUjO$ob;Oz(ZqB$;duV~X9;U`+-i`+gKe9U_A4zh*=!_@;1q@}?uMF+If zi2E$aV3NcI9J$t#er3@RJ z9Jzl?JfsTZ&lo+S1^*dE6LqnNxY0lygy^1q%yo3ES6i?3hyleCyhxDz=?L`N?MvH< z0|`x^1-}_j>l~cT2#)cYPI*Zd)V{r#eHh6eYug3Pc!kV5foAe?Y?!>4Co|UJ2N1HG z*|=_W0`q<*zGB4d3Csjm1KqmNJinv!O%Gc#8K13W1F^WZ%N{g7+cmd;VTzd@ryIRJ z9HSOW-XTifjU+_?QhTwEzm#cn#xvNsHjA+thpKETaj7)0o{ z7+FOfM>=h&%ZJQow`@A}2=aZ>K>AJCQCwj7$`V-B4XKDj@mh~$IUDXZRcSIw?QCk3L@%&S zf_msPgZFnx`pbgl#i5KxoJ=U=(dxqr%~*# zZHQF@gnPiHW7H(@XSDY`H@ro*Hp`+c$dD0QqLn(Fa$qiIdyGpJJsdk~=x6_8uyyE= zxM-I8$vZ4I$Nh7_Da31*x(3cZXqIW2DU*V(J3Bhw6}u|%0=W2q9TFgV}G)} zaBQ*|F#pafBB93f=;u{8CVtA9pm)`}ou%a1g&~=6H$Q;yfU#;;wZ?js)QG{iF>{#D z`?S(3#SdK^ec8P%di+_6!vJ0v7S&^WS1tBI5)#Pz-lVy<5*z9?^UUss^U?Lz;L@=t zf_`*iZC+q+Tg+30Al_648_5p|92%AnEz@I|0b=4x-Jc4hYgfM!iM`cRU@l6i$H6( z{FFtfy1aJ;%jq3~k&wLtKZDoHnJFM2Qs)wx;kNdy7PD_Q<|Em9bq3vxG30D6xT}~8 zAcdVXMd)E#hA#Q|^EHF4aZY03HDlO_VK3g@+C+mY*n52`h2fKSRGS&@U4XCTuj9n1N2KDW zqQ7phZA9c_!ZK4^zjhLXNX)k9UoqjBL^E&-O4%x2mu5X7vr?*&u8t@qAV=__e2nWP zw`?n_>2yz4bB=WCPhR$jAALNrJz=X4MnuictHixH;yFrJ_H0)8Xgfl7Ont>;EEcyh z)%FCl7zC@i2Z8{v-r zc~g-TqMPSK|7^Y&f~Udu8}#$eM8qkI*GNfab6t+4Svy$glF+c>HAe<)_`aD1gClI` zlr>vcz;VuEweJnX5Jd!KxeRAPrA+aXRN%zBy z7tAJF=aT!`&|S1mgPg*83SZI$r)Tbh)=MSnZ*viXV~OoJju7&?2_VL7?t||!P&+QM zKWbjbp0e!s&Yv8)i;~Ydn24QYaIE%VkMzrTrq# zLAgSD7%%QU|=4%Mht}2Tzgj=Es!#~E=p-F_y=Bf>v;gkN094u`$-Ob zfTDb)<`Ya{QOELE3SN=@lN}D0+3mR>J(dfAEYBTWAL(4MpCBGSWVo4a_N=GMNvqiaMONghcQMNtkjJ1c zn~VJ9uP8lI*2A8E{4UcwvXA;;XQPkLl^GAnZbaZq2ZfFz6Rl#4`fK9^AACv(MASx0 zu36=95A^m>jhP~m$k7R4r9J2Cqho3>!j4ac+-+6GM&G$x-W~s#b@O+*7tqziM&qBFo`>_2vf=TK}+4QE z6bxH(Zz04B{E!Y~F82m$JYJ)9DzieDX?|@?`08|WyMEtb`>N9C%!{M>go&S^7Gc4cO-9 z*sfbrA5oLT>1him1fkYrqYU`x5r>JL3AIpf=3W)oJk0|}6C-%)q?Dt`r(^#I9Mz{h zr{?W+_w0}Ea>=1VO?6gQN{3UW)Qxb3yj-t`bZ*$0 zH+*ue{g`k zld_t;iN2{#86;~*{ci2O#&7guoyRM)b8yf6LP>l*kXnZIQ_cC zC&mQX-fndXbp(UuE$#mP$UjS$l8zY7e$8*LMlrFyik?xIp9UN4z$?U?k-RzI4LcQK z0z9wsn+eZq}Mt(6-9IgyG`I}miM7^pG`X}(ud-43)wk;dEK zj5^Liw>OU}yPMC=@QS^CgIG$wEbK-(cI*h*wl+X6PmGczxEE*h$=vmoKhRzUQ1zg} zIR1v5{~JhBdkg!D?4j{)CHSLZ^n`ciM58^laCanG2xl!f-;7m;?@%b$o(RH4wvV!?U;(+qub7> zAl^oJkRwzFbs&t#t`NRalt(_NNXyd)3PYJ3D(V)dLt%5_bGI^WIu6f|A1+IRwt51) zPbwS|1XGF8`3D|Y9mOp@o+cLR{J*S^Gd+D{X0c-7YbJ_DG<*=uMLI;{Z8Z=c`wn1> zmM}q~l**yJ*`+Ob*dpkPkKxQhO>BxsG)a18oC#KffU?lGO3MlRqv=+%SMi-p%@VQv zd%$ePu|z>m&S=-NJFMf)vNkz#76k7P$s1lf;``R!lum{+0#nK*Q}NMOjMvoq<89*n zwu|U~#&Vt>YTDGvID05jeQd?IY7z!CT(t*P6q%}JaVhq^g`8fyZ1NfK`xF$eypo&J zLCO3HP7qidW3^QQRlW#J*0Z5q&^eJZW?*-XKcaXjIAMi@9*m&A1~n0xZ8re~x^%$M z=)E9igaF{wUnGwQX3_L@lM`?+#1}yr>`F)94-?aZYQzni;YsR?JM9#3G;o^5Oi4+oh%UzfW64 z**H2{3GIc~synhsk^x`t?IA4^fcCYvcHbR&qcT)28@ z4Su<9b(?lvmqE?7&Bw0GhtD3XZk|}V-e}coHsS)UxPxZF{)V5GaF&;cKrMs+3PnoS z$32+Of{tBRbUv0C{S8j~&mhonDlBpZQw&uUMpsm~UJ2(oZdDy|e-ZzuaD`Q{%0HG^ zd!Z|et)z4FO>JOLSC_CTDw;v<7nZ?95(@;Qkdzj`{dxQjm=&W`v2{jJ9Lx03 zPh7A7zm90X8BBc*$+CyY(X8@(RM}wbUU=YdnL9t4S|6!)&xBB{r#8E2_LN7Bx(IPw znaIl-zh>t|7x96}ZeKN3B_f-Rih4GtiYSY^U6jZ>yB_tD#wf|@C6cJ$AlQtyuN5V^ zuY@_Bz_X}1`ad3vBo^Asu}B<;+KUNhtreXhUg97*f2+kVmH2jVjvPoDA0C}6*x(@A z-SB%P@`6s{j(~jsK|1?o} zJ^bZ?7dMq0rQP-5-ChFOj$7`ITiRY1{z0Yp*1sNVzS0Lk{Sng}0IENyYkNFcf4;bB z`R*U1{>9c=8{LZPv#*Qw3Rw#a7sBtYSKM!hU0=jE{JA<00H63rq6h^P7AoD}oFSB9 zK5Jv#P*|k%>?^02K8lvdbz%UU497SBm@=cgCv6wTTU$I_{UWQpH@u&_JvI1wDzePW zZ9fbZx7@05PqtS0Un+l=wKak69yHA9EUAG_*1-k!3ZOW9bI!faQ+q`NQ5GXg7$3ulH%vEXP}v= zkfIs4>#ddQ`_n(`OXLzEb_dZR|2)leyzAP`vg3}J_e9X&B7NYA*i+uqc;2&X``F~# zO7Q;lgd4j0&{b<@+=Fg?=>I3K5ema*`ZAW^u}^iV_t1Hkn>yw$b9!JKU@)W;Nt<|9 z;Z${P(2izPfY*5oV8cGFe6&A5RXBNyJ@rW+7;`ZmaVx8I-`$7{sFT)r0?ftmx+l5{ z|3>+rRvdZ%U(7u8=L6EUs!n_C2I_eRDeC{^vC%%`*!(3WHNFIdrQNk9t|M@!c;_V`?*0z>#?#+` z2hD{7u>JwPe}H-g?|K90SLQl^sxJOj17BF^bCiWdpetJHP?dkpUoR}O;5hAZ2mKLm z`+r763V`{~WcLBQut5EMr!6Q+%|LJePZ!9ciHsv9aS|xs zt!y~5ao5{2KTa`oB;hzdT!~lD9o#P828PrpqAp`zb93IM?R2;%fw&nraDG{M;n@|< zz;KryP5Wt3<3Qlxa|+>he<>sucVpks|4jC3$2~Y39*!@i!U6!N`}+{__k)GfON!dz zxNJUlS-yiPEf3ZI?UW5X`x*XUDGJa2`3*ClR4NtKosWC)Kr3v|)nuXNZ$7Eg#{#SQ z@Y~ZbPO%K##N7)8K3Ae8Ma3WNz|sa_$@MROykr{@f4{KB^YJ<&(Mb>!7oo>tM;eW> zN4JjlQulQ_B2p$@0mry0r&p^b=lA%=!``dgvwpqs?5dH;xAkthA8s32%GBNVZfdqm zPv7LNjU}1q zpVi~^-m%rARtVX)Wu9}?Kq)a@jqQi`Oqw*UZzMhDs!&BjLxVz}Da=VErcW+MES5^4 z0Oi+5{{}aVUt+qz`{FAqGBG;c^?W^rin?)*Uy(@BR?`kJaMYd%uOL5AzMzy|_(izp#Gox%96% zCnhGYylx~bxc9F7$N<9vtG~;>KY??Um>F5=d*UhA>S~Vvr-bsia{CvsljD2`S|pdu zEj37`vTNSoJg1?FoQdCTw+oK9tuax|v8nwnwb@C1^w(0ydNpf64~~w_vFbRSK|fB0 z%BqegZpK6I=}RrWda<3$Z%Em$HCeBuv;Hc}|0)YDctJedFjU{`^`90l0d0i-Hvcm? zf6ZZTJYzJ|dcCmZ0HNVmzgto1?zG4C_!;fbwzK~;mZShU&jzLswR%2+*QWTUT8B3P zOT(rV)ghh*ls2q98(h=U<2)kMiIls3TUR}%QjWN_%I}DG$%&rHrBNi~9FkV&wfq`o z!*?Nk%r2i>;qA(vvaye&Gf~LI0zLwMB9VkZ9ogtSsdx|ie>Bmb##&J*87C3>Ci3n1 zaE3xc%omKh>q6do!?SbO!ozk{2Wryacxu1onRPA0?`gZ@iqM~ZW z&ln$VvQ|{Og4X=iuPZEazussD{RaHML*_3K@BTeGyoAa$=#CDb8)K^#r>Dngy9E?+ z?sP-2?DiC12TE_geu~w^}3LFc>iQa(( zEdt4?;mRtnE78wSq9<^rBTIxrPl!x}H5|(>m9i)QeebWG929!uwn(CPDA0tCMq_u6 z=RS8KX;-#bq`kU3)F+Q4ebzf8>#gx=obJ9`+`1ccSMKRXzu0;UWz#PZ9l*b+KNA?p zwx!4EX3YHualRC_|6Vksq6?zZg!@`DYEGdp zK>ln~9b|#lp@=S5LjMryfDlkY9%Os%uuyUrm6#-Hvx(hAjeaV&*82hP-2^$60l1fP zar%OpB&UF{a!>=k2Zo7$nHYqSCANN+4gzVrgTry-3_McX8_5%q*=T}q9Q<*Kj(rJ_ z#RN-{^4g5_Up_TNOc5|Nyh?LL8@sndv6c8DtrSM|pi|(#cEZCV=8?v|w}Hdbao1Gt zU3SyBM33lAqg4lsity2IobcOXO_}j7%n~E)ib_j**KkhkATt$|;6(%{t#q)MbZWm0 zo2biDL8*4DRr^@kczDpPRB%^1U6ws9W2n&iQnfyM0?flIFZT@%Im6BR+M>WWhuGr} z1klTKy-fxnv!&*Q{Pxt@>D$lQ-G!WS^RgkZuZJ4WJaLwf?d=%9;lMez;>=91nYbsL z@*p&HPTc9f@x}RuiU#jR=o0m#{X=O2bNE zR3;8vW(Sk4(}02B`@2jqSZT`Z&JzOvG8N&ouF)$Z{I|Ld9m5gKFnXl^NIj~z0#a2% z2zeq5mI=^QrMQ|fg(E^UKRL56w%|14nVegEC5eYTLoqW+XdOQ?On1&4g=3t?An8vN zKp%=8pnrvGbAQEZi?h~=n(ai=1IO!sdXJiw^VqUg9hM#;$YcJ)(t7DDLBOi=M*(5i zT^Xen%wo=ynkUyLY2}>5+6C!@Ow=0#?G4tsnjunb+AcjmWr~0%|jNs^4^T4DrYE|7&SwfO`!Wc9D!&Li~QOa{= z;CIC?M_dR;Jmf>iw%7Mn2oEqkwAinf^6FRamy1}U5D}xC=+efuOvFcU3rheG6DRwG z=~qew3n{4aHk}^8C!=Z(PBXz*`ZJNzeXq+dpQe*d8dE{&@s}Ygq092B^T1v1bq?fR zAK;M_8vX@7!wvJ=2z7Ju>-k5qy#@vxj<@>Uot_mB5F3Y&4T<(R5A1tW8vRs~&?C;m=}(G#iaI%JH}mc=x< z2w~((HXVFIw?C#NQ$m4~#~(DrVbZf)gP}wxJ=|AJ=wfAST)GWtG+jKUH`hRU(1=WF zwR#Wz^+S*6dY13v`VNb4m9bhE-237IsdFQxq)rcbLbu3^>&aX$(**k0i0T$li)0M+KYun5T}J z7BtD8L;hJ~|EyRaJjFL07ny2$mMu=gJ^%0XX|8e)W^|K z(vVC9)pQu*C-yWf=Xu|6H}N!Kv^T4pyuD~|ckTQ|dIuSi5euy0Cr&bFT6AYZ2zIc4 zxhSLSt$0J*#it7P*-44?6@7|T$CRC)Fpfp8B4A3Lo|t4l1Bh){BP$V4-lGph=e3cQ z_u+RpJryH}uJ=MKZru&`P87`XEF zA;|3tx3nZ9>}Gls9G9+8In1F(&?9`E;QP#K?Md3?!h#p@c_Zo$k7^BhPNs-$5n0V2 zXT>0wnk-Qz`YFpZz1XOJk8r6ycV9;%Lg!@n^4(?#5XX5W>%Lg9A$b^%l^bB#-f^?Gue5bhc^wZakE7a-51x6Ol#hqK3J#qFv${(qElg5on z_`oM$KIk9HfgN!JK9!^(x#}BdHpS5=EYW7)#s@cciIT@GRq@Ij6P+kfvjwTaslsy5 z2q)?7Wouc2_F>mr)F|+Y+aGrd{76_}K(5}crbzSARciFwRw{be`b2R!O{&|^{AXb{ z#K4h9>w#Nn;nm$7YF$Wh@}xoQG8~!QxBcU{XWT)vr2b4!O9QCl4^$y7)GM{_vl9LN zyYFdt4^$g)xM`Dff-|>@P3tMP))dz>oo-j8;^fLq9dE;L$;W%;pT_WZfz!Ug1?R(E z*Rjcw3K>|>!=FXATifoRdBPqO1wRhI7Pkl|zHIY$%s-#rFQ>j&N{+xIaIN8Biw&Y; zDNt%K0ctioc#1=Kwe69VyE@L-OG4|dl=1oQpE6s|B{pT3r1S``blg$j=d`;ssl*K~ z8-*boePon%wUkrvcGk_j*BR&8NL6N{r&ypSrlzW)%ZOJ`=c-el74E*FYK`a~bKi>> z**p&qYO=dZ+57B#obvigGDXoQd$r1jZExsa*j#I3peyy&yLIAsnBe4ymXwF>{#V*C z15dgw!=rR>(Hs(8v{QXpdV06L)PuBrJq}xhFa18xKic$jm@8;VN&$n8S5gx0u)5>? zM+Sj~rfr8D*e*$lWzg$UE)R1qevXT`oa)uA7FW(tbeXnCHMH`Kdrhd-+`{)7SU>2P?kJh@{%F7TP5&SV;Tp4Tp)MGHU2fWp zgQcCll03GXq~*KX<>(Ianf-&eg*kWA&gHif-;cL_h6>q;5eHZCx4;IUvZ z4PzWTc6TTt9pompCOX0wLr!&y&iFXrUB)>*K1tLYwQO)Uq}BFs3Cy`s*gUC~u*QPgV>Q;wf#ew*USRV7`t%C^Eav3StddPV1)9db zFOF6^xZJjQl&!vdGGn z@BZDRKENV@fXU{a!xiv?#wZXDMe&;!r!ge!(;C9_pA=oFOl-r~5MTqxQtbjjSw^o8 z+=2bvg&Xn3Y_>dbYzuFV#78L##fPDd-7#sWg=J;ubq=f<7Le3p;k%U7_21bGfvj6U z=)}G1?7iLI3V(7V+X?_LV3>=1@NHP#z#*h3Ls;9pMOvg`T}phj+JhaV8<&$Z55m$; zFlnvm4Vgt4SuqS`>$Xh;wT#)`F_*pD-oECJ$BRHCQTRxuty~~L!Yea*n^n%Z>w2b` zcAU&%+cP7M7r$Jxb-VaLbdoZtuw3u3_w}5VAm)14h@0*M3&&2tSGS_nuDN0-ATGhQ zHuS-Q#=v>id|Y=+S$Zo_MQKIE8HMdkW>M%MkM*_lGSskgek~rdNN4qkQH|psxkEUH zrBa+B!<;1=Y+4=mQAsHc%l+<<`dO0ln*S|_VdBXJ#++Mc=Xx=VG91~%y$iOB#AW=U zB+j{@C*nxVtQ+o%ucxam|tVO3bRp>6KGvLBf`*Va^y4}0?_CGrv3T!t{=QT>*t zr+aQ5g%-z(u9w4MVM@$hw{8;9D~{t_(8pN=F*hDtgl24}h7Spe@td_XaeG)bz-z~dL|etD?xNT-4^eo;pGg^Kc+o{yuerlNj`$OKtR0eg zPGh-*!4)JODHs?L6CgS~g+nZa*WPsQc+863w^AKX`3}~rG3hX1DPI~dF3j9@ozI3` zt2kQ%t1->HQc|_Wx}#Yr86T_*!kgM|SmJK`XNL`I zil;6Q+y-g5)%%D-qm&l{2W^?Sj!51mADy!d#iRw{NHV1v?=fWOaeejN^6g;F@;`Uc z;v~RU!GH-%eVR+1EX(M#UQax4sSDg~+~H%Eo;r^&nyhPGWy%VFjZS*FM9gE(O}@5y z;CH38%sj-6s5Y}VO0z-Ob5cYy)cPgG{KUiR`u>oUWOF5Fj-%+Rl)$n_GuB_FcEbLs z_H5yPi@WIgIHKKjNnBxP|J2i4pVhuT#%Chl& zjkOq19mDL1=POUbV?#4D%J7QEK)3gS5`y-UaINjbnr`%EW*sgr8S;~5PC;ZN*ID=h zn>&h#%sFf098WflrMTLu`toSE#R;0cV?7tdlCoTy4V%yD6VHg<8W23rNl0PP0YV0+DPgy6Bw2$fQgS%@D!di<|<(D@>Qcp#A>QrOU8rSWvu4ok4 zw^)NvOTaO%`AgxPpPzN8DxAfeO1D!7o>X@0-N=d?@wmgEXCama9d zBL&=!!quBAujdQQ5k@uL9tn~I0h8+-k}Or_f$qnQ$#XXrb}bF$>NREOJbSHc7(ie5 z#jCFU0JZlsI-dH~)An2Ne%WxHXToM_IW>Mr_ds$5n|u*y7#_Q59~8o+?9=;Mtv#!y zK4Yq>4*~`P#gq2%A59pB_;@*&$xYK6OK?*I|wME53?B*7@H#!Ro^M%#Bllco{ z`=W|%r}hBix{%+TWx64tyx#cx&z^2OD^Un{^_8u%w6u+BH}k^U`}M#|r5)#|HPZ&G zhJODhS}gTrHx;$0Yi)8tBdhPoP*5bWNZbDJz2q~jCs>o*)4dXIj1?7$9Ob%DTX zpIH6xqBCa|-}g}UiPjuplru9AG7f)|tvw$DHS^qURVKL^wyrMR7Clxc*WQa$i_sdX zPT{AwzN<0fZQN3rj;66UcG34Ztfvj#=HDf2W^)vun1Nr|f@Tg`Hw=tW3x$XHIIo%QAw15`6B-JTA@=Iyq1L$NH4$GV`Vk=&<#$Tsr7a zqAsb68sDup!#AjL{l05aafVs$TYPA&9oHTkOnV$bVMGQlLFg#}P7_JOO_{m_8LbXd zdR2yWijthw;Kia>iCFh4Ar$A*$hN~7oo}{<+G30L16P0M8axT2Y^-3&=Y-v}kxID7 zN*ky5@A@O?nq)u8>>%`Q~n?v0a0c5&6H;EAw~-| zFaP-RBJlR`PT;t|fqG$eirB32)0@!dG+U7pY;pW?eafrqi!#U9w4UmALpkGgx)tU1 zcyeA@K|y5eNeoy4Sy@3e!R{V0B0_#hA|jF~5p3L4&I!_6OLNSmyZGFls6}9-8OHgi z)IPn>cX%~N%n}gY7xwluAJtrZ%(%&b-sFthGy=pkTxfY6W;iJRE4<#dqkjg2?5QCjnlL- z{I92$9{!J~ddMoKXVx)B^8P>4NYpGlzSYOG8m{@43e}RY1vLAmb9}U{io-YpW>njB z(2z2$1CrmyN|Pbk!TBDyUfUv7aAfafB%bf*T3&1Kk9a}XEfc4rF^-z@Nz|7D*O7j7 z7{CO(>tK~7eJu@h{#f9k-OSF6r>L~Eqcc&qcb76Z z6`aC;GIsyM#g}a6a=ayNXhAz(1x@Rp$z`VBXxX#sqd^GwfbvjlzT9FdPcf^qZ6pn| zR!ho*X8j2zfpb9`Jjf{KypLx0Fg3M2^obJkA010Wfy8<=luM$;GF(^hC=lm|(%@r) z2kh%RB&`KLRYC-e??3QPnaimxI=o``qJXAuT=&AVz-6Q8ihNs!EmuAe>PtXdn#~~C z&gQ0$1P*&%8*|F_LC;HHW(zLyyM4ho;CsCc>%n;#WPC zDjHBC`!tfw9h}PIBkFV7wlBMV37Dpd&lbfi+9ecVkn&I$P#b^GpNs&NqUQ%)6t0E< zhij(tK&vGm$?Mthx&W@B#|2$L!ioesn>Jj6jlsGyJ)<0n;Uf`F{PYO7?_(%FWIT+% zhz%X6Fn}`_FUQa%2uuKnS#JX~oOAX0H`AYx{Q9vNE(}drsQCbuJm-Pi)j$J2GkKRP zVaDrr=3x1KxnPSxt_Ao$xxscnJRt_6MDe-FRHOU%*?xu+R7_oT%gz_{H?RjtCQv5@ zMx)4YTb+>Jc!In*cASd4n?0fqaf?Bq}*PN{{Pg zqyinBOJh^Ytd%Jcsed+-0aF+%ZXgzbj^1|gR==~QnL+nHy#hNLE&CmR>4!c{_)b{# z8ibH$0J`|vj=VY1ijiVeGqb0*I!^qena}P%&_A>fj)!pw?W6?WYa`i-+W3|F+gNCx zv&T;|Yj^&{630B9vITGJ2FL;tDSXhrIUnU}+62&ZIE@f>ueAK+Y!Ha5PBTQ@vXL1_ z;{Y+a`cTL^W~B9H)H6L%M(U?4sxX_6+51*}*A**Yuy-BI*s*Wu^86Cyy3w0byqF$T z6vJ8uJ5PD}oiXX=O7aUB6wcQj%UbLE(Y!AaO%Sj2qt0wgEbClF zeBf}5_5(v&yU^|s&yp4?iQ(pO$spU#{y=epEng2n;vXB7tn1>sV!;<|xC=n*P1xI1 zX}}f*=SN#TFmyf*Ru>9R=Rcak%$m*e))|d?`z98l%sK1I*Gx$hqPXTGM3dy_>&J*I zeQ&8WkEx60muB0|<1B zDZw9OAU!baZxY*cD7TT`O*~6H(Ls$c9yq8)Z#3y|6h*I*3Naa|c`=PoswZ|t?~!5jV>@NuJfTcvIvbvP&p*sfP0ZaG`? z_7ztWrsDcux3=AnEhn&B1x#)XH`iO$h3T5N@11iQB-{o4TFD~x+qGY1QPMe#yo+og z+QFi#9VrG#wi&U zS?l4`)?sFq!YukR|9HIY-%SE1pT1I{ff1HY!XI*$*MNaai@|HzUwPf<4SeeAk(>F_ zkX~ZxTQ?b&TOs5C7M;NO9_-rM=F|>DNuSESG5=5?-2y-5LrdnZI!mB+_^@E@ys_l= z-1Xa-!zVM7t;sdzwOjb(uY~$E3SG2mj>lL!3?>fgb#o7dm~$UP+vOB=pRO((jqLD8 z*irCq-L@$j{o;*_aV!Bk(}R?XAiXnf7cy8^%&*kxRrPx6hGVb1Q(K&23VWeuId-HA z8K*{`cH3#ndqS0i*@x>#*u)8rS`N9FxmQ5ox?hq(zLi+%Hd}FJBayRD2Ssuqk&q(K zFZa3>dJsEd#@I7>zTy5*UmG+7*fkKuSxU`|V7^OpJKTfw<@Ki+o0Z*!E#85xq-d9g zOoOW*27ZzeY_OU!G|ArFtV~PM-@M-5Njb>_&(~`!*!=k9`qH54k-gl%l|vq>e4S(XhOddOo$_$qYiF_!(< zw~C;EbKdbF6s*AvfSyO3FPd)Cd_xg5sY6gP{rvCqLrVuC!Y8YngZpIoTdi?Fthu+( z%_<%Vd8C2O`oY&?End+b_r22P_E-`gRy}bX}*zJf; z8Ky8l|KGKi&yJcFzcp&sATG?x`Zp~*-hDWTFuzn=b4K}Dim^Kg14k32`mAA0%No|Oy)%x+yf)Da`;Pszne7eTn;kcxv*X(2 zNYulVOK?KsuNEU993b#QpI@%uBxLY1@IUfD5ZQP;nibHK>~Or23JAHncHZ?SJ`JlQwu zbEaoR{oOwNgO);HQf|BaKmB<%Q2_fR+Goc&MQ{Kt)Sw%qPGC8eIE9o=&r(Xk=I?9;Mzn7%Vj z{C61okJA3)UF-w5~%e*ah+_#4Lk$9nO@>l?1gz4P1uuORkp z#kmQ}a*gAXqd${hE7|X4s%G;q(%yf_i2pRTeC(`gtN)y7ZWgt>{vX=jF}l)aYZPAT z*tXTN)3L1%I<{@QW83Q3wr!(h+qUs#@3Z$l=e^$<&9&rB%uMZSM>piGz&=RL#=o>a_ z_6WWueU!^S4e7*xYVLE#Ki0gRA%kv?{yiqJa9=e)W~zijuk3UuF%QBc0S=7eD8u$? zZ-iQAPb=u07%e>;_*Jv}J8&G~E?^8J*5#68sO4+vh|-8`*!>4E?W9w#cFt?xdG z^7#pM{~Ev4`~Oe2|9iY>IhLEx*Z(hg_`jgUzbE=f?yru20sq7j$DcY;pA-Ls!~TO+ z|7XX4N}v4wiJc7BzX3phknNKMCz+q=?%z-VKrH$v{RpbU40qTp7Gf#XN zZJC*j0s28Ep&_AML=)biQn7-SJLCO2KpwhEt0zV)2jqb$e*ra&$g=Ie(W&QI7PHZX zu$bwL#yG+qB@GKaSBtTmlWH#cs`sSDl4DNTO+LK3^fq*>Ej5h1By>f`v& z3y7kbJ(rA08~Wyxlcn02B;1Kg9i|Y#SEtB6b(<6DM!W>Rj@l09Q0%cYnr!g}2R`Re zW@Y|m>${pcsaaul9ZHt>3$@Tj`vr4o!WraA1T268r=dmH<08_qg!GC{9gwb7kTprH zIEgo&wGIHV0)R_%R<}B_T(fK~Z**F*Z1{f`y#cVLpVm?>3!3v47ky6*f1JPn2@aaS zorTxX9W?v?Ji7cJCO?qS`ErWl5qjvii;`Ia#VNeB(bke#O+uT{f1n>yczYKKq2xa~ zt4m@1i0+8k)Df0rrzDuZEFqm$>_C(pb&&l5Wbily6$l2nY`##3Y;}lrX`KE<&A-{< z?;OZ~f&EeEthtb|_tdFC%a&wwtWa+{q}GZhQXXF`5ZXX4q__@X7>=xtX_o&o5^$SX zu7p5uYPLo_l=J{5ptC{)p;JN%?No+PEeTCsCD2bzUDFMXQdKhwLX9*sohXY^XUPIg zppJ^l$d-Z*it0giB_~f#Xbw!+u*NUb9Gpe4(jnJ179y4x`d6fGBlL>oBO-v|3l6dT zt^;6x8)G}+a^t88X+S2+G` z$zHPQNw_C(wX}Q4?WPrexDeT2avh#6Mp{Rgvt{HGd{K@FZF_D2j&|6Y>ZGuw)rP;5 z`w6#HhBI+-p@+8wctNw+&bKJ@Tqs;jSizqFG^6>LARkUWb}uM_CyJ7&BA3dUN9PPU z>fw<9{j9`}o1$91K_~D?a?ko4Q1lw=k|#1{$yDy64w5QtzQ=z%pPTV`GQqa6H2)rABqTo&Po7)t7FlzTU;#j_wm&W5u#@E!Ra33~_^q2@BCz-k4Y3h9~%G*9+a-tUtI607USa{FeYk z66+{Rm{$cV%3{mB`894W!tLY~TCda?`#X64PXb5+ddT;3)9c>MKq2leer0w_Y*jXi z>ALCXT3xO;TBq}p(13{*SobkZo1I7o!~qcek1{095IM85kFt7Mxfo22(qc~6@eVoR z!Z>&RN+HnL*i{C!+BfT#;j092mgJ$*a70v-v;q6_|@z(kMQ; z0~}cnJy$mZgTHS8e(BO}a1xmD>?B#_`+tD9P+MgCN$siDZzCJxP3*K5F0^Q00<{tf>hVq*(sDa#Q?#3*3t^f3slr_Mo!jFd+Qqf2)`vU z2Z$;xeUI~1>9uf}QlA$RIzGYHs}dshx*I|K|r7hFFX_-}=W`5!gn z5`w@`G$D(v`#Gi5zO)pHb2#!40QvLvm#fP|H{Yj<6##|hNdx2atu+aW)fSsIwX}@u%ws(;z)lJ;9zm3Y)=q6G^uv_n2D-b_4D}s(H)cQ z{8t7SeP1X!{K5cL5=He5lyHO1G0B1Y;g?T0lJot`vS&uAn6gxOwtcmiq^%fZ@}M8E zj9K_h#mvaXx$kUgg6B6TP+wg=y*ivf%)jC!Mj?NDg>K6XTL^pkc~{iwejxB-f_a$z zm516mYoGMN@fj`L<=~_Gy%1!S7b&9asega?>bYIH&La3r>&3U>eCc?-qO_l;UtW@# z-PK^(mlo_LG$maG9L{)tqVcA-pq>EDC)yoq{v4i;xjviPl!|s zhbM`M5rN8y2xcLIZ)ZuC+4R&F z5C{n`=iFqaX{2W;BLFt6+w4RT-9|CX*On5_b2*dB8;Z4Wx>52}JIDM4c}>oE1}{k% znB1~CRg7EwCmGpH+(CUQUwmKRV6^H_BRR@*y5<-?7{Pwfix!8hhQt>cBm)54}2<5LMlWe$Qs=X?^d{#Wgc zcV=^(!KLr%L0Y}j1jX2DAyJ@iqt;vCN#6%nuf+q{7MwVsDVsFQiYY}T;d0**sVBaI zq72}K*Z~z6_0{NysP60sJM?||46>gYob$*{=GKPW}NK<0Qj4q4seqJ0HaSI#@+z1zY7?6=Uo6` zdH`Sy0AKxNyjXf!!IO{4o`K%c%(HDCWw>TP z+&8If8Qq3Tv^|PGv)<;)$r7%0d=5c1B+mSubv3`G8){ybfF=0Fxr9Ctb^DPO>!i zAy7Hx$29nZ=?3i;pe=v-ddqMCg2EfgGG$4!&ak)(u&|!1=wATccz1om5(lMVpx9Spl)bUuc)~ z*la=m&NzYt&wfhzTEnwkz4^ulVObTQ!db5^@qzpGnSpyQTZhKQxM9hU@xxI-d!hp1_>h58A;(drxvoQfD3STP>^-G$I5 zBU;u4=V2I|JJKV*lkaA>-p5|>uM~=Mtbb9Yg-Khq^&AboMwf0nY5=b_3`cnkpAdy;;n&`2NY~#m9z(pLE(nYY zWc|2R**rb2M2ibGEV-wO+FmC%;})7~q=Bws2>;TldC2m|E1(XZ-=OA#Ns~$mgPVJo*olW`v&XD*v^{*|$6Xiy!}BIw=svrJpjIS08Bw zvzD%vh%SAvA147Xb(&AzI3hh(gpUTGZfb&I!rxM?iiRX6TR2m&XB*wGTI_ln`{0Wo zf;u~c10kFUWt0aI-DQfexs#SY^zYXj?l&6W3qRWRU-0?&UmyQI8UFVtcxD#>=;_QG z0Bixk{`>8C+2y}C{s(&1_IJ}yT+Vd;1OKlX@Q9uNXr1w2+x#2IW&O`IRxIl-|5btX z@B06lb6NkBn*SQ#{69WsMg2bt%b&CSC(d^v{jovFd@V@QisKe_L=|cx%v?WJN~Ot7 z>41TFS!fRER*<~Y2^ARQ+(Z#@RR6r0yv7A0qEi+Krx>Mxnu3A}%VdB_s z*AXYj5g=We$9bh|ww{f;l;VJWNUi2+o4|76prVfSr4fvL-B9HT(_S0R)F~R@BzB&| znfj^;2P9If~fl&5Vgm+fbi$tZeK^Dg83A;Lfo1O|GAM%`g)tCq2w*17v88CS$ zx`hT#{>HX=aglp#jyC5NbI1<$O1Y$Yy^i^|IJ+LC5VpZH%NOF_{^zbP_JF*m5?Y5f zGKXre_V?d(tT-9#pc<-{H;SM}wuyJANl8 z=BHcOQTsHA=DC?Myu0vm&bgi*UqRW{N zcv9~GLl81+>IPeY!F0LIQ{Z{@XoT4JfkR|f&2~5@+CsFd z3U`XX5Ci`b&lJ#>G*4lsxMw`_1EQtyhBV6D6zbC&bLBB4lcB|DPvE{b^XHt_hburgU))LYI5AV{!E#P{SF(m%c zK?#p@T+Fq*TsyLIJXgf}b|(+wOyS5nC%WWnKNADmuul$*IeWExHR>Y~giL)!P08h3bcY zo^}o5vg8EJP)D(g;h8t=f@Mhl3iDU(Ro|fVbO;@)XQ~NeUvwKb%;G~5>Wp413l8nM z0vzgIw5>H8BT*iuUNV5U*Lg4x&veJ%vOhLF+{`zaGC~2* zWc#bNeGKS?6^^rEANqZjD9K+7BEvE+c#lkIM6ynQaSeFRKO^oE%{M#jy@DEC`&BrAPRcOD$-=AJ1UdkxzL^_OuSCq_t3jPbNF z7FS?`IeFd#ljA9F8A*6CMVgcrLaQ+iIWky^by#bHesJ+#Zwg6fcT%4?$; zj3CN$B7$GkF0zKd9*GhH+>!4cG#J!)G2NblP&;9>dX~xkqmdVopzY753T~-+jpoB# zJL}(Jz^#APXGOFc8@@In^r^q+BhScW1t$PWdnaH1I2^)5ZJh+^BX~6uXIM>w@Cl{I zY=d9%q&VW#T?(!rqrbrvp%Kf}Eo|*YM1z{t1-s#)u+tD0pvLN5?bhhL|825wk?oZ@ zpj;ayYihLcvCfxaw1Z3lR4P{&O{C27VY zg+l+s`#DNtK$Kq65b2hvYLxM9yj;~xsIZS*A4LK0W|swO z8BT+PdlMF2ZrQp8(uiy8V8@+grZgKtz%0WUhWlCxjt(Aodm(*UU8wXeA6#;*O-`9; zv>+ilg4;}i{7-hn;2n&q>6NWSLv33K6K^I5Bxd4R9Wd=}Osa+#Oyt+yQ|@g7uae3R zHyE4EYgqi{&IntG@?@MHRN|Ty<*Pwx2PXT!w@Mm@=7VyfXBn(2Eu1 z@kIBDv1qdNnlOv0UqC+Eg0tj@$hoX^d8iF;L`D4{PfB>UdM|&mhGibm!Z|1bJV_?1e ze)?Xnmy@XI+hUD!UC4u*rQ|hmgQ#b=!jdZ^!T{P>iqbJKjX!n#w-)Yk!i+o!$0 z)TbVSyuL_4Ajle{K4Rib9$Y)5%s^i_VZOeqMJ6bGKh(Nj>X^=IX`+oqH~28vc5k88 zDp>u{!b^3zYq!|3Ej0W2!^66o&0A7$k~nIX+=*v=nP;fgy@!dpt%gD zH3ur=?86lOeFw>gZg2JHTswiV?|l3QLh0^FyPCju6=}hZcYVS+g(vP}ghWfQZE9N1 zoZzD!qof!r%0==pxK9ot=~I)b?y{hkp%aiv`OPuPKBC+(&RfZ01k|OE()v3NxLHI$+O;Biz;C`6 z-!Qh`B4?d02jZ=r0bt#6cq?X~0fOe+`hi2g_cIR$l4@%v?JIR-U#%TF{F9jFl{ttt zSns2a7ilD*t<%u*Z-Yf}Bsola=#)jn0}4>Y@$iQ`-SAbgnln_)LT8nKY!m^_qgz8+caD)l}ly_B3?Zz9vL|i1qu_0 z_@lcG(0!znwKV$>)sY2eD>;-xRV7C3_?ryd(}E# zXEfq3@ZPrWL2_V-syL*eJ9;R6B^U@6w1#C@9Q2|D%#UHrUNuk4CisqJrpHY3*kiA5 z7&nhW&G$d`O{MO}y6l$r!1*VTi_7ukfhR;MG%G>`ZnuY7ILRcYhz3tr#~6y*75Bfa z67!BM;$d0^v1_q00ijRS@!zC$si+{$j{OJ4v&qirPS zzx21t)d&bb)$to|&k{R&_H2EDNM7aN&j%e|?6{hYp*KLR>+&RYr;Aib-&>UOP7(7I zsFWpe{2;Iku%!5Yqc-<=>EkXDolQCE%nUAN;VSlyKH5XUU(O$sb4er-f2vo=!SxkF zCmRPIFD9LS$ovc-4pGY)ZE<SnnU zQ9a?o^|yraA*liEq-eY$JNRXCIImLRy4b)SmsGFc1)7KCb6Z^)jU;{-kK}kesrYsy z)lUoT)VW`RDDW$O*?dpp%UpOI@Zt)Gkx7^-G;(Ogq|+;Psv_G{uuaT*R=LmrTA#$- zh^~p&Sa;%*CDJh5UN7?dC`OG887(4;r#sHyP%IGWD44IFk1&x{#Z8D;oc)?0$TkC4 zfGmuMU5DFwck8>@O?i~MF@M##DB7Fl_JQp~?Wz=^JW2J&<{e%}W1G;VWmOmdRT;Rc zjJ5|Xg*oKXL22hCNeQ<9DiN1xzy9?MF-BD@9PP1>5PtYV*C{^fs^z z9w0)@^%E)N*a}ycZD!4BfiR7}y%8(tWQ>!T;F^a!6Kp%G_Xt^he1n)SUkJa;d*2L4 z(8PUfBnIR0idY}qkcjD=0LQOYv>~#2VcR5Nk?Y;T5#ChXN_;y>%g-&hS!**2N$Sc( zM<>6fmIlZ8SD47~0h>_{5kPl8k}L%@3o7VQ`R!K(Rf7kCJ@u-qGlc8Nfa8dO(MvrE z(HY9qvVSezgN0L=Kf*+4L}#;yV?qD9tG*t28Ci2H!koRH3wb`0X|U$X-|=Ph ztn8aXa_1=+r`=dsthe{_`d}E9D?+%UiU}GRE39;oN8r=fZtU0dxE|@fI1&hf!fWG_ z7f=++w(s3kT9$8TGSNKWN{@T_AF4`c;6Kb=+oC_TVb!H`VGHRy@wNts{4SFMxY(wX2X6(mmkO!VmtA`R&EA0*Cs8J9_#UehH_UI>o07MH9p z@WRz$br)R&21YQ$XwOKyW;#JhPb#g(DS@u{fB-D*K$Y=>bVsBNJ7@P1Q7=YwJ3)EV zoRmg}8#u7x>{$+PIW(z*pB|bws|HyjkI=?>5HoQ%x9DjUuim|#cte6+(4%Ta5TiA# z?lx_roLV+g7PKu!BhGkTB~g_>pj@>DVc#vz7nuhMw26aE`X+AjOu&++WhL85)8sJ$ zaaJT!9uiPl`;b9IH2p zrhx`r`bb&c{9WGG4RDUa@hvip9;26?@6FlFa&4<@P*in*_*ulw`Zb{jGk_>9y9&D}+G3J4Li z{)hwlFw8o4Fp-6s=Y+T<2UNXzG~MyF6*4ZZ7gd5}x@K6d z2hA3kujh5*4AVxkZx^kwo!tplTB!jcwR)3?fhP`@wX|=GBB|j<43>{34z5%b-7{-T zU<-qY`6W)}ymRYlNnx_?-C~!k`vZhxw#>5N4Jkn~ozs|_Ts%?*3=5~%P+=BGK zS)?bdpQsG^z|lPK%(?)50X96>8Y(9Ly!r8(ho(mR86UPQ%(5WL20VFs;>3w@dI(f$ z?5qhP5(_ecpWDFX#0v@>sI*zs4==zT2#^q2u-fvH!F-YGQlPt@(`H0d->XwmZ>LF_quf*HnE-Ha*3t zMf=^8he>SXu;g5j>AJc$&Vvrl1L4)0uDu(_E|9w?7He&*qiNP_G>mif(}|{axIckQ*Wv4FR2=~$D7X)7!&@(tbtfGR77=v- z?M5lwMxv+F0aVtk^z?MV5*)(%*x4W>F(mC@IL3|0*XhAG!vuw>{T9p5fWW*YztKF?!^yYaCS!3Mon2u2r5$tAAIR~#v*nX87SUeeusc9810+8a5BxN0It!~HQ+PitL#8bn?13d0%xqO z6u04vX-N83QALiEPCYKPlHI6lsCA(E;RijE^^8|F{;y6}cXi|g)u_O1_NpT{p$paaqGyotmKJ(}~_z=QR(3TeQv(ib$UL4nRquo=TVr1WjdwkFNpD>(pGKTS_^ z72@^gV__R5<`Gzx-P<^AYhoZ(_^16hjlX;#kyQkBb>i7FTspqR(9nwk&rsobdaCQ# zfybc~JtnmC#FjUL_N>i7Py zFZA1{IV9lR=}zY}0Ig+y=z&5Q=lZeegoo>_Q?}01eOSSux^T@)Z;2eOS;pse8-qWi ze;$xFmpll6{&rKgM7_{9(>xISG?k#1FHL3zV~RWfqxHrAS?-Q$mehq;%=c%g{!Y>f zQ=T!pg*p;#(IFr#p*$^g)|B`|wQ{3xC8WQ~xWtjTK~>cgi~Qla4ey(Ni81*!Vc2&j zN#DD@fTT|fOq&1r~S+jc=}F-0pa4(mH~9rOgq{%X=YF+Wl4M+ zXUjYbsQi~mETDiML&65ASl_QQ4v<|TutH90cTUC{YX+@jM4FknQ2n=nG%GSCo8I>w z!c_9x#;T~tS$&8YM#KL8H|)@3pd;pEl+D0KZ=pCLFuZQeTNjL|;+>Z+D$%D~J^qCF zU6Tpk?d+*GMP<5s!Lvyr=Wuj9Hm+R0FWy_|(O0=Zb16RwYq^Mue)3xU)CYM98a`QU z$2)+Y^+M!tGW|e#(x!hsaYNw2Fl&FFV3k1ra1OYfjPIyxPjpn6#haFUV+TJW@G=;f ze#2J3(w*H@E-e1$#SO}kt}s*tp~(p0C$G54m?zHUy{i(yQRLnG81LJt*3J{KCxU*) zCx3nHMerL8qa&Ye6E=F8bhud}zqi3;G5NU*m@5*RxzZ@@6b(>LTts!z7M^!@#203} z72jrtvxPT3Op#625w4A{Ks98nm6{o``8MjPYa=XY z#P&p^sAYEawq|4Qz_x=yzu~derPI)<$WAt9Ib(0*d|=SE))Q`AH(kv&-lE@C_tyJh)b5MILL}Z?J9rp#S$#u&(JS&J*4W+@s0WT=+&;*;nQdJ){NQial#`TXCpbn^ViG8F|(A5KV=EcPp5=nOB(B4 z2B<5vs*Y1L7LqX&4H}puIC7a6G>{R6=Kg$BB5Ny;@Q_+er-Fvsh4Q&PXz(!A7%vcZ zKdf&oF<|c^)3dQ>MoeTSVmSSh=oF}YbA)`l631SsNj~4Jv+n9cg?q;-<(s!MFQ1%& z7t2|DKY@)mIR+svX2b@w2Yrr1#OfdBZh9*b$Spc%>183$=h0Z(woQJ_=~E5waR=4> zbycp1CL0Nyz6rzL0yn2guSE<$)-18~^XvB~YX{R6H3hNm6&Qt^d{`<* z;E>0U_53};tll7iUWJRm$C+hS91T;Orl}E-*i{bDbfU zWd7DD)zN73sSZPDp77r33?1=qQ?P>e!#{)|`_SO?ayUFkuhk~HE0$crnoG~FT?R^% zqwPATh|^vY*gH5oEcftQ4(L`x)9M>knpFXd5V7^h@zf9X%C74wWqagneVAh)&^eNJPnrE=%lN2gXE}VfA*s>mE zSyPvS-{N}9A}TNnZ^0WS(v=<)tHt4T!h_3uN4EO%OI5>&n7!6x-f44HfaAHR)u>b6 zsKsL{b84(9AOjSlx=UMFUTZi~UU&xxy?8FQ*_|c54nqIKjwo@EMqc9YdCSizjg8&} zd<64;p}N_MYmKKN@I`Pia*YJwF!P~j~{Kr;e6xvEYHxJnfOH1nDBZsEj78C z6;&wu)=5MY^8At?mM_^um3>pvBROZ`(HoxXL0VDk6_M-J%{nZMCNnrX`p@&X+;k>< za_5q*kdjZdfZAB1a{6@V}DoBlhA-BAOYxG@!yD-5{mSVCO zCt4rNHh7s!0exqCyq=_6Rps9PVUV3#dS8g)$L*S%g1J;g2DiTYyc?_fyEbHSw-fL! zFBrFNs8mJS0L$jneqw z4V%>2NcXrQc+in7=mYK9qa}@)8zr#Z1^f$ez{Lrj4oPzY)Q4_2gn78&>=hd#GQ#n8 zs;Cj0!GUKLh4c;W=)MP{Cav${ZLieSUJX$pzjqz3+Kcm+_Q-%5nCs2vBncU}gZM#T z9^2`N!>v3;-~~R7LFi_XYj1Qnqo-N1f0caQ19&TJzF9sr;ZmUUh0cizHLda|hwIUQ zy3huaY)G5czfn)e#`!gKJ<@2`MJE;hVBfcJY=WEZm}Od}dD&6Dovfi64UB;$z{rTi zS5Z$NF%y{m%p$z{HVK`0c3;^&Xpi5-o5^LJNhh3yku~2p5gme?^B!4Pd+B#aoG(A- zMXyHBwPcL`K4X;9__K3W-t0Y&Z~_#K;Y!J^pC%LtG-YM?TrQVfDBxbEt4i?>;XTyh zQj`h;B%W)Od&%*G+2zt#UJZX9c97-fJM5) z56p_LZQ+jzGH_6!uZAR@TS13g`uk0|C6!JsKuv&^*T>QeUt90~PQrRM7}z4xaV1#B zJQ6z~WZsL8_)FQEwB@6XNJ(imi4>+6{4)kyRkXG50GH+7ps>qSS!QhIi&5eR1#BL} z6O22v;Ga*lFKb9yx)1_0Em7K7I}41kndf{=Px{UF&?jqg znsl4ZF>pQSlzO$4N)T4J=J1O9htQgTrL`Po<$sT3;d!j6>nFr#2LIM$X~BI<$f?c< z^kUk@!upb^-2|*uI|L7=gydTI;=^pktvJEl%Vj6WRjKJqKw8m?MV~}35ht*P>`MSu zwFbM?1$20Fty&5?E980zIVQZCdr7=fSvZ5UE;32XT4l`hwR7sU;ciBC9r3BW+_Fb| zw_kc2HQCb4OCq|Q)7oBYwmlIdXG78khxq7o@l~ zDXTMu%ctm3vjy>anc0no@iWj=gGqW%BrXpYLypUP!1mf@3hFMGugTc51Xi43@$JSWLrRb<6=h z>vbh^S(6lJ(0dqEPvWkvKL^x4T)MyLQ8^e3g}cM7TVqSQYr<@NA#S|2V&D)W4%l0& z{?^wpcIWWY*4@)~#w^jyXdXAVG(?Y*GSFX)SuL^n}*L4(3*` zwzX25xX{mD7^ZM~=|R|FE0%kaP1IS6UdD0xO?TKUb4*iQj*xPaw0Mp5&MR44aQ_Ht z+Ph%wg;#VD$Uh&WgAQV?ny?N1JB9XyxW~Ksh5I>vD?IGgvtXh@0`-wH!MspPgV*oihM1_C z2V~jLd;L~}fuj(WJ~;SH;148M1&E`WAbHR&Pmeu&=>?oInUmZ}&+k(;hnJ%WHn9D4 zhhfXR5f+P0gVrVPxwU~G15^0W!%M-7uQkG5&J-N!Qh#l>97`7o+DeQ7F zWUPKM0G95=Th-~Bn%o=CF}kYx&diei<2+?3_(lZs3iU=^z-{M&`XThBXaC_MCo6XS z313A79Wa+VP7e*5Vu##(UwIK=k5WvZr?GM}Y53+62EPx}+thhHRLP?_T?XpYzB<9o zn|n5Bbq$F6R>zXJJOhP6wH>JZ<+$KWH8Ohaj){`&csZAe$X0&Wd=DQb0x<^pP`G1=BegHhS?*cS6`de#7sug0hz4yPM5 zG+BH!wlPh?%P;fG@w!ss&9z&Elq>C$YJ8g|B%NQ5Q)^?|F95Wra&dGn6seYw@JGC0JdA!MESyd-G4(aC3Cm$X zG+qT0EjCVZC>c#-;)u@sX{f&-#uYjJ$j(n$&>q;M2N}-$jW^mZ)b%`^mx`c5&wBC| z$I)x;-ZsZs^wD}+Z=Mx%Z5fRfBFv$4mK1ZZsZ+zs+|o`ZM%F_EzfIk~UGQ?^79)wF zv8yiguX0KY%LtW++C;@6!QxyYlOu3w_!%7G`uUyfKE9-Vz2m^Va7&KFHdS*XQ*eAL zT{`k$o`_4pT|8uxRBErYONQy@Yhx?Tq!K#G;W`jtuQ&rzV*T`p#tff3fN?yhmpyTY z)o5|oEON*G&ws=4xQ$CnUPp*$PAz za>N~;d`ltL6A})HjS=5OrG9K=WfRdh?(K~wzB4lO^E?hQ^fbYvD?!6qHZ5sx2r34I z21mUKW#*7nSP7Ba`Y|C^W>%Dz#1cpQd^AgvlXEpppSVd&OsB}3N)v90THHpUsJ#4O z3AUA`D^)ahRr^K>oQ{ws;Kl7Thcu1-GvxK8kL;MqLWeGYT^8TFkv;pOaGcXwbtVS@H|r7qz`^STva;^(-E z`P;C20ey42jP>Eyry`62!Um-$U zu`Mp1#S9DXUC_c;etq-U%*sj>sXpOd+rkI&?{bpnnP{yw>;Sj5dw#hK7p^*aBZ?SQ-^equ+6j!MQ#T^FUSJ+~1~w-qI>@wdT1-pNaK z*NLb?czGui3l6seWoL*_q6%HU2s9CsF>GR3L*2h6UErHGaDNCL|MtJn4mD6s2U10% z0vcuTUpi*<%XN9t`9J&THo)Eg*y6Yf*WiCa5WTW#?5qer~6PTVYRH zt~Uttg$ugZYrB+=8_OGR5 zZPoMPWa5*f-J|G4!)wZo~fF+lv zo^HOu%P`1H3sQV^p>z$&=3Qmk{S3gn#&E}lORKrLy;t_lEr*=`9-oO3sGZ6pk=~k$ z+)=vTdvM1iEZX^ni&@K*7)qYCUI~P3Fuco4Bxv@R28yxX80#*O|8{TSLq;$=3x}#l z!gE7=MMzq!SblyWNNsRr{lTOhp)Lo1!JwwVgWW=?GCpbL+%?} zGNX~%frB)>`*^+JUM@c~Iz?eP#5F^~nd~C)4Cjxgxh%>fgNdo(*0=<{}6-6L1`VAPB01(Tp{i zJ7b^;jGI2bZ1=4RE&<=Im< z!bV}g<(Kt0H*=YDpRwIT{8;>DEME>WOEA8BHr|Czm)HGfuPE+0#)Ls#87mxAxt(3& z58LzcsLE#D@=M-v`AwnwM>Fo*7xi(@_mCZJFDt{r`{J7>r@APQ1e6+i&bPUJ2;&HPOxELfba2z& zABpmf#EpGp!i!&E=w07!SLO(sQ!_O%?&_pPyQCqh?RElBALxdDz*@ZM@`tYSCAdkh zeFMs*#3?<~9r4Ma^LSza+5^Pui!4JxRd*59NKw zdr#82qBnXkp9OJ9X1DDqM4_1y_QHKGSrQaf14&(d477B=7CS%uH}YXDYSOV2N8?m^ zc2p715qn~F#Gv#TbEr;u1(G`%RB*F6qPJd_U;UfTH4fX}!A1GceDUmcvE|sYjtorCNGJMV;BN4fyN*Uez>d~D#HNPW6?o@`m(7UqIAJJNqUUGV~o7W#5y(BOwh`q}MK<7WgW(cbO z`%vgBj0bovb5hFCKjFFU(al}nJKpusi{3PH(VF$vgr|jvYcMfA^dm<*VbcI42DHQU z!ZGE>7sfHs(0Q%ZDgSrE0{ZVNi=HW-vvcsMyKGls`#C^C5fhq=AAo+wWNZGcgRV%| zLf8SeNeM8r&nl}k=71qDWmTu(g$ey&&Q{-s$|_DXxV$3&p;BsaiJbVy_2e?7Ti@{Y zqNM^PqkQ4w{66g@Qcg47QzfX>ktH!Sd5LeYYJg7vhdOMelk-TiLS7(=xp1T+D;cKB zLcgTPw3^4@Lo}v*UCe6Qre+@b?dQPRyJ7cpZQWGz+fSJh=%6_}e0z=aGM(PwLyP*? zr|#sfP+`<1a&Q;19Hzq}z7Pi!7My*Rk4n48u*hi+fszjfo?VHh7^|UmL(F556!$JV zHcGS04ffDu|JeQ(<}6pV1^!JdTElIr z%PM{E-Qa+U3-(H?Lu!Wwqp|P?!RZ(MCh9+c%s@nIPEsrZxxM3vSJotuyq$I0cGO(~ zig<8EBp%XITMS1)UK5Tp=K&KtDLQvhUcriK^CNV!0MZ*;>>tx$CiD?=ub1q%E-B~R zh5HJ9ivFZjqAmu;jz#vxibYu1Pxm+=0f4mmXT_xAp0n?5Y-38u%=>aXr3wD+=v2!4 zcPx^$f8fut9hNcB1B1{a<*5-6)cY>&-(qa_hY40S>icF`vCSgCQjq@x6!zGNOJTfP zJD>$~*ZU_W=F&~_>X<3bdpPBYtK4QNe>@AjbrAw#exZ?89r24<{n_tjpV)o=oYeOa z!^Qj8Usu2yT56b1nRh~;O@Ugnc9sCZMXHBcu7I*IF^mUPlIeL~(DRPAht1@>xImvg zg<!c=!h1XYi*@e@rUTHbaInG_x+m>rKx1M#qS^gtF-L=sKOx7t+@FN zz?x_=lLnyr5>mh#_yPs60d8JyUeez+!46?+VBEgBweT)Gfw=|N zARvJ0=~8?ENCL^44$?L?rx zgPXb)Og(RMHX#gv8zlaUZW_!Hx)dY?SC3m(2@jv9C=>&br<4a10MJm65QBTcQv%SS zo>8F!D48O`o|^!`b;YC;puMvbOjtm@OrAq~4UfryeaRpb=!Os$OoRNEA(&>G4Li&T zKw<&3BMOV)ic2Rdu&^Ndm^^odkdDkwz?F%Jk5)2~Q<5J4J`$KA$QFtg=}i$BGeZ&R zH=AI<3zr>_B9@bH$uj(0y1UgCL+PzvUUs7Lu?$Q^Jkv)xs?b~D3!s3>`P1ivrGat? zVo(WS0(ky(`ZIx3=RD*zD^q6nQknn|y#UZ&KigP9f)E0K$~~1{@GIs?CJLDu1@1DY zfj>tKg$4j1$D~6+ayXDI`T}5x01OOaw8$?Jh{Q}tEVztJjEDdkL;yf2T?AfNV1$(? z<_<$nl$WK|G+N1^S8hbEeOTh^qYTD3xKP}e6GRz;ax4i(LMdYcN@;$rGUozUmm4sdWPE#TWc;Cm=OA(~dw{dj5y{^5A8-q?TjhhJ5 zQ9aoL8mnH^mv~nf2;{;P)VG?Zxzkg<^4;%Ka=&)#bYooz0I1_C3c;hwM+uPoiFnUE z(9e=` z?o1C82G-|c;6ocHHX$ZAWNld=F`*(Rt~MVIxf~!qSGjIpqU`4qehA&E1)wdEgCn)W zLW6C#6>ss}tLmf*ni%7Z*M+E?=(EYvHzf9XvaK|9yo*o4SDy1pcX?S{PUWyTc#agm)>Z^DcgXOMRHBXbg#49m9~+eEWmZaq@s>>`z- zP1JlmJYgix{dQed@J9>THJM~s_r0UonOEeb5& z6alOph`Yq9#@0(knhlRRE{Vr7w2CnLY$ny?I6LCOh80ic<99AWz}Gos0$M&UJkFqvPl4^0pxNiJOf7yAf==x z1lHI8W?C>n&|1X(&Wmck>1#wUrCy_{)>IB{Wd3=l$9rr13nE>@jtlMXxmUOB)%5)J zE@$>1cJIGX3qTTIZ?WK+BGW=qAij(d;6bAQX2w)<%~_hUSzDT`uIYNe_GR``A)Dw; zrmWlOw;9y8WAknhl%|HhXl+a`Q&Y?DUqbflx`^8*>C2x#Ob-uFW%Bt8*WgwPnoXFa zs=_JL=A_9Z8jG4h4Nv6v&$k6b*L1d&FOB$G!ZJkg?ziDV0oE)X=AAW&Tgy2SH^Pgz zmijwBxQd^|!OkGXPay27>t4rj3s-Utvly$e>S19Na;_9YSdja$ZHi19C`8q~)TXCI zz4b#}7TciWzyi$ivs-l8g*n5ZQYV*W-ZKObUvdp&-X-@_Q__#XHfO=V6=ikf$4ok| zQAS;8CH2u5!VSsyVNigTuLz|P8V;of>ydj=|18iP`9z?IFy|c?h-J& z=H_X#O-GS{%^s=tCg79kw=gX*X|d3rk_quHS=j3+cn+K0{;}b(%9$%tSo32b}x4cSXRdPupV>^AU$#j1F53a|Y>U>>onDMP%Xv}mn=e!e#X#nJ^A zF}R7^!gGs46ya!u-@V7~sDMLwv07CEq=Ze(9Gc7qvlwlXZbEc%sIPd<8_aUbD&vkv5 zP;r7d>~My*)&~a={p%jIn9uYk-gvh&H}$SSyz&kdMGnFVAd4--E4{PhOvdmf$E1aR zCiKmV5E4=fTB!AOSidvL1nN#TL`+&R+|k{VPy>g%?Mj z+qA68?t6~IuX+N+Q^-wrpI*{TpL-0(QutjOW)Q>6W1&KNNQy)VVEF-PF-@g=YLF*i z6X$PriHrD+LPE2ki+hV2LQ)H86Ji-E_EFUx8}JaE^Sx|I@QQiJSMA1p!J2TAdhbuc z0DqW{UftR{gnVmCvR#tfpnJIqC5O*M(ldy6=t++r{4i*A*O2YkndRk3xbP zuD*JTMTOgbD$zw^=pr5E151pK*+J#z{E#IsBAjyjrwceGvtVXH?VW{EX!&ja?`i7H#^yK1vP6tJH&wj&}W+km@wz3&s{; ztM0qYz|wtGadIygCh^!&OOKFb>QjD9R#U=sM5p$~yBzb22P1(QXbCuQ7^JS;`1`a7 zdV{67_swjAOU~R}blB{R^9alIiGwgT@ zpS))@ecnV|3&cH=9k$ z+(ofR_i9Nrr^!Uk%EiSPL{c@A1%yUNRGzx;ZD*~#$8X2&Wb6|lF3fg9XQ#@RN}>}T zqMD3B5v+c*j)kw4jukebZ`N&mjI{2x3>6)2Pc-acg6>B^jQ$NK_{t&r27@J+oiRM& z5P3kLGOcdARWx58BW(N3KLRp~aPQRjjoI7^OgouuJX9kuJvdUjK`MOY(Sh)3GYsXSN9F3Su+^fzn5^%&UTB`jY5X<|DBq zetaAqHG-|F8uPbk>ig9Nfi zj~tYgj0mF5cVG1nr+pB#IzP~wvIpyE_hE;co-?DZZLz%+H~>xj0G>1-F-wSzDWghn z(>N=uVliGcC*q=*sY-^e{r$jVX8_;gzMP^kuSh#E3DgZ8>V9Cl|bfhn;H$Z#yd})(p&IbNrBIVw$kgZ|;TADoK?a>M;95FuO z;+FkM4Y~+B69?d)=MB>+n>ziIDOZu~k-&F_fAN3M}MH33BcV z_amlfI#4ZE$19W@MJ^@#HtlNe91a+Zk&3>Sx%LX+qghZQL@IsXrdoB(a`{7p4Iwc+ znoV;$6xk8(yI-|H2M|ZL;sXIM-cq3Pd9O`s=0(2qPS>AsBk&2?zl*xrw3ko8rFY;# z8jBLxC7CICOrM+m2ua_SvuILXBBk49N4fP~r&|-+1$hOQ02l-Cf^!id5hDB)Z<$mT z;M}0j^}-9_huU5f_Q*=Z1p}0$_fy-kOtw0#fW=Y;*p=B(a?+Eg8SceQ5D%swOIby> zeQZHR8TNuB-t%dyKWAz68TKNa;_RVJiOi70K)vgQ8vD`(e_bQgDb>S7z(p>aXWKy^wMWd;^Jut z#hMNhIY~h2ggo;r-rlP0 zFR*|JI-GA`6eROnITKdof%(lCNQ(-iT9vXHADRXqqRs9~8t6V+^4PWuRg&TOmI(x} zpJ6nas9MILFo$wsfAx@ftAZonAM!~ZR$Q2P`Q@mtK&8fLd0L6>#LG94jK`U9E2ua6 zJsaO1#h!T;;i1UVPYsbzcUe87s4V}*j8p>;HNDVAyhpZ>LB?BCcJAH|p356dmtdV0 z5LEhw+~vFJio6xPqM5i{y4#n0sx@HZXYU%%TXumw!^%wMTxe0bs~FjI8I%=8r2uEHCooidD6xzLw^!`ajNQ!PJhHv37W?UP0x^`2aEDCM>Bm^6LJOtJj3C-gANQ{ z8*_j*uF>!-y$Gc47Vg@7yymZK)AGEH{$ySkDjrUjRo6v}iIX1=76a>$8`wq6Cynh1 zP$8V2Gf&fia}x8rWTP%A%FqBUluktC#%RB(i>}ePhdJKQ`Pz=!zo`{PF)$B@N^jjgBvf*PyeBDOdq2!{4Y?s&^%jjElTW2?HERCSW(J?R^(YJ2zpO;SM zWZPZnK+bw9aCz1rT_-uwhZedK+TCIZ70N5SwKCD|sYT3Z^C0&O$!N8D_(F}@~n%$ELxawNT=Y+a| z0+l0VkqHnbcW`Z@wHj@{lmiy^o=*w-<4QPn>PJGrX6d&Gmi$m{P< zQvO?4`S}9>kRt{ID*vPE|KUsc{4@ZV;paC$56h2b4}|X#rXn`gZ)$}|zm1J^UCuoa z#xfk*_N3e4Yg!aC!@fLVt$X>lHPs0%Fm;M8;k6$6um|7p^0mlOI$avdq_n&9mHns8 zwvUlXj)di(iHaT9e43Bj)Jl{m$*yEc@?wy+(cgU~xE!0azp@ZpN9|vA3G;e00gO2Z?UJ@Q|K0+atbD5b(O?^Du0CSBo1X<#pDY8F$Mf?){%siCpK^8~ z08oovgj1Kt<&sA%CQtzJRU7C)Qq%j0qxVsbiu{3(2*XGcC!-hROVPpH`WIJO7xjgr zF$5~AUWfaO=D>+K-uP0NhE(&LH;)YUyiQ9fRgK7mq0eA)#iI3?m3j<>kb#s|9$qVynb-%ACcV199IYC;*?KxE2*^gRPJzdL- z?SxfpII+vT+_Q>Olqn4TaT{h&nnXvzE-+5+83qKyg^-JgZVjPc=8#q2s^T5qb;a#F z5u$CmEIP%UX!CESGF}P08*?vSHXbw{xh-Crt4~%I9j4-+cO{(-;SQy^Y^68@fWMQ= zUg*gWv1UYFz%M%{=|cT(R=GNx!T}9+gwn19g-2Mh>Ay1jf-XkjnpNvFnnAkYH3vItZ@f65+dP8p(4 z+?!WDYpK{<_6*w~Az;g#&kz~|J3g(kgcnJcq{YVHi zexM}rWG-5`Y4&n1@fPOS*=GqR7;Ti{4^^0g5{_L@lRNPbdcjMLg%p`t(M+_ zuvSPBRB$eu)Ah))^V$gIM;yL*Viq{{Qs;1N|;r+n$xD$Z*%gZ|d zG>J6`%g`sF8m}PKCx5u$Q`X5^WG>p3pI=>ysn(&qcm?1%n<8}C;{0Jzm*0>pFN1yk z?YCZ-K>4L+PmuLI7Hc{|NNX%~099Jd)t~&4_Q^L}-*0iS2=+%?=L9t@QWvg;5jekR zfaELA;U11VlkcvWNZZz*EcCy`Tu#qP2#!=0`lbv{kmeBBgK@J$a5q)#so2g(jtb*h z=2`uBh3?f0XH>5DH@u5E9HRbhE88}>X1N2>7x(ba-pMF#|a{wuV9!roCQ z8;`X!LxJ_HIfPu|EoG}LDg9;L+AZ%E4nOy&r7Lc$wPB0zgs;=K`Ml4<(-PM>pCGk- z!tFQwOT|1Ot`EAO4e^|{{1NvGhBU2z!K)8|{sr$Efcke>tnNyw>3m}R;vHC#`7bQ( zlGdJ2R;I5_05zuJ3*Y8jy94lD_QHA2lD0sD5Apo&oNoh|`NepS7Wn*J>!oIpLQO}S zAcp~Y;c9+?F361Plhr@6N9((jV;%K}X56csg_=iI>A&4K;{3k~LVD3MfQ-jJ+M(w++WqUZPCB{e>xXI57ej8}# z9&epjxL4Vt zEDArq`#Y+ij0_$uY_Lyeq8lrhrTd8&f8jroTV41`?BKr({swk+UgR@r2>B}MB_A#f z(#lQ*(n{-br#}gvPzfQAb6fW%VkQX))Sr<;vBjhgTgzcIrV<#@j|T5D#dns4;QS21Pto*ODmvLJ<{G>Pk>A=AY{|Kkaq$PGZNqMl%0QEL z(LVC+8ffbO>N-bEcz52F;xcIma*DIwKgP%D6tE0o{z2NO2|V;92}J#yg-*ugC!W>^ zLJNQxR{+t5;ul6u zxQ&RfQePaAyD_6s37!CzQ-0(8@9w^-qRsVphyO)p=gxi9 z30CN#71dJ?-aYi(2Sjp z``R`6`9G?Unx59|i=Y_?G|yZ2|0M8l`T{usmcMDMxcCmqDU9)nmUW={CbZoF!L z#0oHAKP5tRoq#;oSS#horVGSSjkm1lT8tjM9eVVv=I^F>8A*;Vd^@a1Do!2|MeZZP zmewi~0iuosWEA>83gi(UR4t04OoFv5-@2XFaEsv?g(twRM5VXrVdF4pXs9PuKne4V zO6bSD0s2ZN1BxCX6Y3DGh4WkvKH2+hh&ms%9#Nlc_{o{PF1#Q2ycGJ=D}Q)VIOCHO zp8uFBf8MuJ7|%~JFLU)lyC3)80MuCWLg4`|lum%w4nWl;+pWaQAJh9&zskCw<2L}D ze?YwWWR3+Ou<>h>ue;L^t!$N^<_yUn-yEO5rr_xP@X?s*Q&YM^r}8sajUhal+s=jM zLr8FmFabz++rEptpii&ayv1X%01G>x@GW*j87ppAf)7d*y-%=sF-<>E*IFbq31NnH zrU(UbADU}PtauuZkRIl1Qyr2lf6`9_hv39Tk+LjR@to3*#cFN{_pB1H9@&u`DjhHt34k6m9vrstFT= zmjsALX}W{N>Ghf^CeC@KUXMskTVPI)ZpxnFj0jXydOWZ8UI&|8gG z5d1#yWz`7PfQ2fImFkN(7Jca6&7g zv&y@S72t-&^*t6ej{3@aW8U;n9PjWqym!=(5wp_n+p7B(bv=d8D`wXJ;u^E-nPS68 z2>=ErMvs?JdCq=?s$YFnU=fDxMsKB8eHtq$yM_x{_2A)il^TvidO{y74Bb@#feLMG zaXDcbi*%)ZzYAVT;I$^UKEmz=M_hucmHjBc!m&KL^yy(bDjT%5a(sUF?R zu^)(FYoi~;AQ4GvSkjf`EY`QY6M2@yOeJXVZ}7F(GjCJuB~ZR#MTe=}<=nkJ*_~rW zmCVkhH@Cm(VfEDV5_J_7y6AHwOss_s<|3iO`5o*|J`Wp~k#D2-o2o8pJzh4AyGf`@eR-X(BD6-BvgyQFW`9OMuy^T1dGI*mmtdW_;hK<4gr4EOd+t0P zzfxQ_CoyDYd_XdBafu6U?u0`{!~He?U|fZCdoPFbygyS8UwGH1R->6_#ee6GM^ht| z7%~EiS#(BMkwZ~Qg}U=T+T?^|@%@oYWqYnk@a$3(Pbe(C>D_)fTG1X@v{pa#o5r@B zBi|iWpUruA!PDY8FXx+ZN-VFh=%tj8vS5})W;Y)JI2_0w%g?|kivqCOA`}mf@bJIs z?_P45gIVc8KL!RF*+2!N>E^>=zrbC&4u(j05zr%kOGk?o8}5Eak#L13;tjm-P;EB- z(nT{5fPy1^$lM|JF_wgdw0TzT;xr(GJlF1BE+W0v!#(3Ucf9NF&h}YTyD{YcOw@Z; zF}vBAwd80fyQ=0W^z@wn^<|Ut&i4psds)86LVoEB&hi`rgMO}BiZ-#R3@4@~{e2Hh zj^}HLIh#jjrL%dP%7#vj1LhP*O6{v!8N0AXTfrtx;NV`}W~b7Yfxf5tM1!4$+O25| zBky9~PMRH#)Wfq5*^dg zQStBXv@ei)ev<7uSh&lW6|C@f(2_bTRqf_6u)m4zB}Zr&M*9tX@?LxxMes_8QegbC zAJ|Ahn{Vcf$bD=Q%l)&ci&99iM42SuW{{<@PazuxP84W zm=cVbVtTK4K9Ox~iPeR2H>${{+;2$3$KUz!^>ym9%A1#4$0M%ngpS6{)m42%ojX%E zM2|!DB@PFVhC@Baub84;-Mh5h`7lG#IJnN;oi??u)l6^2qQZrjFI18^Id$D!;<8RE zHLkQYK)dRL75YW=Du$~kMIFc(CGX#~FTwh&pgp5?)*jN}%QK{98S3UCLO60G5@g&J zV7PQh<%}vfb;I~B%VX>!zpSE7H0;97RiD~taC2aHd-IBnf(2iawe<6Jzl0qJ4V%Zt zO+eE^+ZKgmmIZfH1GMkf*nC>zs`JS_@4a75)xNH_rN`}~;~+x(`hhn0V^s*(ribwQ zb@5&hM~whjM^>6h%#wDN?x-F-;ePanN_l(O><4JPz-4L5vv)ShA8@e0he3o?!w|lb zPrICRj$WV(3&DEPcijVj52ccU&~p)w7hh2j^!RPHPcA&WM27iU8>|pJJmr=_dLv!8 zLjD+hcy#a0bJ{Rs6ZMs|Z>UELL=R%wOI#LMBEIgkvn_i<12_!6!&yl>w zS%;_l=GHbbkl7rTti5Aw7cDeWG$grB&Cvr|4<`DND5bJK-n(tD8?d#GkRc&fqoBu5 z%+jA5>%iolBeGnUT#2jF@o1G2h`*ZcUjN1v(GmJ!;s{xT)COf7+ca5`|%dMa#73vNU zEZf10(Q-+^_amG2@n~-Q`!&o7dlME0whfUh!GmRN8oEw3dJe9Lwaf1idP^N9YK)i7 zIgfOL+>}TAO1z+Aq81*PKlR!TK_97;(wHsL#QBKf7dcq73FU0v#eQK(CCwul*Lr=G;T4w1>vg!~fdEq`Tq+1hAVl^h0OhFc)fGPVe zemp(ed{G@NMnksIN(idUr?z;)1I7(pLOKTi9Mn;EZ7l8&cHW|U7PVsLd!YjR3eM8; zx39~5&i1Yys;b1Lo$kM_X}+7cFxT)uQ>Q$<5CrS7-~;Xql_~HnIw^8+pXN^0BQVHZ zB{9F=L%v<@(D<T*&OV9=MiQG zieiIzlgJIs!8F{qYvS|-lzY+hHxeR&7U06ZQF6PIkhQE?&Xm?)IIV7$(hdrV;^8&` zLQ1UGr#)bWL&(dTTCew|yC_f1bCizFjjxE}y!0ClXoX(bEKUVZjLSHutK3(+20Ng= zD!?BjUWrdU#l;)dc+Fgh$fWm?L+lEMubv*+4W(ylaZZVNjZ7Ig-E-6|l@_-7=v{t> z)d^R>kN05cYmQ0LI4C>C&u(k_h^r8J1h^;66Xzyu(+rOKV0jebZUZ&0YzCGp+t2M# zd>!K!CwWBx?KIfWkG@`XGLQ@}yuHZWpZCxo@C#{XwEBLSti{{K-?k6rJdc1my7sT8 zY~x?zwAs}|-E*ED*gL>?dv%{5Kbm1Z=JCpWxY+fQJuTfN?Va~B%G<;VTN2AJXu1NU z<|{6@3jBWc!8MyVI-Vh4hGFfyY=@e}IPv?F87anjo!BV6HDCDFSLzXdI~;I#4?BPg zvRi4LG%vc!di$nh9^E58t~wf8c9Lns&=9)C$gu?Sj4yj8a?L zaTw1Rv)emYxDTDBIB^KLVhozeonGdP%ulDEd)A87113oe&l#d1v91zL%|>!|{6*d& zZ84jBCPZxTaG@xCpO~2NIXdJf`EI;wo&%2LT}GvvYV#o+(Q5)*_Ha!jqY(%^*TrIe zBCijhJhlOGgYHuDkLDjXD>zdQ%5VF)!1C8Aox#8{!mlR~G=mB+-?~oCtsoF7*dV1{fjv|?qAy{F<9O|g4Flk-tOeMpAU7ES(E z-;a57*V%!H6UO!U-P>F|*>r4J^bU3{cLw)gdqo|;v*QMe%`tqbs#dp@;vZ%Clxzz@ zlqGE}`U2&=goRV}d*R)M$cSO*19%vX$R5|0wT@IBw!!npX0+A4^F+kNK=iqrFEa72%%J1sd&@%}d2o00wtFW^c!53uQ2{6hQn_FrxW!$ zqAYw3b6t3?pFN=;!d#$LqEG@1HF7Yo+-2QOVWK{Lw?^;WUC`4PQoBZ4LP5{86%y2t zRMYqGP2t{~mkDdhVdkxt3@O=G?0F5L|DA6Cn-N2Ie-2obbv8cGdCneL&0_#u-{{ml ziBye_#kK1c)t1#X9KywP;k1nfHBI3gZk%vp<>u!9J{D^S%|oX*>t=O$r5B6QfC>u# z>2Tk4(6s7eogBU1H9EHm$`ATaNAMPN{+c6aaaHV)5_^FkP+9pu9d=F=w(nH4)y0;ZOUl-ToyBYIJU$|&pEaf=eByZkoO=zk}Kd}LA-9QAC#6Y>2(T`+c^i(18 z-_H#0oTkeMfEoxu*ete&#f{)ehX=Z4T?$Jl-{HdS1Wm_|RN z-Zh$cv85q1nub=27iftzAw|8~ZN)W*du3ftAl038EHD4m{7J#rk&#dOKhYWYC%+?~ zxc-yz|Ghjm?o5slxN+xb$Pg!HQOs0LR>*G+j9J6xPX7N?eLLe?`cp{72)ktM`~2{3WXm zVFcUPk7u{m6Sc-BNF96KGO0Ad@-p=mFRHJDBsmVGwAo5LGe*oCOjxUA@s^hayxPwC zn;iM$X4A2(&m}&F;BwYVe~nw_EL9rOcX7xSg19J~NR_1GW)(fuxdlBjRU~rBkz2Ms zeq_EyX}L;C?Yz=@dj4DDZmvGXHQA(s{Iu@^+7JKRJ4|*%JbR!=_89_y*1~|cd5g^d ztN=aFUw4Ce`aRwsX${mR@<@HM_DK@-9>mW_%mqmxDX^oZW-HK>dVxQLK~+zZ6@ONM zwgCRp{FnNFFLLH@{&~@8+o^X zO8*m;KU@B-gltw@5DEen^bDWtCjh@RtIhwXRzJHFfRwWb0DhhR2YLaJo-CO4^U=S+ zAG#m{fq&k;+vU;H(`Fg~0Q2+oTMQX=kJliij;a8}zv}>?w@pAD7AwO*sJQ-A{?pIl zZ9p<0Hk|$;3IKq1@Bec3Uln0kH79;@;_s5kKiB{Uvd@$N;2$T@{=<@o*WcxTUO_#* zd-peeepvFO+fmcgCREDp9|rhe*ah05OZ%50|HhD?M))O#@U;J7Hc_BbbTszG!p;pj z)iicOmbYnv>?UeqV{#Aah2R-SjfV!n%S{LK4M-RY0rhtjZ=E)l z&PT;$ma?XK@1M-3a*G21u(d#BFHFwW%{ggU?O85V%~}3mJ9GgMW~U1aQ|fzl3r;So zE>^K=H;_+r+aE~_+g@wLNpu0*_Q%5FznP&bPzQqJ0x@O}t6i(k_m;#9vJqIRTXZ7JF3k&?$5KdKF!d&NOOQgkFaF}|?m>ilc$17!VEZJ<| z$7I;+xgkXBr&(cbf&y!!NpY1pnMgh{|0+Z>CcTAX;YjkW6KC}T@b|CTIkYthHcO`$ z)nQ_CV1hmj4fF>zAM+n<@!FeNOsC`;clxu@LgeNU zOl>3U`FQ5fuhlJ<%z5Tjm8S!f>I2iwY~KvHBfHUaO5s!qJ4(^(wE4?R%sDpiV~@3w z_3L1vQ5hU6E)Ee1^WyK8&_OG+ua!Ce}xwUrc0^ zq~iJzzYh5Vh!A*-?pfB+h+Oi_1n7ke^?_tX6BbZLCcX=O?b(`|RYIY<`gP$2(PNH| zd6WrhA3!P>7pkdON?1$1vz>$-15p#;F${T{K?xv_yqZUnAXY@gU}QIwB36+rAGski z-jjmRsv4V{*C;e&6DTAM9bs7-xlOHn(1|@unb-uqxzn7ryJ&S|&AvO8@AA{k-~#_< z?w=d?U36Ox@ zkw>A5@6kZCrFnT59}ukb?$42m9Lv~a2t^Ts!y&FS`$*6(t3;6&E3v4_E3-PaLJS$Q zIGqXQdr_US11}F5bbTb0Z(6h6av+X2PZ@kw8wb~^LziY+$2IreJny}nnG{_7$A8J~uAVxd-#DfHF^jvB1_RWD5ZYl05l&pfXDM`BhkO z_2Jn2MlglLkrh{(D&d(gB)?J^eqIHp$YZN*-p$USzJLN!B%2zjwJgHe+1k1^31UdF`m;Tf)$>hLPfXEmg+1~QSVJ? zpx?LIEXo{-S};9CIt0B5G}`)J@XBlduu`f~xw*EV4_lJRZuzF!?!0-fms_%6ozMve z6`dq9QW*l{Su|7XkdPm67{q8^;BmFe9Y{lugs_En zxO~?UTX@gpxm01gaLCrnDt+I1@$Pvm+(7#w%c@yL=JPe@NI6v?o! z#WYOks&{$yMt2*WP;7Ulj_!sg^8#tTv8gTWL%%MZQ;f1R$qt&3y(xf0_jy&hMQN7M zJ=j`A{!B-kDK{y$aqhia*Qrp-_zo*}=dGKrzuuq&f5EI75Yo!RVW7lzlom?)`*OfX z^5Ckf3fFk-S8IWO*>Vd zcS&bUGqztUDMXx7QW9#7$kFF)+O|Mkj^O)R2L$s$38ECyT4Jtq8_e_m?k`Qh6COK_ zyJxdKhk>$9b60gFS;7R4wyj9$kVM5{dB9%Xv<9Y+q~Bo@+>^+Yr;Wz*_he z^?SD`HNo5GEdXESKEz&(s_2weWF|OFMf#C_EZ7o)#*Fi6GapmjpaK0!MkL%GmUOkZ*#AL+dKj`gOug7U3iG$qqgY9+n!Rb52 z<=eF?TG&rie#)la*lQMm>bIX7x9iLc>*#^8zZA9Mj=albC0VOl^7>wW-$82~_R0YJR^>jgA-=|=hwF5qdt>k1K?S$vB(-ka!BurM^ zG_$3!2w0Boz$<=X>)cZ#G*yN2BX&v3hT+7B-}is>+q?a~&3y1F|CbC)SS2rU`Ob4N zGRGSq{B!xUNfQCoNkiLbUa%xd#6e9&mXB6z@#4VuZM_6hCV8{4Io(LBcmv)*jI@>N z0LX}E*Pap)Z*ahQR*_o z{>cN7osWM~;Qv2Ko&qWea>*2|%hK7$DW$Sme{zPXm0Ftb%WgM^>uN_IvE^*BJ5=+v zhg|guKICc5eS52=wm(yB(YO%zW^Erz7oLzxzwE6K(W5Dy;>NRte9iG)!*IBXl)%i+ zwnV!1rYP*V-u>^!MdpGZzU4!G_mS}B_M&ErlW*ly3K~Y~_EXBj$nyK*wfQ4R|4^q& z0WmO65(n`&fG^+-rT^y@kX%}A7S}iAu1eg3v$;V`1bmo`X+iFS_N=g3rEY>;93UUd zk%kM=mDUH>$3gFeeERI+y=l--%%+bU6_Zg29_Y7jir=m4m}eAgI;MeP7AN_#Xs*B) z_=%=fAe)FGn!jq*!I!G5l{2{hyy!O0vo0b6Jfj3XI0_za_5#oA;f}D;;~5$_X2QFA z^yhASpvdfsn6&u>eC9>6tq3LH5n$(&|B}!mb_niB?-xUGr~a7DUX)TqfpD4qG3Wir zHrkJWgM_>C11V4jNdoZGK^G)nABhM@Z}bMBEYP74W#NV*L7GfIm6G|MEqH-Royl#9t)-T7>94 z`BQpw@=vWStNyH?v#k8<1?Y!d5at(r6HZQAE;I!r9`EPwN-boE_zQs;hH9c@CII;s zua7{HlXuiBxXKb#s9=#Qr$T_N8gQ+AO{lpT{$W~lf!OLrzHBcqBE@1f&C6+R>rxjr9E4hS}S+N@Izybmjfzxg6x0Or=40TErt?U;CLq4`{8sItRX}VUp_N);SG(@O= zB(OrLexxaftKUU6ku5eb?UH`~tziNqf!_tv(RDuBcX4<$0;1bEr_Iz3z-YnDy*iwtbS5a7o# z=*qq4S1%pt{W?A~+Vn>Lx_aJU%?P&caUzW@InwFux+73`@zt&x^2n&l$ZA$I0Y$w4 zxIxqb(iU%W%G)lxQH=cP9er6%N4(Su1CE)6%AS3>f3?#6 z*oBtkcj)7?Q|E9?rAS9>tiJw8EEMzK#-u1{iJ62jvO8gFOJ%M!=WoA5&NU~0KG1+b zefCvfXd?lja?R1VY1~4uzk>egpS7}K2!#TvD082vp}gFxR*iCMrlGIgFn2NC``isv zPqm^F@LX`xY^QwZgIfHmq_01&Tw$@v8O5YQ7&w{+4zBqLYX-4VqWVGa!HSB_U(P;+q@*lGGK+xC0n}qOOD?byBthC7|#RWgCq~LQdyfjo?gKHu25E(+W9_i*)R}N0HxqCA7)sRe+#xy| zE|It$hO}F+DeZp(SVc0jL_peR-cvu>Dzn_Wh!xCh5j|8aV|%B1PzH;ZIsUdSstj z*{$&C*Qi-du@xjfU4s2ZTcS*n3 ziJd*C(~)c-s2I<94;zc=?GK$XJz`^{6dn>944nRU^I zaOHL^K^>LjXBhT6FCL!Z@H^tGV!=dgi%@E>LPV6ayBP~KPQ#UQS^)0LO*~(<`ASwt(=*S|K_{uuyDPYmo%Vcu z?#b_Plf8T5ofPwxJG1mxcyvSI3JHBcT+W?xH@Z}JFJW9EF|is(!X zDDHO$1lQqkp5JR{u*{4s7__I7^g}DEiCv7K#q~Di z!I9GZr1|mIZaSWPs``GPm`-8)!;NIjVlYv)6ePln9h21mwON$UhLQaylaFeP$p(F! z8leUy3G{nrp^eTJZKr{n;K<_iTzVK@7y(_9(=a#a9U(u>ooXa}*LrTOMAUSe27|7p zraZZwla%H;*T4OANox`SD0C-=cw1L#k`=o&cn4~h(o3xCj-`V+lwq}VIN8tY#o0{x zBthU?DhUf(2==EDUC@F5JYchZ5uw%Zd|nN< z%#{uVCp5f9wzqufc`z&iZOy+LJ5r+YmnIYb7r6w9-)u4vJ;~UAvrpRdDMflFGGmQ# zjA_jCuy=SofaUaD0FlEbTj%3iwh#oSc3i$_!Fqu+b&*)M-|_$C@~zrTpuM&>Go|w8 zfxgg>EMulR%m=eEt>8V@^7O)&p>$=x)!+I>3R%oAm=)uvtELdHZPmzkUX@b-|(gueRBY{TV`ZNip)Hp8rvdzbk|^Y})Wk%Of>T(W=Yn@1pB- z{Wa=ZK2-x}kDl8@+10QyQz6mk7}Kp*t$Qjb z>Ow%BP*113LtfMU(Ja$H!go=20-54^ktP z!o?Z$x&;yMkrZ3gu$1rL!;J_BVy(MN;fJZ~9AppP!zxSK|JR+bawU0Q!{V~vo!GuU zwReUv=+jZ>rvB4(sHo>^?DqjIPpq{u+4sk4vL?OSihHc{eKvXWSM-VQy!CfbUw$9@ z=J|u(o#Sw5;1r9V=u?OCL)Fk+Cg-MhLTN~}dF~yCRUnyo!+_mH zTShZ)vfgKi`jP_xN%LW7iuYl7e&{4`D<4qd17&Y~Cc&S1r~hJly#8>z=O>x-R`%rFZ>#-L-uE zOY|3?_aJq-f2-GF#eRDER->=_0I%BA3Bg>99XAT#ss=0l?3<}`aNvAhCPrQ2`TFEa zS3Fm7dANDC1h48dNRMm;dNtM=$J}^f+dATB_@Pvcip#cbu#+EKZnjw^vLLWnwNG}{ zL%z+%2}~`gdua#+6~nE)z4`{!b1BKG7Pn6||K8%hM?3|>8)KQu_x2H)+w)GQagt+t z5H`3kG-GyC=ANo6_iBaJ%+nxvG5C!%OhbFC-L?L$mzmfWZXmVl9?YXKpCGhubxgwX zkJ62swycYf>`Mjpd8lL@f&|jkn>kJZ0?nF=&y&GX`O3MuxhSV+SFz`H{X8|}3HS*$v;oT%*FjQM?6^Id*r~qA( zB`_BLx(-qP;#I4^AU2?e*zB*PwrD#~I$< zt#150fgl+=eacJv$+L@k@(=y+Cll@s*_#7BT-~$LIVfeQ9K{xx9MUFA5_El*GHNs^5Epd=219J3(Sh5Z~G3 zTro^dK>tI}`-g}GE$D&t>r-J`i~^T8fWhBEf^ zS5ojM4?j8n#}kd3;t2fo{KmH;%1D&s{fYZjc<-n*aN7D+0(qA8?g|`&L-cb3}0bNz8FU}gJ2?T3f#w20vMZd*{`}u>uVzA&O_KlEk+FJ!WUy$f45~%%EA8d_ z;4D>-wg(3XJUOWS);3o>2ZRhP!Sy{rt<;qr}>l*#n%P)@SVaArR_`WD&^ll;R8e?nfwCZ&+ zIDcLf$OO1)W5iX=90w?uy*>W<&6nO$+y$k+5z?Ke8*O^z!hhRl%JVnMy?*sFYd-(3 zu8dAVRo%0{mSgGo$Gn7mI(tHN!nVcB0g1=Od+QEwp}B&SJmsEL9f4sbK-CAIre#Do zul3G&`Pg2sI(Pr*oQSk(w~x@P?Qhv@1t{{vZyWxfH*9*l%8W~HVuoOQB{z7_OO-oI z@4F_B20A|Z?*E=+mv(3Odw!)Z=lsn4szKYsXs#-3h@#`(uFP5Y?tQ8|fW+}vBm9`f z_u(kqEEjxT_536KNG+9&*bS;#32|3A(rFn<1n)9#n?S88-`u=~EUd0M&RB zAbab{5N~U9VKE&6p_DmIctGGuzLEXNK(Q|kYhd-|zoze1`Z=|MhR&~`u0GD`!kxc;^19xblHOXd;)^->qG!(6U^AM= zz4nb&l6_LG8i8ovyYg2k%eTKQe3~WE#=r4mcReY4e$O=STCIo=GX$oeIvGPEWth&f z@ww^_;R8uKXxF9bmh^Prwv2wIFFT{}tE|y4v0GZK&nHHv;;U4QoT`$wLy|j+ z5=*N3hN@haH^%`Z*EYJ7!;CWX!P@h=C4M4vZ)U817AD&PyqA5LHizESoX-R1ls%OZFUW90vJ!nnF7b~gcH z&WsCBa^OunDLozRCPL&jobJz-HN)UG&0$M2{k^_1(TQxZ-GQZ+(ecT}6O-|=g_Qjp z&JOw^#`j}GUO*SjWF7Y3Awo;hH?gH+VpzW31ouAs-e4Q#!7~yW%EG0cWk5CQ@>n*-4Z~jx!_MMB1&%OpwZ}G*wJx0O zc}an_sZcq(zE4md0Xj!6JZ|7&IQTz@m6xMMiJ}WFFLdy~fbrWyhqBO;?u3xhX@~+s zgV|m2HabgceQ#dt{elmhf5dJHY{bgcicL8?8=uyUm6`9>KPO~Dm;N1ad3~(?1U!NO z)7$+uqEHXcQ=m@3m4K6)nqeimw~=nP3@pAF9W9>N7BAgf>uH^VFvO$+paKa%If*y^ z4JWVIJ^or7cYxgQKYngEW0<`w+&Le{Pql#hxL$4E`e ztV}ZVDYl-gLYOxZlhQ`|hJNL*f^8XlZjZ6KWhG6Cq?a)xE)}Rkv6LIj8hN5yJ;~Ly z{aANBGWA6Sx5dYYzTrpxqT?F)diGgNl;- zaF`r8l3|*~qrOePwdLq#K+8gMFV31Mx5O@ZPZX1$ziTyB$`1$z3g6Rj4wF62LyUL< zQ9R$SPBFHAU6dxU0qYGP5t>nTu05w98s+{Q4@oc+8_!o8MQ&ous?UVp8vY5_=v~u& zaOc3F_l0(=VFOr}Vb28ed(nZ>sf+GARpCPnRu|W;{&l~e1J2o#?%Z6wxTvPyQW`1} zg6Aefv{C=QCFP!YOQIU>dEJFyvu9_ zLr8|Ud+;J0`R{`>|!;+_-eZTP;Qcd3a;>cNf_9xvfNDC{hneUes!6doP2G=0E0N9tu&=0Zk3_HifJndu#a?$(IkF=Y+dSV_;&BkxycJITUD`| zvIiH8^!3v4Atcfw`7GV9{jznHi~F+eSZ9&W{p+=GLWnjCYmc$~UGD>@V0jL(O$k*5 zVcNyF$`v8}msHtz-vFKa9wDGqw>9-yZ+en^e+2_nio9Y6mzJZN5zY2&1F1Zkgl{uOtK4W{>QD3*JP48lAca#~%(7Wv z2D-UkuvtHU=@fK4@+po&GC&}bU8j0CCU>!XX3Y8qC9RENH6kuXLS=L40Qk`JA2 zmpS}>Hq4Sc-N6H>3k68*{UYG;Jjty)?i?t+bd)7@6KYGATY*mJ7EkaR-${(`<~2fDiMmCnJQ{b@YrA!LH9LOMFx)RGFFkVF5_)5e)X|xDAQOi?e)dp(!$@ zCP#MX^yo$Z4u(_vnc%mi8ggStaNn`zy!D5X-Ni>TdA_%_w=qI#oSN|FAdafCQ~)hk z7KvSEk?zLz5Lw=CQQ|2?kmFE^H4z9+{{GJOqFZEX4mfrxnw3vIb>T!{(iN zajK%5`{h-W0~$+$edH5E{pY4mp}Ljr$qH*(?Hton>Y{jwq)HK?r@-+mG|vHE&V|)5 z2cf?|HGjy_Gvs^O4qD*2T4_Q+lAP>cC(h%tI$us%XeO3tXTQ0O!%Dj=zL`CE?sN2L zW^+_a4lD>iI~#^y7pRRt=lV_QwQ{wZw-(Da?^!N^RXMQ=@qP)o%R zG2!;^$%T7C+7{x4JP(i+9)DZfd*14w~1PQjqM z>o|B$lQTUsa=21kT!6B+8I%l1?%NvvFko%h{vx?+Rqs$v#f(zcZp6-JrPn&_(#7DS z_fi`^`NgUI5CxhKO}q@+w}N6~VnZ$!m)l+gLW_K33(KpyPM2?8S^0U|S@I(2o*yq_p4MzZ-l=+x6VqJ(pb{ z6`p>Mk!2_YL(52}A6#o=GYAy;f1s4FVi~l9s})$PWp~|-e^C`$dDC9JEd&4v^tN7q z@)mu*00lmDadYZ6ev5GLEg3?*)faJJlfAWO#9W3)- z=gtRIWPy6=Sz(xNi9{o*>Gm3EP`xUf z;EL?#56M}J+*_fvZ(kFscNCyV&0=niN7H-d^Eljan=17rNfoL(4#4Hz*srbpw{@X! z%b({_ms3+)f6?^Cj}8{BV-Wokb3+X#-cTtgv^IeILzx=iUdP-zwkyR>6^gp={gdUf z^<1u%kJb`3F=DEtS41_lE@JZbv4S{Mr6%Z|lPKBPWA!zsFp**X5rB&&mQ76E+2%Gk zxf+#Wg9YA>_AxhXD{sPtuur5Fw3EzjhCwdMa#p`uczAuH$WbHP4uku<)nZx$7SZ`| z@Z25Z1wLXseRw+$>5S(cC<+O`AR`zV3*-ovro?GU?h*gAFD z2Pm5hlDU!n){}pr2tbqdFiC~AoR?EOK1&;f>cVRjw<26<`O&+#U&96uDz}Y;^lhb$ zW2zO45dUO_?3>=ztW;OYK%xkraN|SJe0=-dU9Zi!P0Vg_^^!j=YFqSZk`IXW;1zfB zb=(`SrvykKjsk^@Re_NWrV4KoPAn%~;3WPuY~1EQQ(O}=mS_@Fshjfv?}juYKBVUQg^n{ybrcUv8I3$ZDWJNi{vQP zeQdiXc0Ckg&HU70v8O`@tIRO^lB|T9Q__#t@%+L_lUz1agJ|jBi+8NnXOwe%J2UN4c=h*0_5xxB`buOE@u(Y0+$> z*lj=2mdmwh;8a7aA(dU$iKAaf7_CT0H?6r9sA&eAOB&Q>Za7chkWmvS0g-CZuI;f; nP0=ZzsT*K}svLstNz8^~#cygDw2UJa|BJaIoG3_V`hs=<#R&$x diff --git a/R/utils.R b/R/utils.R index 89f577fb..8347f7aa 100644 --- a/R/utils.R +++ b/R/utils.R @@ -58,7 +58,6 @@ add_pmfs <- function(pmfs) { #' @param n_weeks number of weeks those days correspond to #' #' @return a n_day x n_week matrix for multiplying by weekly estimated - #' value to broadcast it to daily #' @export #' diff --git a/data-raw/test_data.R b/data-raw/test_data.R index eb82c728..52e1866b 100644 --- a/data-raw/test_data.R +++ b/data-raw/test_data.R @@ -38,68 +38,52 @@ inf_to_hosp <- wwinference::default_covid_inf_to_hosp # Assign infection feedback equal to the generation interval infection_feedback_pmf <- generation_interval -model <- wwinference::compile_model() model_spec <- wwinference::get_model_spec( generation_interval = generation_interval, inf_to_count_delay = inf_to_hosp, - infection_feedback_pmf = infection_feedback_pmf + infection_feedback_pmf = infection_feedback_pmf, + params = params ) -fit <- wwinference::wwinference( - ww_data_to_fit, - hosp_data_preprocessed, - model_spec = model_spec, - forecast_date = forecast_date, - calibration_time = calibration_time, - forecast_horizon = forecast_horizon, - mcmc_options = wwinference::get_mcmc_options( - n_chains = 1, - iter_sampling = 25, - iter_warmup = 25 - ), - generate_initial_values = FALSE, - compiled_model = model +mcmc_options <- wwinference::get_mcmc_options( + seed = 55, + iter_warmup = 25, + iter_sampling = 25, + n_chains = 1 ) -input_count_data_toy <- wwinference::get_input_count_data_for_stan( - hosp_data_preprocessed, - calibration_time -) -last_count_data_date <- max(input_count_data_toy$date, na.rm = TRUE) -first_count_data_date <- min(input_count_data_toy$date, na.rm = TRUE) -input_ww_data_toy <- wwinference::get_input_ww_data_for_stan( - ww_data_to_fit, - first_count_data_date, - last_count_data_date, - calibration_time -) +generate_initial_values <- TRUE -# Create the toy stan data object for testing -toy_stan_data <- wwinference::get_stan_data( - input_count_data = input_count_data_toy, - input_ww_data = input_ww_data_toy, +model_test_data <- list( + ww_data = ww_data_to_fit, + count_data = hosp_data_preprocessed, forecast_date = forecast_date, calibration_time = calibration_time, forecast_horizon = forecast_horizon, - generation_interval = model_spec$generation_interval, - inf_to_count_delay = model_spec$inf_to_count_delay, - infection_feedback_pmf = model_spec$infection_feedback_pmf, - params = model_spec$params, - compute_likelihood = 1, - include_ww = 1 + model_spec = model_spec, + fit_opts = mcmc_options, + generate_initial_values = generate_initial_values ) +withr::with_seed(5, { + fit <- do.call( + wwinference::wwinference, + model_test_data + ) +}) + # Generate the last draw of a very short run for testing -toy_stan_fit_last_draw <- posterior::subset_draws(fit$raw_fit_obj$draws(), +test_fit_last_draw <- posterior::subset_draws( + fit$fit$result$draws(), draw = 25 ) # Save the data as internal data. Every time the model changes, will need # to regenerate this testing data. usethis::use_data( - toy_stan_data, - toy_stan_fit_last_draw, + model_test_data, + test_fit_last_draw, internal = TRUE, overwrite = TRUE ) diff --git a/data/default_covid_inf_to_hosp.rda b/data/default_covid_inf_to_hosp.rda index 235c1fb35c7b7a957fcab0518dcf96646a55e188..970ccee578fbfdfee9e24ecd2e204110de7f5073 100644 GIT binary patch literal 640 zcmV-`0)PENT4*^jL0KkKS@*tIxBvia|NsB@+yDRfxw)^degFUW-{)`tes`C5`+p<< z{qNp}yZNvIT4vNiqfD6%G#UT^00w{&}asOA%xHxXlMf?A)qvArbB8B zCWsmu8VrDGpc)MWO)>z}AR2mr&;g@O0ig8&G6A4uG#EyPfN7x6WDI}+WEu*mp)!L^ zO&S0OfB*mkK+p{U0000000000000^ukTd{2KmgZNF@ej1T{zgFECjFwfPpY2mYjta z5J3QRci~0}Wn!syNiJ%bO@EsTgyRqU4{+1MWNB42pEcGRha@T?d-Q)tffEvevh2MQ zK0CfZ2Ad$SsjU6V9CNTntU%{Hf&E~QF=h8^fknPwXQmE(;7C8YJ`$>m5>)Oe$qU4@ zW{wgaHgAI*z5i{dbn_Omd49SjCCDJC8<=r8E6uGQyKh%>rXa<6*=t44S zlRz2)paGx&Xahq)00000000000B8UW4@k&p&;vjL%F&dG5d_g?K|nwXAPF#lphz#e ziYf5~0>LjqMhOTbRT~J1r7==2-^uA{Z4`r?VzDR+SkCLlXMn~7b@bMvVhU0Ps=6)- zt^`8t`$Qljbe$U9cb302pvz1>mYi$V$-o34(F+6gvwYHX1%1$p8cx|O zG3NU63P++f32)#k0Wszd&wxpB9+0$UVhy&n_B*ce21o$0li@#+FOp!e(OHU|yr#+J{!6Hm34)7!O%Ttd=AQ zOQzG|G4LL@|wT##Z36T!7$VGH9A zt!@F(fjusv)Suu12^7K#0_!rmC?Da{#FYy(o~Svg@V^5j2|sC{TXHA+nguEl6bdx@ zUPA%OIr%qY12U=`sl@LKNI(NKy$RV6<(ry9Ao=ICHjAzXqlF5y)TiwML1B9&)E9*dP@`) diff --git a/data/hosp_data.rda b/data/hosp_data.rda index a967a8fb195c34b51fafee0638f4a9b2c13a559c..872e4eca0666e58de08d19243a58c7beb8b447df 100644 GIT binary patch literal 509 zcmZ>Y%CIzaj8qGbEK*N4V_;GHfBnC4hD-SW|KI;M2n763zq7!Bfsw(1fddE`7!NRh zcu=~-Wmy9QL;h6f^(5fB_0z zmMnG<=Im@r5M0Lck?|D+1JCUHk#Je4B4bTKFE>rKdELLNX6?H5TiQChdWONfN5?1Y z8lCmCEIM^M(<^T2hrRhlx@)UvT-%h>lOh-+FFaFF#mI6)L}S^bzIV-&E*|E6G5gq# z3dtmiRehbeo$s8>(=1q|>E*J&Qy|FtLZJDZdvl~W?CpM8B%Za0)#>)Fh<|Ym>r@J? zR#g2B5R{Y9nkTZ6lPBKBnvX}$RY_wKgP=lJkU~%^L$$fagW{qqq5)zLSeO{a7&%zf z%&&^9;1K%P=+da*A=t>o(x~7jX#9HJZqv8d^Y%%--a0-1|H1V7uB&_Xel$r7PMo0V zYc>%CSU3a}9DwQ}6qk$0`MAGXWgJWHY`t6aZvN}p&%}ZLP z*{+K}I9_^Ty!>fy@O_!7OYgrqnZD}E+t}kO1-jBNeq0Th`G@1O%7p*` literal 526 zcmZ>Y%CIzaj8qGbd>eFm7Xyph|Lgyab6CRv|NmFdA`tLD{mudh21W)41`Z%(U_8Ji zcyQhB2^T}oDs!;)%ryVCiXoBB|Ek3QP@nm)7BDbK^w23uPS2lEvM z#%28)?fOjM+Ga2aHX1H#U|`@CPQL(?gVK!FLdn8sJl)IVe0yi# zj;@})`}QC49~C=3Bu>kocqdd^XKmoa&Bhlk&tE^txjoB^Pq?`o7u07s+xXl627AtE8DAjBYJ!FP_i;o%K0i=@CNB@wTvA3q;D9q-z3D=qH@ z=So%;PEHk-Nk#^ZT3Y9`-CP6|92%KeIG~iIq@>oW4o%1EEi3jc(lpD9-Sk%K`!>6l zh?Vh{FBe)qjoh%={PvnCV`t~!;PnTu^GJ!m<==R2{aUB(K98N%dMn>AcSt|;C};lW z*iLIYXVt@m~5oqo*H0LLijW#&h_GL7MO;Pr-kBPr3>gD&AVU GyaWIOSKA-} diff --git a/data/hosp_data_eval.rda b/data/hosp_data_eval.rda index 4380d9110f7ea36bf1884750b5a71704e8602bb4..a663068f861fad7099622c4f541b9038ecd26edf 100644 GIT binary patch literal 593 zcmZ>Y%CIzaj8qGbG!$X8XJB1lfBe6(Pe}Ox|Ns9s2sr#tzq{Z8g98Hx5Hc_xU@Dr! zD|1N1a{&WeZ&%LWAooQEhc#xU*oV}=TEW0zRQ)%U)7HeqmqF6jfdLE@RxV#0ka6LH zNd|~3#lR~!!D-3l;7d{rj0+dAIb2-qz__e|t#^L^0=?FT@v!T4>Oi*QiM z_k!B>Z?qbpO<}lutYXd6{g+CdUj&JYP4H9_;>B0T4d!gHXytvN#^lB% z#FU`0-F`;Qf(cC~2?i5fM1)x;1O)i7va&eZY>)L`QTp8QY+3Z|H;bwY9gjm#W%}w#Cl@p{Dp+-e>>Lnrr0b@wwQALWAif=$>i+-eor!)T KDm<=?{RaRSr2DV{ literal 615 zcmZ>Y%CIzaj8qGbTyk&W7Y5e#|BwGS_6Z694+Ja%4*%2dE_lG;z`y~742%buCe4u& zYcg56h{1%}ZI;>cf2(Gim|T3hDDy?b-&ZRbm@f&MuL}7e!0WhjL6SiOvjYPI1FsaH zk;%!<1t%wSE^|1M!OOVJmxo~%Ge^j>uFM4t%nrP~KqZU|G8n3Q}Gq>9XBgZg=Js+$dP_x}2GTzbjN;?p*Q7hdm$umON(vEvdA4%kQ(&mRxojjOCwK z@9f|Dw}qwL)=FuM*k|jNd~ZD+oID*1`BV+O=DnLH>mO%%c{XE*u!n$wzyU`_0pXhZ z88L@hS_HBZ3^sTI`7E+CZ_b^07YGkGTsm|{_mD??%Y|vz_Pb1&C7kg5XfxZrd)pVE z-+JN1b>`bdw$pTJlB0cU+(LEbR50T;YkkiRt}cfmRbN3b^q7D zuyuIOSvc`CZr1q#}moJ@;OLv#w;s+vWUW9>Y6I) zit3A`#&S5ru()5W9MeJ%rn2xCQ4o<}HR7Eb7vZ@^?*hEo%&dnzSCKj7tJ=h287>-( zDbgO6KSC)Y@j<@8nE54Z`Z7L##}kp)zR)Mw69HsL(7KT~lRmMiHrA z=)Wzwf+i0hMvB6i-bg^TG=ohf!$EWatbLdO910{r1VAg)!$1!4a1jA06*zHd#CzfP zhyMQn{oyhD`~XB2Lyq>$VeEBvYhuZLPfV<1kk$luryvCOp-Z_mjR>_)*3!=WYEn-y?N;|06I$ zT3Y(>7tkm@Gc{kQ{s#4pyu1P58A+F9`kj!_Nx$GO*Zf(j;H`meVI_-Oxv?(&>v!Ns z6GDxTf<^fxk28Z35FdnKYt8N|dWSjS{BBZGgO9@0v?1;6;n18=M6US4 zc%NATfsNOqytmu21y+mKwuNyjr~#FJmAP_HGtfvL9h-O>-ZuRr&Mv(6y<2Yy6_-0M3SI5o~W1qj689ZGcl@WL}Ol0~-l)ELp*l=U0+o^cJ_4M#) zs>q9%(SdQR3H*yeSRY%zu)>M2*5&yfWep50^i8WmsXxJ917>4;8BY-%z1OTEC(*NF z$-*9}S|$cT%;u*v_v37HRg16f?X%016Yse(4}4w`K6y$sr_4={`vv>=(cL8H z*h5}JyeewhN>nV~X{*$RP$x?zH=zGO2jn?=%=e*gpt&pJdSX68zY6`x7aS^;bDA3Z z_Y$m7y|>NJE}{$46+Ln71P5Ne^*K;$Lk+D_1BPBHC`l$T}QUWaDaA4uM_tVvzEXrY}|UZvC_Pm*~sXDD|M z!T8-q8{TOraoTgzPc_$+IqY5cufqR)O=OLDfm9KAM`WqSy%t1P!M%cG&i7OZYmqdc;nYhW% zc2H{70y6pzutUq`AEql~k`RVU@4(Ng1I}))1gUTVCgLn)tL9?rD=-=?j#4g)1g1Yn zkD+LwOd~tY!DBTc<1{ATvzVd`mATkraG}t5UhU*}PrObrYhfCOHMU!9R>*(M(>d#@ z6!{p{pB=q1)-@+-ge$vUv(R}*6!+fDPHo4m>!1oy#5F<|>0rwC(`D8Ck{9mCFK(9C zct^kt$)O*aLnCDCa^fe~5h%!;dwJHj`oiiraAR6YXoe#-waO78oPIj#Mu*i@-Wc@v zpH$;|YB0Y2`=#wF*<7U;M+cv*ql3&{L}xgDoT}l+53GQ!4R<*e(wIq78_&F>ll_1N z{mI+uy(Cs3#H=lddj8BG<2Qrqhd78R{{e z@a1u691`Sx3GnZUrLM?`mx~?F+ZP=1Z zyJVzzi=~q4*D)WpHjFt_cL0x330$@*!n)0dW!g!*4@wc`=3SN>{2sh$ zNmaFlXo(Szc~{GOXs%-19u*{gMFQ)lnC_>bvOfjqV?JQ1j|yFMOF>{emv-(RZ(w1o zR7^OCDnLe?*XGSQ|14l^R@a93ibO!^Sji=p_T@~RbI)aK2u3V9<>BBb*=W6q6~n)- z$KKT=xd#A7v)R4M`c(88W0?B8m5rE#`ixvX zJ}POqF8N;Z9Iac#s6>GVfqm2|jc;jse0UzCH?sNJ(DCDcqkW791i@SdjH{=#wA)YP z5SP|Qp$=1Ute56#Zu)8+Df}H;4e!_Sp2enp*SwWlJ+WF7R?uORp%06@QaQflZw%EI`zl`Q3DlSk?c z1zsZr&Lc<{+Us<_)ic^4V6?hd_aF~z-?dEoZ9ktBI$I>IVVl1q*!n1UZK1J# nVWLY|aO=aj9xPwTD|4BOQz!SKVC=>DPlhG@2!6eSDD}#crn1(H^7fv4&OPUzd(Zux=bz{MJ)iSDw!S!XL$uGq6F$nytBU~S z`rd!>Wp8J%>+f{uUlmtyck!4~htE*>4V_BXxvrN|)%o02WELZ<7>8$uY$8ES-bZK( z6=p=FB5@mudFpOR5p*Ff1+7_xT^!ee0$GJty3 zd<+C*Sq9SQ*m9CS!QjiFg?(3HfF0w^UW z0sxE-ys6ei0z4K9frBQY1k}}0yc{NA2ml~98Q_)C5g`B<{`Uf+b9-?B4uNL^@-7-O z@=jJNcxJCrqyx>(u}Z=NA>qtiJ8$JcwXz#mqK~0JDwVN|!$wuCP;0m8I4jhc17s74 z|M<(sA#g<63Dl-(I!k>V%2+R60RA^#HBkjFHA{k@^tlEe1bP#9RZ1_oe9FOrlTD=2 zTWb=2JsGazo#sFW^qU(@5=Bpax5FS^p_;4!po42~D&1t6Tw!a7F6<{%mz90u{oAI| z&jtlU4gTY*zhttiH~3nV!#pbI-@j zY*o2qT;kKw8q*k%;FTRnZh%)hnqwaKk93pD_!x$8b)7x?&;^)R#H{+G3xV|%;qW@! z2{D~;ylSziKLi~--EEywC~eY$&d#H>b_mzTWj%XkUl$6~o6*bQXD*8D&Rlq#;Fr;N z=7az19_R1ziJn?VudP~7ne8^&fpdAE+v8;{w=T-IJ%%m5HP#k{_Pu_QW2C4J?E(F? zz2>a~9aP)`J3~$Pb@Bv~v#*Nl;%D7Q;ach!kGP^m+JUx=>FJz?tBBN~;ohH#{a?`~ zDfg-oe}Ymgu(a_HnS=ot2b^zS2qUzVi$Zq@^c9a4du4j&D*%W+y21 zl{$CdMUhq;JwuOkn*BrEn}*pw^6kO-j{0Fbx?Lc*IxEfkjIv|2{dTeR`bz4tr779H zA8^6}7ArNR`(h5ZL8UQ^ny(9&ZB;54MS57kR(z5tbbrbl*Kp(8^@)>Jypy2 zz)rYSpJ4uu`CK_#$>M2C=Z(8NTJ5E2nSpKdIwg7d!INPUVtvT3eRhOUMi*)JlGO?v zG88u5SQn-D;>}eLc^b6mX~WiSN|B>wRsb1W<1G3h_gRvJz*yN zgA_Hy4+rqqw}Zf%hzaO^na{2>nmNl-6n@Eo@%->auCbh#n$#F1q2$7{C-+rSid3z4 z9h!(+qZEoc=iv%GRJ=CgZsOU+gan-^i?Mp=s1Y9f`(?N|H9}kgQ!D>}@%N|StDx;) zV~*d&!Td+Ne-9J%imI==%TW||?fIlqcSpQ;PA;L-j?{E)&q8F(GVJhsn?!&he-&wX zg!738?R9BoF+dvC@K4s1RZKpNJ|%-->fY zD{PULO%_=90av``FlpqBb~i?HHkx(iZLlfUXZq-2TiL;3%fj@Y5O?QTEfGUyAz#XY zy4M;v%8P*B+cqA?iZe^UsT-A2svR^>4;Np1Z`Td~M%0+{&6N!pX;gD`{gJ+>tkC-4 zOXbg8_oh$TkJ`-=$e=HVgxpIGtr+|9UZ~J1U9WqwVR{1stC9Kj-Abq9xo?6Cw48ED zn-Z_;3IK>v^R46xNyC&5>OfLT&2YT*siGvOx29+B;I!yiWp(&hLBSeQp(!?14|Iba zs}GhsJ*Eh985+mG{%44$Qy{==K5w7o@~+0lQbv|vSKbdKujeF2eBD2H&va* zf4ETtyI`V8)vb1ws6UA$CW?e39F44P`MpM+cM|HgPrhG- z*zq|sX3wxPY(j9XdF!~}>8mG!>Cwjd#yBjvCe_SkGP1P_x~soURLjW5M%x*cf=5_A zSU@APFCuXl96J}?zdJJ6M%f)Q?mY7c!`Q3ndH9Eibi#ls~w7Es7EGVW$M+s}BT z!p9f_rV#F2?@Ka{8)^W{nm6sdoItYHAgAU+-3O3 z2Iv$~E)+n|gx?8_HXrCyh$-gt8+j6Phrp-3mZH(<@&aG!tpXo}{#Pm6nN(`Fm+o%Q3@q8hs-{cb%$6rSaf1 zF+k0?ns}d}ydSk4D!E&8S!Gui0fQf|faWF7mxfHp^M>wwla+F8ghfRAJQk$6b07FJ zvrxU*)o-0)aOdZhn=e7PM)Au#ofqiOKbH!9Ar?`Y-(vhGJy&{2=tq0+Kw{VVbGa_t z+`3P)8i&5hnlTy5$bO+B@ge&hXs#c}L0s+uUo7k?8q%r8FsqiNL>l?q>!P+-Wr7;2 zYoCK|?LtO`KGPzkm<8)5L*C;cPH$p(6pb@rl35KSPG|_+r!Zg7%QvlS+#M5aQ001VKLrS6nqb7!iOpKU-$iiY^fskpC z(?&x;Vriy^2w)J?O+7)QMk5K6BTS7kGGx_>!tnf-$S1Xc`qc_okw#)a`Lc4b@bLe^0m-tE1SOXetewUNt zC+V%F+v>Hsxz!Nx@Fw#Q+YYh;w}8QhCW)WXf+aEy ziAW>ia|%RmK+8G|wIUy@KBQ^^8jFM@zErcA&Z=Xi7BzBzD7k^cY~}LhBoe>iz`^q z-*Xqu(~+-$ykon;GIkCS>Bd+MHA}JGPiKbGMJgII*4cEd7QH2L%3)c_$@D9oFBD_; zQ|B8dB5z+ZnAl7@@0r`PfUA##pe&vdi9xD@0Dv$IhyyYJh!7zPL?IBd1Q7&81OTL{ z_x=|Ut=_7~aL(;Ip7QDkvEpEX()lR}M4z|2dYnYvwqhd5#fIZuvq%6MW)BCXA8K>g z=xgenl=#Y$h#U|OI-=X+(_C2J`wfl~qo&_zR{-?%EIf~3y4O#^(cZl^c3$~47rYFj z4q%GR7o9uVe<%oJhy>w(8-~c3>M0OENy)_!E=CzW0DwOumpWHJ^=Nq@zg<%AXV+P- zyxS`Z9@3_)R&2lz$x}~;$be7jf6zdh-VGy}FDWRKYl(sf8<#>`n#hh866iyjG=<{V zz1~G4Bf$tvOQL#dMp+OCS4#?WAj{$rXHtQ=NyFz zRJ4LOnpJi$b1bLXL4X0pQNKF{&VRrFQSdRM&9qiPLJW!hL8{QG!&Qb(pJ)LFpN~(i vvxzH}N`3qS1&@{K$U++~uC1$`q;PBB>aYBZogbhcez#4;1G-;8eLn9L!fXRvEO%G9%Kxi606Gnq* zn^Q(inKaslOpP9+N2K)uk)vpaMvVZ(^coWh>S)MmnoQ6_6e!bB(4M9GN3skJoTs69_mX`zv_jXg)GJpfFNq75-HCYXkUAoT!xfHX20FqoM% z$kRuuh-ffkQc30000D00000000001d>rEjWRURqaf2DGynh^ z0002cGz}U6(?9?K8X5oq00000&;S4c8UO$Swj|OBBgqJ$l3>Z0Fi0c!(Wl2cGZCqNJ{W@*^)^EreNeDDZ>Z^ zL%nbyh9<0>F+F6_lP9pqN#D28m#U3RDcl*;w_OfVQd)} zhAgZEn;xbFP1@3jwHL%K{s$ZZBN&Oxq6Avzb}kMNnj=Jvpa5Z@NCGd(k+!qMb^F$c zdeD+>xsgOZCK_}fl-kx z8l=QXR(IG}MBR}=WD-{=VLA>u>{{9tqTig1w^I80^dCDstHl6FqeR-Xhz@Qa3V>!v zMn^qRktebye1jV@qKyQJp^zXUrSZcslEgEB24FxzXpo57N(Aa+0pdxcz#iD5U-kT7 zPPVKl7;=miaF77aHWHN%O2L$bE<;ElW39SCZ1PzwFAz_Zi{aq}fQmp25_A|c0HKnq zL9gNJlgxS|xz+P>R;j#vrYcny=3$=OaUBSAG*j=(*%<%2%3`u6Heo0lG6@7yAtF*B zq*6$PfC&JRNCJ^a1c5!qIOnkjDWq3c)bO9M9DA^;5!|CM*k9B(gU+^-^PuBAW$$@you`>o8<0uWp4 z=W5+~u`nB$V`(%hg_TnC(<-^ru$f?u253WJX_G)q8wg%@0FJftQ-4lRTSInaAQ#=8?&>-@A7(vClme!u{bE#L$|2zlewuFWzDC?njnJPYgQjA(11yqI45gK&k^1M5GUug zNT7rSr|{sk#{vPXbJZfSeK{2kf90AG7Wo&8vH>yr>paDV77CorjFU6W% zONK`fS9@_7aU_N2V8ih(i00`-XW-E+gA}kkYjU^EP7O$|K zbaWLgc7A9VNG1#ec#=0*uk2p@RbYTkfCCmmjl6&c6SwEn{~;9BO&;|*8e9S(b$V^> zqA(E=|HyxyQk+pD;aSy-E;Xn0TgLz+}l4fBr7y Lig2MJs+Wf1F r_prior_sd; real log10_g_prior_mean; real log10_g_prior_sd; - real i0_over_n_prior_a; - real i0_over_n_prior_b; - real sigma_i0_prior_mode; - real sigma_i0_prior_sd; + real i_first_obs_over_n_prior_a; + real i_first_obs_over_n_prior_b; + real sigma_i_first_obs_prior_mode; + real sigma_i_first_obs_prior_sd; vector[7] hosp_wday_effect_prior_alpha; - real initial_growth_prior_mean; - real initial_growth_prior_sd; + real mean_initial_exp_growth_rate_prior_mean; + real mean_initial_exp_growth_rate_prior_sd; + real sigma_initial_exp_growth_rate_prior_mode; + real sigma_initial_exp_growth_rate_prior_sd; real mode_sigma_ww_site_prior_mode; real mode_sigma_ww_site_prior_sd; real sd_log_sigma_ww_site_prior_mode; @@ -112,20 +114,20 @@ parameters { vector[n_weeks-1] w; // weekly random walk of state-level mean baseline R(t) (log scale) real eta_sd; real autoreg_rt;// coefficient on AR process in R(t) - real log_r_mu_intercept; // state-level mean baseline reproduction number estimate (log) at t=0 + real log_r_mu_intercept; // state-level mean baseline reproduction number estimate (log) at t=0 real sigma_rt; // magnitude of site level variation from state level real autoreg_rt_site; real autoreg_p_hosp; matrix[n_subpops, n_weeks] error_site; // matrix of subpopulations - real i0_over_n; // initial per capita - // infection incidence - vector[n_subpops] eta_i0; // z-score on logit scale of state + real i_first_obs_over_n; // per capita + // infection incidence on the day of the first observed infection + vector[n_subpops] eta_i_first_obs; // z-score on logit scale of site // initial per capita infection incidence relative to state value - real sigma_i0; // stdev between logit state and site initial + real sigma_i_first_obs; // stdev between logit state and site initial // per capita infection incidence - vector[n_subpops] eta_growth; - real sigma_growth; - real initial_growth; // initial growth from I0 to first observed time + vector[n_subpops] eta_initial_exp_growth_rate; // z scores of individual site level initial exponential growth rates + real sigma_initial_exp_growth_rate; // sd of distribution of site level initial exp growth rates + real mean_initial_exp_growth_rate; // mean of distribution of site level initial exp growth rates real inv_sqrt_phi_h; real mode_sigma_ww_site; //mode of site level stdev real sd_log_sigma_ww_site; // stdev of the log site level stdev @@ -159,7 +161,6 @@ transformed parameters { real phi_h = inv_square(inv_sqrt_phi_h); vector[n_ww_lab_sites] sigma_ww_site; vector[n_weeks] log_r_mu_t_in_weeks; // log of state level mean R(t) in weeks - vector[n_weeks] log_r_site_t_in_weeks; // log of site level mean R(t) in weeks, used as a placeholder in loop vector[ot + ht] unadj_r; // state level R(t) before damping matrix[n_subpops, ot+ht] r_site_t; // site_level R(t) row_vector[ot + ht] unadj_r_site_t; // site_level R(t) before damping @@ -168,10 +169,10 @@ transformed parameters { vector[ot + uot + ht] state_inf_per_capita = rep_vector(0, uot + ot + ht); // state level incident infections per capita matrix[n_subpops, ot + ht] model_log_v_ot; // expected observed viral genomes/mL at all observed and forecasted times real g = pow(log10_g, 10); // Estimated genomes shed per infected individual - real i0 = i0_over_n * state_pop; // Initial absolute infection incidence - vector[n_subpops] i0_site_over_n; // site-level initial - // per capita infection incidence - vector[n_subpops] growth_site; + vector[n_subpops] i_first_obs_over_n_site; + // per capita infection incidence at the first observed time + vector[n_subpops] initial_exp_growth_rate_site; + // site level unobserved period growth rate // State-leve R(t) AR + RW implementation: @@ -186,10 +187,15 @@ transformed parameters { // Shedding kinetics trajectory s = get_vl_trajectory(t_peak, viral_peak, dur_shed, gt_max); - // Site level disease dynamic estimates! - i0_site_over_n = inv_logit(logit(i0_over_n) + eta_i0 * sigma_i0); - growth_site = initial_growth + eta_growth * sigma_growth; // site level growth rate + // Site level disease dynamics + i_first_obs_over_n_site = inv_logit(logit(i_first_obs_over_n) + + sigma_i_first_obs * eta_i_first_obs); + initial_exp_growth_rate_site = mean_initial_exp_growth_rate + + sigma_initial_exp_growth_rate * eta_initial_exp_growth_rate; + for (i in 1:n_subpops) { + vector[n_weeks] log_r_site_t_in_weeks; + real log_i0_site = log(i_first_obs_over_n_site[i]) - uot * initial_exp_growth_rate_site[i]; // Let site-level R(t) vary around the hierarchical mean R(t) // log(R(t)site) ~ log(R(t)state) + log(R(t)state-log(R(t)site)) + eta_site log_r_site_t_in_weeks = ar1(log_r_mu_t_in_weeks, @@ -205,8 +211,8 @@ transformed parameters { to_vector(unadj_r_site_t), uot, gt_rev_pmf, - log(i0_site_over_n[i]), - growth_site[i], + log_i0_site , + initial_exp_growth_rate_site[i], ht, infection_feedback, infection_feedback_rev_pmf @@ -284,14 +290,15 @@ model { log_r_mu_intercept ~ normal(r_logmean, r_logsd); to_vector(error_site) ~ std_normal(); sigma_rt ~ normal(0, sigma_rt_prior); - i0_over_n ~ beta(i0_over_n_prior_a, - i0_over_n_prior_b); - sigma_i0 ~ normal(sigma_i0_prior_mode, - sigma_i0_prior_sd); - eta_i0 ~ std_normal(); - sigma_growth ~ normal(0, 0.05); - eta_growth ~ std_normal(); - initial_growth ~ normal(initial_growth_prior_mean, initial_growth_prior_sd); + i_first_obs_over_n ~ beta(i_first_obs_over_n_prior_a, + i_first_obs_over_n_prior_b); + sigma_i_first_obs ~ normal(sigma_i_first_obs_prior_mode, + sigma_i_first_obs_prior_sd); + eta_i_first_obs ~ std_normal(); + sigma_initial_exp_growth_rate ~ normal(sigma_initial_exp_growth_rate_prior_mode, + sigma_initial_exp_growth_rate_prior_sd); + eta_initial_exp_growth_rate ~ std_normal(); + mean_initial_exp_growth_rate ~ normal(mean_initial_exp_growth_rate_prior_mean, mean_initial_exp_growth_rate_prior_sd); inv_sqrt_phi_h ~ normal(inv_sqrt_phi_prior_mean, inv_sqrt_phi_prior_sd); mode_sigma_ww_site ~ normal(mode_sigma_ww_site_prior_mode, mode_sigma_ww_site_prior_sd); @@ -336,14 +343,8 @@ generated quantities { vector[ot + ht] exp_state_ww_conc; vector[ot + ht] state_log_c; vector[uot + ot + ht] state_model_net_i; - vector [n_subpops] site_i0_over_n_start; vector[ot + ht] rt; // state level R(t) - for(i in 1:n_subpops) { - site_i0_over_n_start[i] = i0_site_over_n[i] * - exp(growth_site[i] * uot); - } - pred_hosp = neg_binomial_2_rng(state_pop * day_of_week_effect(model_hosp_per_capita[uot + 1 : uot + ot + ht], day_of_week, diff --git a/tests/testthat/test_helper.R b/tests/testthat/test_helper.R index e4156eaf..8b6b9480 100644 --- a/tests/testthat/test_helper.R +++ b/tests/testthat/test_helper.R @@ -1,10 +1,10 @@ test_that("Make sure we can find and load files we need for other tests.", { testthat::expect_true( - exists("toy_stan_data") + exists("model_test_data") ) testthat::expect_true( - exists("toy_stan_fit_last_draw") + exists("test_fit_last_draw") ) diff --git a/tests/testthat/test_ihr_transform.R b/tests/testthat/test_ihr_transform.R index b9787a13..a2976d95 100644 --- a/tests/testthat/test_ihr_transform.R +++ b/tests/testthat/test_ihr_transform.R @@ -1,9 +1,12 @@ test_that("Test logit-scale random walk on IHR in stan works", { model <- compiled_site_inf_model - days_weeks <- dim(toy_stan_data$p_hosp_m) - ndays <- days_weeks[1] - nweeks <- days_weeks[2] + weeks_to_days <- get_ind_m( + 168, + 24 + ) + ndays <- dim(weeks_to_days)[1] + nweeks <- dim(weeks_to_days)[2] # Make sure we cover a wide range sigma <- 0.5 @@ -20,7 +23,7 @@ test_that("Test logit-scale random walk on IHR in stan works", { # Get vector from stan and compare p_hosp_stan <- model$functions$assemble_p_hosp( - toy_stan_data$p_hosp_m, # matrix to expand from weekly to daily + weeks_to_days, # matrix to expand from weekly to daily mu[1], # intercept to regress back to sigma, # SD ac, # autocorrelation factor diff --git a/tests/testthat/test_pmfs_normalized.R b/tests/testthat/test_pmfs_normalized.R index 4475ff89..aa44261e 100644 --- a/tests/testthat/test_pmfs_normalized.R +++ b/tests/testthat/test_pmfs_normalized.R @@ -1,4 +1,4 @@ -test_that("PMFs sum to 1", { +test_that("Test that bundled PMFs in the package data sum to 1", { model <- compiled_site_inf_model shedding_pdf <- model$functions$get_vl_trajectory( @@ -11,13 +11,15 @@ test_that("PMFs sum to 1", { testthat::expect_equal(sum(shedding_pdf), 1.0) - generation_interval <- toy_stan_data$generation_interval + default_spec <- wwinference::get_model_spec() + + generation_interval <- default_spec$generation_interval testthat::expect_equal(sum(generation_interval), 1.0) - inf_to_count_delay <- toy_stan_data$inf_to_hosp + inf_to_count_delay <- default_spec$inf_to_count_delay testthat::expect_equal(sum(inf_to_count_delay), 1.0) - inf_feedback <- toy_stan_data$infection_feedback_pmf + inf_feedback <- default_spec$infection_feedback_pmf testthat::expect_equal(sum(inf_feedback), 1.0) }) diff --git a/tests/testthat/test_rt_assembly.R b/tests/testthat/test_rt_assembly.R index a7b07638..fd664bf1 100644 --- a/tests/testthat/test_rt_assembly.R +++ b/tests/testthat/test_rt_assembly.R @@ -6,9 +6,12 @@ test_that(paste0( ), { model <- compiled_site_inf_model - days_weeks <- dim(toy_stan_data$ind_m) - ndays <- days_weeks[1] - nweeks <- days_weeks[2] + weeks_to_days <- get_ind_m( + 168, + 24 + ) + ndays <- dim(weeks_to_days)[1] + nweeks <- dim(weeks_to_days)[2] ## Make sure we cover a wide range sigma <- 5 @@ -48,7 +51,7 @@ test_that(paste0( ) unadj_r_days_stan <- exp( - toy_stan_data$ind_m %*% unadj_log_r_weeks_stan + weeks_to_days %*% unadj_log_r_weeks_stan ) |> as.numeric() diff --git a/tests/testthat/test_ww_model.R b/tests/testthat/test_ww_model.R index d2afebbf..e7c77c4c 100644 --- a/tests/testthat/test_ww_model.R +++ b/tests/testthat/test_ww_model.R @@ -2,21 +2,22 @@ test_that("Test the wastewater inference model on simulated data.", { ####### # run model briefly on the simulated data ####### - model <- compiled_site_inf_model - fit <- model$sample( - data = toy_stan_data, - seed = 123, - iter_sampling = 25, - iter_warmup = 25, - chains = 1 - ) + withr::with_seed(5, { + fit <- do.call( + wwinference::wwinference, + model_test_data + ) + }) - obs_last_draw <- posterior::subset_draws(fit$draws(), draw = 25) + params <- model_test_data$model_spec$params + obs_last_draw <- posterior::subset_draws(fit$fit$result$draws(), + draw = 25 + ) # Check all parameters (ignoring their dimensions) are in both fits # But in a way that makes error messages easy to understand obs_par_names <- get_nonmatrix_names_from_draws(obs_last_draw) - exp_par_names <- get_nonmatrix_names_from_draws(toy_stan_fit_last_draw) + exp_par_names <- get_nonmatrix_names_from_draws(test_fit_last_draw) expect_true( all(!!obs_par_names %in% !!exp_par_names) @@ -28,7 +29,7 @@ test_that("Test the wastewater inference model on simulated data.", { # Check dims obs_par_lens <- get_par_dims_flat(obs_last_draw) - exp_par_lens <- get_par_dims_flat(toy_stan_fit_last_draw) + exp_par_lens <- get_par_dims_flat(test_fit_last_draw) agg_names <- c(names(obs_par_lens), names(exp_par_lens)) |> unique() for (param in agg_names) { @@ -57,7 +58,7 @@ test_that("Test the wastewater inference model on simulated data.", { # Compare everything, with numerical tolerance testthat::expect_equal( obs_last_draw, - toy_stan_fit_last_draw, + test_fit_last_draw, tolerance = 0.0001 ) } From b3acddb09bf91dade4a225aecc35c419217cb755 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Fri, 6 Sep 2024 19:15:53 -0400 Subject: [PATCH 11/46] update vignette to reflect default NULL seed in mcmcoptions (#125) --- R/initialization.R | 37 +++++++++++++++++++-------------- R/sysdata.rda | Bin 37855 -> 38039 bytes R/wwinference.R | 32 ++++++++++++++++++++-------- data-raw/test_data.R | 4 ++-- man/get_inits_for_one_chain.Rd | 5 +---- man/get_mcmc_options.Rd | 4 ++-- man/wwinference.Rd | 11 +++++++++- vignettes/wwinference.Rmd | 12 +++++++---- 8 files changed, 67 insertions(+), 38 deletions(-) diff --git a/R/initialization.R b/R/initialization.R index c420d5eb..04cf8172 100644 --- a/R/initialization.R +++ b/R/initialization.R @@ -2,8 +2,6 @@ #' near the center of the prior distribution #' #' @param stan_data a list of data elements that will be passed to stan -#' @param params a dataframe of parameter values that are passed to stan -#' to specify the priors in the model #' @param stdev a numeric value indicating the standard deviation to sample #' from when initializing, particularly from a standard normal. Also acts as #' a multiplier on the prior standard deviation, to restrict the initial value @@ -11,7 +9,7 @@ #' #' @return a list of initial values for each of the parameters in the #' `wwinference` model -get_inits_for_one_chain <- function(stan_data, params, stdev = 0.01) { +get_inits_for_one_chain <- function(stan_data, stdev = 0.01) { # Define some variables pop <- stan_data$state_pop n_weeks <- as.numeric(stan_data$n_weeks) @@ -22,7 +20,7 @@ get_inits_for_one_chain <- function(stan_data, params, stdev = 0.01) { n_ww_lab_sites <- as.numeric(stan_data$n_ww_lab_sites) # Estimate of number of initial infections i_first_obs_est <- ( - mean(stan_data$hosp[1:7], na.rm = TRUE) / params$p_hosp_mean + mean(stan_data$hosp[1:7], na.rm = TRUE) / stan_data$p_hosp_prior_mean ) logit_i_frac_est <- stats::qlogis(i_first_obs_est / pop) @@ -39,7 +37,8 @@ get_inits_for_one_chain <- function(stan_data, params, stdev = 0.01) { sigma_initial_exp_growth_rate = abs(stats::rnorm(1, 0, stdev)), autoreg_rt = abs(stats::rnorm( 1, - params$autoreg_rt_a / (params$autoreg_rt_a + params$autoreg_rt_b), + stan_data$autoreg_rt_a / + (stan_data$autoreg_rt_a + stan_data$autoreg_rt_b), 0.05 )), log_r_mu_intercept = stats::rnorm( @@ -63,27 +62,33 @@ get_inits_for_one_chain <- function(stan_data, params, stdev = 0.01) { mean_initial_exp_growth_rate = stats::rnorm(1, 0, stdev), inv_sqrt_phi_h = 1 / sqrt(200) + stats::rnorm(1, 1 / 10000, 1 / 10000), mode_sigma_ww_site = abs(stats::rnorm( - 1, params$mode_sigma_ww_site_prior_mode, - stdev * params$mode_sigma_ww_site_prior_sd + 1, stan_data$mode_sigma_ww_site_prior_mode, + stdev * stan_data$mode_sigma_ww_site_prior_sd )), sd_log_sigma_ww_site = abs(stats::rnorm( - 1, params$sd_log_sigma_ww_site_prior_mode, - stdev * params$sd_log_sigma_ww_site_prior_sd + 1, stan_data$sd_log_sigma_ww_site_prior_mode, + stdev * stan_data$sd_log_sigma_ww_site_prior_sd )), eta_log_sigma_ww_site = abs(stats::rnorm(n_ww_lab_sites, 0, stdev)), - p_hosp_mean = stats::rnorm(1, stats::qlogis(params$p_hosp_mean), stdev), + p_hosp_mean = stats::rnorm( + 1, stats::qlogis(stan_data$p_hosp_prior_mean), + stdev + ), p_hosp_w = stats::rnorm(tot_weeks, 0, stdev), p_hosp_w_sd = abs(stats::rnorm(1, 0.01, 0.001)), - t_peak = stats::rnorm(1, params$t_peak_mean, stdev * params$t_peak_sd), + t_peak = stats::rnorm( + 1, stan_data$viral_shedding_pars[1], + stdev * stan_data$viral_shedding_pars[2] + ), viral_peak = stats::rnorm( - 1, params$viral_peak_mean, - stdev * params$viral_peak_sd + 1, stan_data$viral_shedding_pars[3], + stdev * stan_data$viral_shedding_pars[4] ), dur_shed = stats::rnorm( - 1, params$duration_shedding_mean, - stdev * params$duration_shedding_sd + 1, stan_data$viral_shedding_pars[5], + stdev * stan_data$viral_shedding_pars[6] ), - log10_g = stats::rnorm(1, params$log10_g_prior_mean, 0.5), + log10_g = stats::rnorm(1, stan_data$log10_g_prior_mean, 0.5), ww_site_mod_raw = abs(stats::rnorm(n_ww_lab_sites, 0, stdev)), ww_site_mod_sd = abs(stats::rnorm(1, 0, stdev)), hosp_wday_effect = to_simplex(abs( diff --git a/R/sysdata.rda b/R/sysdata.rda index 8011a7ee48e0683bee366bd7fa21a3aa5533dc7e..69b428117c2b7062b5b92c766ab6d995d2a310b0 100644 GIT binary patch literal 38039 zcmb@t1ymjDvMszIxDzx;a0u@18r%s4cXxMpcXxM!yAv$9ySux~zq0o^`<#959rwR) zyw{^gudnI)s+&2hW>xp#opiDRar)kkU>Fn zG1D}W6cbsYpa_4o{wmk4+$aIL<$yk%mG-BsjEqd!X-;8bZSI)+$=9ysdG?CDkXDxgk*R`jtsP~jAV)o@)12eJ^6zOsD2-GJ&V*=e>%mdcfWVU{N-wd%&0vF%37YXwjat?I`d9E+fu+3j2mU> zcQa-jL~xTn)8CC;{nPAm5$P!MONJHI=7`{Y~)aW=`?CBXnASU0tDO z_9B(o^c0RlB~xwwn4PH-6j@;@k%%jAPFz-pmX1bQlJ7WqKhs&xz0(7${*$&KI&2Jqp8An!ndzD;~E zUxmwqj2_G{lh{@tbbVfuS(Or)HP;5@)TmD_RCBqlvkVo#u4#tZb+<06?G%Jw*6&;y zb*2?k^YgbRe<{V+XEpZ}m=TCA15hmamiiHfN_J=&S>b0_kD$rHqUH46E<;v#S=_HjYr`@zpnh}&TG_K3k#?YD0MW()mEYpfOwkGp%E{c( zTXjNxT&YVNZt(hRf@ZN%!o}=rH%)+??n}Tg-`D0}*Wy#3qD>bDMG@t=HsNZ(Oj+bTuiByU(p9U%Y41>uv zCk?Yp^$aMQEw8#l&7ypP~kRko#Q)WgJS^`0nC4})0_L~z@QeyC03id@X{6eOT${kGI zZYBiwV&i_6bmpo#r*g5Z<^&x%h_PN3f5f|umu)#H{{^)nw`EkRlWo&(!McOK6 z??hm$pVU%b+5q8aWBnj9_aV_9pOf`_yMERIXu)*rlSm{fzJb#)+8Y*#qhE8M5MLVR z35e5XlNkh92P*kMSsz}Rm8x>efoG~MK8_?uz(pr1Y!B-J3>geu)EDSt1*z1lw%Bbt&)n^n0JudcO7!GB=UXtb9Z>^@Sov(7 z_RBhi@&N0%nYH?Lsab4|s`=aETxSfICm#&ZYfQyRULvE*IRafM(OiiA$Z=ywtNP_Yd8mVUMA; zgNV^#uaB0&onqVzqUg=x<2wYCYFsAIY}ilsD_3M3i8ly>j=Tac$-V?&W;cK#BXg7^AZG3;VsVVywGZ2y8M8#j_gY-d zMuH3K_OK4wqZ>UckHHImacRFcb20yjouHoNI9jl>^zCOuI;9ZOConqal5#Q1h-WM>DtM%P%2iI*-@B3Ahy!J+Ft1ch+cfNHOxR1|^ z0(tY4sn1aWCteh}T6j3&r%)nk}w-WSNi zysr#6CsxhCAfov2?+s)*nD&(_m61%w8HN3 z92x^YA3P@%*r)G)&`Kov{uYKL;jIu&2Tm;>RqcC(ki2`!8Ylb7C_rcQ6HK1}N1uYEgmyVOWhiQwqXYV7>4qv6 z%{VT(eNX6ogD3D<#A&%1>@6$rZy&Y9&h_S-PkTleWqHNi(~v}iu~hm%kXEr~x_ppi z8Z(!@Y?q|DZ%f^+(M=x~ie3Xl2F~XTTS4pAHm)K!8rOv zrW-53piehX?a-<{A)THK_1^_OUml%&#`OqT+xcX)2@Z}n@_ApA{e2ac; z3XT=Z{aSYTv^Ar%4q`f({^L_W>&V=W=R{q1y;hf}w_zDQOfTRoruTJJx8;85+F{{w z!w|BIRrN0TL>5}{Th{p%@ksOh=YbVwy`WGjhP#^GWTae_KuBZ&pZ8EWZ)m{R^#R1$ z{KUKTk*%2)GJd2gQ;?QvBFcWLW4zsWjt;Xe54@bMcC5i0PiEnUbNTi;O+-e)2nKqS zp__5{YHD<$?*v!2t|vQXsNejcN1@0E+if4DrBo-!E6O&^yksa#L7+hi!LWUN0DNJ` zc3o1R*O5_WR>}bZll`QCl6=QDhB$Y3 zfON2?(In6qiYLje*ci^%NJL!@-w78Co(-5ti~N~x)Ui!@*VPydaMl)hByCk zbhnpy9?6pje?hDCt4Xu`U==B1*+nlV=`AH_0@C|kZSs{Fh24jU?N)23MR#a3b|nQ( z)CVaSLiPo8mY@n(d_{{gsCy^s4%Kk9n^^e8^Cr{Oc5y0Oez-9*i{{Uwy>di!D9? zED^%U$Ju}3KI%2d5g}V^K0)CJCZbkszD*cZ0O)#az1d9kkEO@2J*Z4und) zdp#KEDJ1MpqXEE2<1{JFnlrwKRdI< zV8X75XcDs4PReNe0)r*I_0mzLymZxK*R%UPULA~3u4wtjK%sCZ<*0deJtC_F4c>gE zW6)jIdKU-_xiGR&uL-Vwx3V?1i~*u#m!RBn!((CAO~*J$XV$RgXP@N!9rw!d5=j^2 zqAMUcs#|fz>l;V@7M$7AUTZ6EWPqo2>GhL2Luj?w%tDn5qlaOe;;=PnbQom&*2NGT z`!KF%^f~86`>BiggH_rY9+An>iymWuk;^T&8fAT9{WQ!8#m77ae$;$!+Tw1?36@Bv zbV&h)(%yh113Cqr+|U95`w{2UqYS#srp^&sU+%|Ct#(@>99wbj@Q?E`X#Hf%$DhE= zJW(<`j&iSuoov%pNKLWp2Tm`To3}yTwK+3Bx%)m7-uZzdozT>T@`Zyz`OhPAIfL;r zXbFBVih4rnsfa~NBg@y~u@-(FxO=huwrNguz>PcnRG$5dGeC?1hac8QuJya^c&5~# zBNHVH#r=lP!A71V9n=RkS61;NOmVezP*2IPc&Y&d8xo=nMhN&q5UPD`o3vkreR;gs z1>MR;PXMf3J+|>DjT26ip6#0XctH##-Cn$CDh@nE=;#wxQdKMR_a)@B1lR|5oSvp7|j`SICalE!HoJ%@Gq z2u|b98-pPehH*N3Jj_q4k9=^xhkh3ar4)4l(V{5K26UJ83i!2@+J^*AtmFrK=oMOB z;nN-kfk?xvnjX^G$HZ+v^S#LVBhhQ_9O5&zb(N=`4xC{HM{Db$B#m_MDS)ah)^*v) zV5ey#KxD-fNv)us-JPt;2O!vUn-7dVH(=OAqQ17F(QXg(FY8Pgs)C%;9Z*fP_Q|my zTxV<+Uz#xo83|qtfCgpAYDv@J_`}1o@TkVa?8|WE;%(FNA<7)kWTMgJ@3Lk-AAavl zp`DYd-d{BfYx2}oEx6f!8Ljvtnnty*eM&6VPo{u8&i6|&Eo40dbp|Yb=SzLiLP%!g z*GVROS9bNSEfd4ZZ7&XQ^S*;@Y{d`D__*aSHnvDwi_5l#jFvwj)iCUQU2qWla^&$` zt*xV!KBYff{T1GTz#4}WhKLx61k1jPpx6$ADzwtcRSR(gL@aK;EXvJX>%6Ryb? zy;9NUP zh|r#XzSo1OD5?l$&s7nDlx7?3#!xgJFQmtEJ#*h_*KV0CiOP^Xt-$hKk2d(TV$^-e z@(FpCw>lGY_BQi7Sjlh~tqaVjSjZ#Iy-<&ytKbax!uafraum-aV?9`#Z5@U;fnZ6_#6!7iAGd_3t8Gw|EGlV{l-hiGpTF60A!^cQ#$HJ-5GwxH%v zH?5T&`Tbu5ZbC&7nGrWkYPhde-JzN>Q$L*T*EbI*!ScW3&EuvF&6D>g{hD(qKvCkI zs|hx~IJXE<*~?`;q1$l(^67iTbzA4I>bu+9ueS0nl0nF3@U8{Okn5h5B2gqsw$}IU zc0&NwyK>YAS7QZ|gBQ&SrBnB>Wm6QG51YzeT;lVh%y(~y;vQ-w9vk#&sPn1|<8i+i(?fYTU!sDcUKfeqTVG?OB=R8J}nz7R-Ib@ z2uZ3Qd3M+U8R@#5yU6!aHHKVKGm#{e)!xSL#RJKz@6A|p#JOQ!rT%30REnj9!#j!F zJ3uhUwg?C$!0Ph{rygLmL)>FYex$AM4@-g${9g&lelBEzH1YbMs~lD zx2o?cP%#~1FEWZX*^CBtt293~4_%mQQYLk=euQ9O6=zF?us`cnoA?6k-Oke*uCks+C_zJiO24Eh*SJ5AyfA$j@iDW%^( z#)F1pcg8H>9pH5OwfFy&-y5m!EVnQ%v~Qqcn^fT=lkCTRq;f)I8J}l0S+7<2FqP}i zDonz+JQY76&MiOS1h(`V+MP4s1e2az?_H;_N>ITu?udRTBw5KRAWqll0D@Op_N1K_ z@>=(kr)yNh=}Jk-fT~h_2Nvp}2cO3&?ZKS~>#cEuhjR1$2G8*k zqe|oEUyptN*CWugQ@;N+)>tk6&p-V?+lL%;YCqThf9CE_M;K1OJ@OD;Xh~OHdpdTO zT~>uWWX)5fVDY>7Rdn_n*RRau8Lkh;XO1uqeaE6;BUXy`bJVV3pS6%#ru!04S+iRJ ztLMHtZ8rO(XHe^b=@X_XD+Uj}G&z~o=R>AUx9eF#{BC=^!9I2MkIs!%R+p73RBc~t z>b||v>LqnqaATv!cBOa-sm4#HJIs;YEo$^|fTS0)$H9PwkDGhN^}}fO>F5j!T2M() z-$`JP7iAF15_qM~c3zxTc%XJ1!V%hX(42j>(YTV&OjSM#tfGQ>dXb{5b{t+L1C$Ts zfUq*kt3&H0vHQK%q=Crv<$iK8BL&0zu`Q~_gCU|%L$XTH2{PHa_VGYlLlLG7gkpQIwXJ`eB0n z=bX6q^FKTSo$l4I-M63X$BJ>1Wx5c@Q8F?zI07#NpafjRfwPsZZrt8+951F16u_YU({EvBSpo^9Lg zGuWq!#HKSS{ucwv5vS;{k;%snjdu1^mJNqwWMyujtH}P_*&H15a;UAXgGBZNY89<% zg>epzV(c7e=k|`s+l3sf7AvbvX%#JELrVPE|GvAr+WoJ6%UD|{Cu@fs z-}??=mj8YMh5G-vAO*=~pgXbzf9F5UiGj}PfD0=or1bUJpfLIKQc^G5soN6PT=$?8 z)eu+uML#lw$iWW+8|&)j!RySg(N|nid#=qcqpPc{m1k#XyFk7)25%x)tTJ7G%ZS^; z-&s#P{Ry;OT^rE`{242D={i8>PyQBju2o(z^Hs`DPEJ4mo2U|V1QnwXArAT|Mx40q z(X@6yW(Pda{n_85mQ&;04e0mA=pP|T2P#G!Lvnwsk3`K1k;0#A#Y?WPm z?(Vv|Di^#r{&Hn3bLHgfoV&BVQK#b@UXJ|ihX;+|l_NG>B2DXOdnN6oqg@x2`^!80 zrRcJwVtz?EV5{Pp2es((hKmPszPhlbB$FScvv=_LD&|&)e)A#r zCmXh6Ez9|_uG3JL)3}xmXJV{s_OYUWG9N27w@MsCC~{a}nKA`&7$3scC^k*F%1OMn zN+ua*e-bzGx@y*QWuL)7JzXPBJ!L=GC_UIU{diiN9*I`5+Gjq``7jQbteG)x^IAzN z5c1~|s-41M7b%^=VShONFS0IMZ8}``*?;GsHrU^IaC=a$(rkCVJ)W=9d|vq%WB*~M zg?-vj1LXc(o1*L=aNDJCqbVs$a{>`Q0gKi9D27`?94n&%OEzj5Pl4YQFNB}P>5p=3RJb^;7L_St1wNfAf`xY?GAJ=l zcet?HyWz7YqCv_f!UU630qA6M2iTG8&afQMyj$%Js{+LLH{^#K= zO4rIZT42Wi#h^7kj<&YBBlgPBptESvMh`ec7JECs9fGgv8rmAX#n*e<~&rt$(a>>pj2Onq6Hz=?B35Lyh|Z|2+JM z9m!?KitcZBcc7)UeQml$b1aa{ZVC0jeOVq~Vk%<6n|++M4$!h67R z@nX%|ae2pn$38xMd1HHiUsxr;6|}k{(ZOa7ca;i1UfR#N_{#3t@jtgCVZjq{#o4hX2A+(?4m| zdot@tB)P9<4=?ijuK(8VmF3g&0-B6~XoWX$i-$LG`LbW;TK%6Qr}=*%a@s&S8u}Mg zKzvH?FDhJbkN)ShK>$vn?tivvKTqEW>e=6OMr`R1jXSUWCy&1?tZ3}>{TaOU0uX(5 zAmKkSfF3x1ht9*ATko|d>(9H>jlE}AJCuHZ~xybe&7wjC^z@6!IFEy9xJ zcvuq(2K;@g3Pz@)`Jou}QG8YoQ>ev(nJ5LOiS(X zRj@;UDAIp9_7A3HcBz0B^xvfGFT<-h)>o&ps?X=E?O6|u&GOjVpT=$GEKcL=P|PaNEdg*ke@6d*h?x>FKOEBb&dw_DAnL>Qu>P!4^c7|THcMi}N!n)WW~y_M z*9t?#ar0Kde0#p{i^+I8mdSWB zPb7njut2bFq;8B})Z3I6C%)%H(bzd61z-iH7x{(YeVo3E``c~FSGHaR9kptZBu($* ziN@#XYTTYAD|U?$-+(ruLG|v1hEL|NY++GG*-S_^Kx&|2h)tlRpC$#0mH*Dgt?>Ug zJ^m$P@*hz}r;rk!-z&dAds<~Wz56AP7PMv1j|YWTIriT(>$i+3>kKPAaKEB7CTw?a zTsU*#{k(AD?bDX4pyLct#v{F4X<^}-B|mH&5ha@KH}PI}^Apy_qP-dm>xPMa@ja zo2Fu|dRGt_od^Q=pSAiw^yxnmCWdX5OwE4Pa_mhNm=qlLt&4Av%8_wJ(n&5#Ex-uZ z;E>K>!$cu7@d_Hf6}GW3G;{lWSK!sztJP{R8g{2WCmwfK)lEb|TRcUk`f)kXlsZ_oz-AOD8B+ds>?naUr44*&tn zVLK&`mH5G2$y{M37y=xwTe2Rn0khyY;y^Ho|61efC;lhE=c<4qQP#=+jzHPi;0gJe z4DXoXfN9ILCdw<)32wGoC{33Laac8-qZ$EBcMdoJK1dAZF@X#|87H10Dr;q zdmweU^*h*qi_mY&(m!PUZx#|`&o*g5Z<<|m)j($Y=_7%73pj3x5vObTRM-FmR(z|p zv;@e|x%2PF&FycqrRRU2^xVTq^*3+c(8RG6*D1sa{q+@Q^1s_;6(Ernrnf*Ztrrj1 zye4NE?-e_D<1>0cFP+C198Zt6wqAI9j;C`@uoLIwsv@(#8KFbsNP99~Atns+yKq0Qk3K`g^0=QTo^CyG zeMW@z>)yCQByk2})cS+=cPKS;jpJB(Jodl-v$_03-ZTFdlaXw{ja!#4fpX+z{u|VY z-!vQnD`n+haVxqV0pxFWt*f+rpY1n#7$L+-ZU8H7C8aGfvdZ5r>bT}n`}6IeU2*## zJ*(@#&^HHZ_?=2We|rX=nr6=~h4?pjs=teID=6?>rMDG8_2+P)6(NN;!d#7rHg*N` zw$NpBtPW@QfsBJIiE(pk)bsZxg@6m-a4a8^%p}?Mxor~r@J^P_2_>CO-f(<-Ap@fw zla${xm>v1Xex@pBuUoBBf~o>#&ZDy(Q0p<5?xn?QeEAa%-IY@`@n*L`wpu2!W}w_c?P=Er>c$W|x? zH#E5N3rv&1ZMMr`;H!iighSfnolYyQjGP3E=LY>oR_+S8Wb);dEu zIyg4sSe#d`vq&&oiSe@s^;~k|caEdaS|S3G2$b>c7G-iq#jiK_uO`wDnMzq7i(;Yg zbRNR>c(6FR!Yt8gyI?eYfjpxoemX-|g#e5(Nv?j23a+^@a5h zlu-(IM0mPoiSEA%ud$%KOw_*Yhkpx#7yP;4A{2EP zezXsH+wl<6N?@rLEqzk*?QQG%3UMpkVc>>I?}}5vhVC1fmh~>^0-C_YaY*zUM$j9w zAQWC7TL9)J2g9f!0(~CS7iQfVQ?M_mp#)tpYy;+2X{FbaAb&u+jHCo5)38{sS7WBGQnS<86!Z+Dr=Xcx=T0w=i8Bg=;wnKh+ zF~{D1#B{gxZ{3}D2e%YIWh(ZDm?3y~XzSgV=V{ly*h^b?@>{Lam+s5R3l%-07b2e0 zJUwWzHuW&GKn8YK8b2z)7@AX@Q0`x3&9t6+f@cvon7-c(%=}c;7x_j)W@q8oZklzc z;@(hfR%@p&d3JZk`0nz^k~MbcX!E?=rGL-gYIgZHvY(6C)a(RtS@1-`wdof1?)1xb zb+=H7SAu+}yQW6<%Jwq!n^$I4R$=eYSx@>AEL!ZnE0kKZ$1r1EW_|TeJaPX zBBb@4hOBim4lq_F4X5*`jx2{upmOUA!ee(B zc;-EMyf{mYg#I?~#;rKIL#Du*tGH`V=5qV`eD&(MY9wZ~x?p`^^O;M)-zm+YwtrIo z<%W*A(vkvA`pJbk%uN!H)8#Vnjpibwy{!3DdtWRZXdWy2-BzGy1GKc@^ZvM?HL0E{ zBj;1vnZ$DVtobE(6zSKUPx?!}!N)Rti$}TRMw;(}8N zOHPeBkPHYPudpB5!_SqZ<4>=*$A-Ih%9y?r)%GiF&Tiy!(7uktJpRfnSjw0RJNkup z?b3gGu$)g)RPn;8zUnx7Z-=`+A~m^eieu!y26gB8Rh)%^L{4f=7vfhf`OJecy*cLz z+7yBpB6WE6+J#@1-Qmj7d+pm`(s-h#<@%dq!5#3$RX!uE@K4z*E4Ys}H0@UKWpWRA z+{Aah&~0-smN9P5%_kPxulA^xjjEA}v{h!1Z>~EPm?GoNJla(Zp04ngA&)8=MIaB+VeFY^gqq>4iFt%Ut=!L{EM@pnH4{pCX?iMiHGqepme(iC+2GM>Bch}-cH$V zFLE|(s1hSY1+ValOVPhrKbj;_SuP@foY|K9rJ3_+P<*~SdU&7No@bZul{I_Jfv~*u%-oCgw;PdF=J`%W|3dx;m?bGZ%U`bwRv%jL7@A z)|cD|ED0_cg>|mjq*U;%QxwflEJA@TrimRAjq$@j3&2M%Q9eu@-Eu(U;PhR9OZv%8z^Q#03GeJTUAy$xm7XUL})VT)M_XAG^e zwv18Y+|x^TD9A5dD&YFfHOb4C&8P`Xs!<$Em|H)3wcA7J25w>N&zJc^Yl{7EMdf+#8VfE~|VF3@n<049+cF6W!d*)C<`q zkAJcnAvnTE=Bh0EzH9>HgEmZQ5f0}nsr1P9tF<)u#_Y{;eyq8mB_UgB;y>*=7Iyp14^m*6aKbre$ zrO=@-1boxf6PkXWjv=$g1ldmiv5M&vE;h13d!}1lJ}s4G<}Qt=Ga>0$ z0NHwDB4av|mwhAJMpJmko<$Z8N=GYnt}OUgp1cfr&Sd}KBBx26EWP5Yng0r$5@83T zc>me!_A<9ZS&QuPl3^=F=LK0O=h}CxV=?32%YiE*8uwajjuXr;4J=V|8@c8fd2{c{ zQgGX2HfU7Il%pfhw&_p1TBS=#^|j%vR!r>UJSH~%tiREnte7FxSEb$&QF{f1 zPrGzeGwiEUcXC9&sbQ#56D=OG_^Pb(lBM?8ay^m1nSEOJK%9~~dIwoFiP`Gn(c_Nx zt}Xsz6jWT=1UhS0NTjT|`fOR^3O!;Mg~!6)oP{wSB{N&wd^E&w@z9l2`K0PCXYz_r zXY05xMwg9Fn*r6htZgxvK?Rb*r1t|M4-#_)`I@fm6WK4H_IH9~26p~frmo}5lov02 zE9X~8ni|3)^7zQrJ zafD{4i)``~TN4WAk92REX#1!Qs~GPj1H5cE6(kP{J?GnzuJk13YAsMq!7`b5i3rmQ+-$?qfOy zn+6Ofwc4}_&+9~5VD}}iJC|%UFdo;n+=xgGJxVe-*&9R7Yn&clS2ORu4uii%zqR(P zFr9wq*>C;DBXWOrfjjWNRvRY4JUg-|cAB=DOjU64uKcT3^v%>%kJNK6)oxYYGn7-) zkGWze&rhVG<<-Gwp^vq=t%XDM<*t;F)Vis{sFXH7%f3waHE(3)q)y|pxiqtnq_k3` zXjB75hy5Y)l+f{ea?7wCfhXk(EkCTBE*5K+8h8*4X}pyVzNQS5RWu%w ze*FHF)s_D=z84px)2VAu8^LwS(X$y@{!D69#Ysbv-2Sbs`q?9QWs5-Xp(>3{qVk-+ zSIf2cen9V*U1ccZY2=ivfa1kI3gYhzy?Fz3d^hst)+FC};>+3phB`JFnWj^$%kMJ7&wecl&-<=qXOqukytpc43 zq9>`i#Cq>{{lmiss84hIS_vDNPn;SFsKO8gJOtN4QQ-3!;vt&5T62b4O>x6An&@r)?TzXD|1rDNeC(3qp#MQ4RQABr17M(A&@ej zw`~r+5;H8QE1XK~!Ct1Qdn~`2ubH?k7+I7r#Xe+oYWRdFKh|lBS?l z8@;y%)^PHNJ}cfm1I?GhMg- zdG`6X(4@JB)y-=RcR7j0NiNmpT=ZI{zgnSAG1PtX=7HT4$3ZXA3%7N_%RcK` zh_ifWs*m^=x++P-pdQrm_C@P{=1ktMZ`7XhIp6fJ#On*pwvu&4 zP?~mE5b2iY@%iD`5xXWm*7WZhzR5#c>?cdY7i;YGL#_(XGnNhMY;K=vb=x)321sc$ zWX5FnYg$(VDIW(fYLk$awrn?>IZv(WChXr>#ww;Rybe@nv!{P4TQ1P0{Uo=J0u3o8 z2`#ipvbr6q?=?OpXu=isQd{>$*)VdYd|~r{p=PmJ;2bg9iboo4Hu3iJ^-Co zcxUh49hYiu>3%h3a?Wd5Ho1O4NHN~n$#W%H()%GopezZNS*A~C_Qs-cp51EbK{Yu- zfsCd4t(K%xgz$KbLQymv5DUdJg$J>WUMdoJ~VEPi?IErn@((8DIr43LFv zc;-$JwgZKLU^kWrB>W^7w_FN6r`#trzi|0naYym=idqncEd>k3FVfo2Pc1TNtM?Sh zNT@jKMRkPx(`+O|_3f!XY{ZqOr~C-cyr`OtbEbrTAbZQzePXdtb1M9{EG34CzPdyt zzPjIpYwva+>?`x<=#g?UL<2@X`tXz#ig@^300lEPwt_&SY_t3x(ZVUtC;aJLkr6vH ztQ|OSz6-yHPYNB&>uvYXNm=R{Ai`*xMXr-Vo2aFnMHFHS4!?h zar5nIEANsu(1v3)I9wI-6-uhL6Fzz{Erc7MVGcI~^|9GX8G*_k*Ay;xx2Pkx&RmWP zN3t0mGNisqRA4n`C81Zv>Z|lozRKxYxpjM1KaM}EgdFR);^^vU5>YU8*q}R|LNP095H zT(g^AwG=K`9j7Q#@Y<)*_}Qo;s6fbQ6WDcQy5}NXHYfb9fC_6+gjSUk^;w{+IEBT zf94u1d43_H&6bt9B>d&c)HrHh<93O#-1&hE^w5Mr^N2Q2Ir5(K8~s5nf=pj)>;^;K z7P&O?&q{hrCMFz-)i#=G9}}&WFBTr zW|hXYFz7M14Ak3>VkVw_<_QZgeZd4)woaidDA#OM({-%iGe55zEP>EUIyvAvJw{GN zRk|`HBom;X&OIkrndppoGPS@t~K~D66H#N^D z`U}*MIgQdo#}XFdahG^opWm4Jn&F>-d|lwj#04*Yy|iaHa|V9rWY5ng1Vaay@69V) z1_^IFKu15O$sAQ@viS*mi^`=;#Ky514(8RjIt&|!65>07Ef}c2Ugf3#5+PiP3r0%=> z^@Es=?IB&7`x}HaJ(M6Knb6kBZ~>2Jp_T{|Ez}IA%ZMkbNG)@z(4EM{|hP=oMn0=;e#!OFkn;3{(7ntfLnyxu@Tiyr^%-Qv$VDSmD7JV*)tTkvp@-FCX zc%>F=c=-7Vx#eaxE4ZQx^;t%?d1t^*vczC_wKg@xhI*an7; z_g<+<`wQ$%Y`gkk3TZ*xKo$Mzw==*_=eopbe0 zU6Y7FFBPuZgBEqXUlPs@rq2Tn z<7b6dE}@V#z026NUsI_sbDBefLXB3))xyz9(g)@s={t~?C0r+@0~uuQRwp4WzjdZv zef1#}ims7HaJrjufBfJEnupewvXqbaK2ZX}!V7=?$i^}ce*d20y2cFrO3+`uto`Nd z8^OiR-Vz=*i@B5+SLpHnnfUlL;vidkz zN(vv5eSxV4^1IciL1U3PIY;1uhsKUlcjX}#gf9XA38FLc*TV1;DCr28sL|H<4FN`X zL$4~sM0#YKT1DZoLC)IJFW9G5Ifb`NnBKzCXk3yz_#nJzeK7(01=I*25`j^2{a?8{ ztzJLm3t2(39Qu8&16ZKg+H1x5INtIWlDN7Zh#EKBU}GY&H8f531pAZ>iAR+4c56+g z@3i&J{*Ve4V9{epVYy9`4GmOuOnyqIha|l3@q8V9hBCmARaleTWt8fZ{47yJhF+D8 zcUL;1ipi%KDTf}R*q+fTP*sP8Wzyii;a*5Wdm6c5hapjqvx7lsW}6wX8NP6K@o|$f zry9o=nwJJbr=g{P76((<9ibM+&X%{>$Us9Nsn3&+2J4E(KLOc4qUk>MjZpggL#Yap zq2Lh%3RJe~&pV<+tSC<10H>GHP0^+|hr@VYL1;$mivWkrBi>TmemYD*u4-#jOEeKL`lXg11xLmB?Wh%iLjesL}??H z=~MEC218oibsbCfdTBGLE%b_tADQPkD*Cw!0TnAB{j5$D7FmV!2qPYG3gaqH#p^n>m2T~iE;NTOjAIToBhPh0f*%S@S@Ht_$ ztC!t}neC3U9g0<4&drUfT)hWO^dPZuUv z2i*}GxU90A_JN>D$c7=RUE>CCA4#a2Uq+b|-0HG})6!=d3ghG_SrkjUJ5@ zubHubZFPxr8#O#)FJ~%uDOokV*;P7YO(|Jx8EW0Fc1W2|QfZm9taiPky8FGTr>a%- zb84a2^-evPTA7pD(C&X%;(v6pJ*PoW8O65C<+RdyuF@U5zc2V7iaYHkwX7!(Egc@7 z{$Y>OlIX{5^X}qTPOQSG%1+DvldWgw^0bSiZ>ifebGM9ha&Y)hwlQh>Dz(t#*PU+J z7dIFGCtKKh`#e(Uv8Oit-&{HWZuyGoox^pv|59P8O1jeM!}67j!qc!-Yw0|FYs-%0 zaov-|AorRIo$Ye$@ulPQnBsjw>DV|Ydpj52u8Taria`3GyRp|7 zLkVkYwsFxeEoJIE^^{-9Q-*fN{#`_Bx)pT-r^S%6o%Ea*)A9~AXZ{g=lEr0Q>a;_` zNZo_Pm`T&{u9|y++xE#rYT?0=UGXbBb+TpEL;U(*6`Z-JwKK=@@K`#! z47NUAsoq<$s{YC5?=1iSV0Ike^~&AljrRXBzq4jarSkvmbn)M1A?a`F_@|`&Z)le` zyZ-c+b$qYkt-)QF`smAtlmC0|+*huCQ+DRrytF3aT2AdSuKF%-|2MkuPZ^MT;PN!0 z(sEH=Ik9Y9eHYdLjfnn7dHA!k|0?4#Z8Gag?~0=I$EdgS4|)GTuIyc5+~;BIsgB&| zEUWHzcGS<3=m&pkpZ`V?Y|f6H<3DuCS{@~HHljw?BVm!wDW~1# z0Y>f9J*-s!J(XnD5EI+^vq+Y~nv;9eI(vnN%0q@ZPsIzfPah$?pl~|%O*!fJ&#`U= zauW4L?Td6YScwBj1b+M_(8^q%Y^y5A3i^g6Gak}(jJGlcj13*7e9s}B-@SHZi76@o zG=!T%&)(kH+Ih2mDx;pAj|e$lXYI?ck~`|ZFxm;~dmMY5SLt`Hr@ug3zc#@T{=R4G z5BD8fXZ?=|j$a_6zrqmQSL4JDzs?u?)8PFEC(CqdZL>@L4W49|`uFyV81MH}+1@wZ zeE&1|yYEy~v|IEZ|EGD!i;4Y7{||hSBogu8VE=z(|Ds5ON&dAYp2NI`{l7&0Vw?~F zI4Wy8%KWe1J3P&d|F7J?u%Leh{s+XaIA^qtlKRFUdlCM^c8L?cC;VOQKWchs&S3%o z_`|as=e`60;G5oA`>!6{J6^Bm9|h6gfz^N4Pxw~~2(mcI-y8I}-qDfow^`;50Quef zBOlf~gtc)lPD%Y*NeS_+NoPtgUAjSHEG{(*A~*sqg~;xL4!c-hbr={C{bk z-+Dar?>c@_@0+l;0f0aH>0iBHa6#jL&Ha1moiT5~A07Ee`p5TH+y8}X%u`Z&Z^$bp z{y!4_lZW??*L!dN`M>gUzH{vlJV&CuyrCSXv)OIkEnFA;n2~Q(=NhCy5sZygrrKx-Zu^cpQ0ww^9Myj1 z74f-@drD*BrGRxAnXwBj{b;^Xep+WW&}~pvci~ZuTBhf^)3BWwP&GY;q0B~~;T9V6 znub$4vQIeUNG>)RtjmZlEPFG>=yETd7cd52fpxTppYf4=sWdo#>gFc>rujir?n`N7 z5u54T@pp73^;e)z1cKyn@Y(4H1FFNHr-*tnKNp{AH>~cemo^7}yo_{tSjxTt;3T)L zWzZwUpO`*1y>+L}spyWH7VCq38V~QwE-fdUl`F&lz<14W3?%0yG4GVz8aJfiq|T0` z58P=QfcoAO#pVD2jyBM=<&njzMRRGrL*41JMcw~1TLA#7buDmmm}@$%b@GH53HqlA z%{~onqT6rIKK=E({(oqoei;~Vc|{3GU0BE>(ifj-3C-DrYK@mBqSBKZ{|VGqenmoP zg#)X;yczG}p#*|$yKE+x^a z{9q2hR7;$P)&&S^eWiiaq9TQ1qed*17&B3#RlX)dAf*H3@^!pk=xMt&0eXgMn&!oUK4f6#ct}p$*d1&ZI&@vq`YwC&1Zy zuAP0vOVsB)6wjJpSXei0mw!#n|_TKG|;dEjL!ZP9ZBsX4#_oh=6a0Wqi;#dMYXeL*Y>kxL6S@G};A z1_=ONm0seRgZH3fr1IF3z7LUZ3u3+0Wg_ZlFGo{tfRArhQ(q7|x5n!$UZB8_1X>4^ zY(PO>8SlIJf>q}Tko1T?Q4Z|*0BjRHOl*zVLFzP(1P~T7+HidXK%m3L2Yxl%q(C5m zFq5c#`=%Aiq_5*gGC$^Ur%+3qZIihD%6P?DZF!7KxLaj#K4y10J-Pr044l6^F12PJ zJTXdi35s-QFAKphxYx&zzK!JnU9OP-MZEqF0FkNG-;$5t$MY-Nk)z3`v1C|@vEJ0L zm1ZfG?|r^=0^9c{>FCfl@(OH(SJLu1uW=`fw1dQork20M;YC;?47pvi(S{2al>|^c zkz-fSH1W7srowYnEZ&3)0^bFC#Z4&f-~NE$29yXgPE+BSswk*lRn4?3Ty*o`-2 zG3$~!@p{*KQU#WXY9=L4(JxO7I$*iJiMXA@um`-u>}Nt#l--I^{tajL-)O zWj@MPE$tDHoy$dn_m;Q#$f%sth@ky5<+IJI&O!efis3p5Q^fi}mxgd=E0?w$Nl^Ou zCvBH+40_NGx~&_VaCIe9$+kPI^1C6W(f!srC%STKPX$-KnqD6; zNKvE2Q6u(G-z_lL`y>o`x(@&lH)jF>5vT8yXviOp2plDzK%t*aR3;t*of}k~bf2VC zQ8GoKDCZ_UmxuHT3@WmOdJ57~5TqIHL-f)0`sEs={e3I|@z|cAs3b$-6}ocW3iDge zQrM54K~7XIVIm|*Kf!mw6Q-`${IAfB|G1&*z{V2DiGYrH!%t$jyNFu&!=-anMg-fvVnQ28y5pHL4NoPp55 zlKze8b!`Rmiv!+Dc~@4vM@|r_@+Y>pyo(Y;lIXIu;gcs0`F5QF*j+sv!o-Iot(OO} zrX}X6N;icrAhrhblqoY*m2QI+9kdw_3l16@1~5)oPfYI_Y{G18d7vP3{G8Mi?h&P% z4#0qh%{&R0Q0^|`!h!du>80Y@)1va{Csxot3(e>JOd}mLNsbHMSF;0NK{%@E zD_k&s+^&V6d`9xb1&7zHt-LAuVlB%b17rX|3k$l68n|cR#Rzi`G%4R#W&B z5s0p^Kq3;-&3dz^{H4h!+eAYrcVNOQT`pNOtG9Y|XQ9NGK(;7-@av!e`x%5V>go7`HGfvyAPb2`;6Soqfg_X z0U0{cnpRl*x#oJN?%A@x_t~3*qof3hgG3mTm{~JB_=EbS1+K*oKQ<2?xhnbjH!+gm ztuNQ|pL%Vt!3%%%9vW&7`$OwPvk%Iu_8XOdY5i}iZ$JOlUcLB_0pfiGFe_=IQ%d+V zQG<0(1A}V#kCCB?E+hTQ8-Q@b004{t0L%aYYzF}3&j2if#6Lp+k_3RgEhq4OW-oc# zS>tZoKP^A-jOh{?9;~S!ip}3C35AnU)r)G4ByxBI+`&eU`xgs92h== zN=@OAue2;Y#$GIVQRX8MpWjeFty_%Rv3*WW8W#b1Rb1R ziSmdP2h%t-dAVYKTZiwC4+Uhv-rDMDyO1M477mUM&NFda19}c z(=IWKrjbUNMw%a?ef zRzEu`d++&QH~wzp&~Vv~NeO#6%={|^#E5{9lqv8DFm9MvlqRcD72Q{$aTTr2y?>ms za)e&+(jW_XD?kxOLw)$IuIY0X&3Acf`CDM#sh#(zKd$s&1t$53E;P>I&qNGqhXj$K zsz0Zo(EO(1?47T_1y;v)V1P}KVh}P zQ1M2a1TwdW3^()vqWS{XZW!;`660eo>XG*>2=Z5r4vMFU;xT0M6bGiQWuMQ^BFYA2 zaDBLi5Vl!0;vPNl3l92a^=*S>uMs3Q!_gd6&`&^3Fr^(js+C)t7qQ4ZQP+b9S8^@% z#+RI8oGuhXM3}n?wMT`|lMyYMPYXsWi+W~!FKy>v(xK2S>KosWaOU+^05e5Z<70{o z)`cv9CR2qX?BMwFu8Y5`mj?G*Q;UZ4yB3}Qt%6%k7Y;w))voKWmMDlg>YewWv@QR0 z7H*TrY?wqFj}Yl{XQ?0^kD2q2=^-DoXQtC#r10C zp3h3{-ky@Av#6cQ&u4zaog|nLSby~WZxSG%p#8NINc@Q|52vWVvGr5RO?kHtot}hj zGmlLFxUKJszb!O|a`grrv`%T3xf_RB83%RmHnP!h#MJrEA`NMfOkIiHm91Frt!_BY z$W4vlMJwKWOV6P!)8DrKg=v4JWb9895icLl$bSehvVQO)$n>*=0L*18rlAE1-faO5Mmud=sv{F@B$p(pXY|QCf2|E zWfu~q8$VwKEKc=zgOb5e-~V~DE(*P?>u$OX4(M2 z(w&x|CsD*PRj|Ggahq}}YZI@`IbA>QW|pxM@?nL@2aT5v=npd(Qae>EBp-+fnFx{p z_%Hy;<{&A1_sW0xKtdu$MJ24%EDG8&zv&EkKYCl0zuI<_zvcLT80|x7Hnhf#)nn^h z_4Arz7r{;1@`cAqx~|svhVQz3j*ceEg$>z*O2jQPILcORV^h)?;nwk0AxR_3WYve^ zGwjXn}1Pvm|WZ^lE05%lr94IIPT+^n)qjEzP3(|`WK=m%3V4H^vLwk z&+y=lL8>wok=+gYXc&1`iM`*?_-3FLNE;}0X2vv*A74>@lsc_L6Ah0w!XwJ9=K%Sp zgjCplfc#=)O9%VM4?mrx&zjeq`5voNI*4Fi9ZT=4aX$<8k#e-JrL-7?r%|xwP>2LS z@7&keXG4NgGnm%Md?FedY3FNw>c4qY(^`qud3+UNV$KlCW@!NJhiG$^&kgM$T?eDhW(x=ZB^8UP53a5XsT%)a$z z!`{==9-z$QoA^%fVUmL0k@LcdhTH{l_GA7vJ9ccFJ2TN~fdKV#_G~nvLHNQiX zY80kyle!5}KXPqnStA0fq;!TfhGJGEzk$c3YiH#cXXIneph8XMVpqKtrQUrJ0pgRt z1wjE53YpKQp575XFJa$Y)rLW zI%X_v9Xd)L^DYlxT#j$o;WY>nFb$0oln6hSpFl;!D^F6= zOvDTq4VFhE_bk$vLA5IQ55x37ohhEt6==M&l*sRyWv)|96qYscike4@zH8vPA$6<- z#n;Vh1>TMsJ-MwPWhf?o)XPvNX&|FZvnZ2^A~MAE%nu&vR18WLF%uBpy_p$iOy%_~ zYN<}WFuzOG7PhS%D(+{Z$8{yToDcn?axw;v*|bETh0gm-icXmY>Jsna5=Ow_ADpcq zCmH4Bse&_HC`w;87jR0<-F{H4VF~UnN=;M$ z*=hVlj1}!_G(|C2eDHKZS{sKjio;B}1_9oR=kO_!O_bjqltpdds;*j{I&DloVZOG@ zcc{N^W|UDf{tmXVjvKtQY$m`DUOCEQu2(E*BTK9#kl^zv*!B-wiZsJU!CnLQwDFl> z_JMDf4HsL%r_jXT6opj_lXG`D7B5GAO(HNeZPSQFqHrySN8ZG&NBnWD$CJG!MUo)X zdmtQNT|wf4Hhx-j&C55J!ZkD%x8*la!_Tf`NfqYxjh;c` ze%CyE@Ih2T?|MHLoOFMmL@&_jm|H6y{HG#S3#1dAmAG4g8p$nA z=8iTsoz)=93Z7j>fxPR~xFIKwg8u1TQDX>Z7*7h;)9h;0mr;W#v<*Zy^A(9=6)LMz zU20|C6+Ffml~FUv>N>x;L$){VY5fPO}<4EdIKKo#s#7*Em z3$R0MiaVvg^^LR`#r?DelRAY{t$xoxTPREN`j`hpXLY5(u)`p%rYHQqp*PM&T~R52 zs14NLu}RC#>w{I{s8OSf_%Z9)-n0V;%SvsMf;iix1}8@F^T7x zn_$U;>$p>@=lZ_-VCvg6Qa+88LLKq$iQe1QD`Ab>KxV(KNA$2l`FknQm)f3Cmv~)z zZdJcJc+}bu-VSGX5O|OXZHR815q1a%LCQjDI?4D7x)GtiPv=$WJ#&U5*@^d0U~6wGFlmaHm5VN?U+3qV1i4aKe>6VxHF~jFC9tT%@O(h>#--z(9(pA?ONSJ%SP@$7 zYgy78to@PmwgQg8rM`hY?kR!`r1rm$(~DXBmAZ?pL;n^TRh5%=Q5K@=x{}`a(Ve0 z6CL+PJ$D`?NJUVItP!N1PM6;j+ILjNq0M{73C!SIBX<*F2NLd3$R%3bqyejL23@0L zn!+d;P7|O=&Y~HvaIFLmg(wWwiLGTAbh1V2r!A%j3}s)qZR6d=L+0T>kkh@pN-I9! z%(bU1!cvg4?VV>^M=idxAePuiGsDnb(*4pg)5p@pU_U4A@1Y{3GtRgDO)#AN$#CX} zPcX+dFIc9wEu8eHv$nogM_6fFXyCeMihW=2>`J>6;2$rZvq`RY9xGEYsc9gTWB>a`z);L zXqsQK3=Q!POnl0Wi3(keNgHj#XT;=m=0P!b{j%iX*6S z`%r-}A&B+sV}VWxsbO?=DsSJr9A3Av{bQ(7Z)6CY#!m9-Is0fD9dsG;`@{gbUdLnI z()Q~q{){eZsi3+9SW$mG+DHCd#;?4)c@}aG=>0_Ql^T%9)L4v{WiLOpAn1{uVB{4* z$W7Pw%~DzMs9QS4idr~+zS-pmFRE=}sCxN*LOOF(o?#x2ZJQ;iwY1^H`8*Eg#&OC) zbv-}j|5lP)gl_1ncinlLv%D1>Kr~n35+nQd^*bx7Z>fdrbCFeXcz|Sf6(#&P17Rx= zDJ=iekG+s+clCpKJcrP!THdRN_bp(BidX(!-QmyL1hKA&NxdqH%{`u=Tx^khslAsK zINP>8m%_$II8O(GoLP*YkEv7^74PPYv3yv<>F`c$CR*>{CU@NAwM%RR8X)JVDBh1u zC#NM}ZGew2#}D5Zn1w)7QQk6Z&WJnYVl|EuM?fLq-4_A@MQ5l|n%vfEWHZEfK_{OP z^05L5-SX$8WfEuV7ZyIQ`^MIMWk~F_l0*@;Jtv|48n02&^%}w=j-)m5a5*+o_SKK8 z*>xl7yTkJ=*~Vk8I5}$_zc%)>?nU=Bm~QdmxZ7*NT3L zXtG{A`7r&XR9=%>eW&0)+7p}F21qaC}4MI?m%pI zDXTxxJ}0!@4zpib?@VAN`t*MGZ{NrWglyvlodh23VzyZo$g)vzuPm&Y)-X*+-T~U# z8T0@TN)cHz?9w~pq`+GbQnKO@0i%wi6>_hBY8db8iE9td0#}Z^SPO1oeSH zt2tab$oK~HDmmh_K-d9PM}<*d_p~HNpS^ev$in1}xDgtM@E3wFc2D1PPI}uBj|PXu zpF62H1uewN>!0I&NwKI65=(h5mwg6<@foTNCYejyhlHei5*7K);YL zg2x2h2gRKbq6LM;C|azNrZV*j9Z%`Fk&+S9(Jb6dS=3NBxuVpngbY6SFKx$&o3I!I z4;xSJG2UvYd&HNpFi&)!vVzvLezY1xW*c_IXU%dK|2W-#3dFo1z9=&BxRu7A96vfkfMK;e%KHt z&dr;~uivhu5<%}+I(i6qPqz1KV&PV_`4aM-rdrhQZej{-Es-!B;q+dlzE5@W74GHS zj0n4WLzJzV`eMk`aLQ2C%5kbWK0%}9R~KfW0CRkkqd9mEv3MPSr4cet&AX*WxypHsp3*&4d; zT8m-5;1EO?GdCU-`3cmecMsW(z}sJIU@(HT&OH>hp2wThPEjf2;B4hnXM)0EWUY$Y zJNKI@1}Qa=Cm&3fjcQA8}{Pg->I)*S%0%cOaydX*IwRE^U84R|9I(2l0IUFbv zX`EKqzJ}%5VbcFxoodC1fodDZ-v^5DFa$(X6%L!3XjMs6yYoYH)h}b0?!#-z-T2AC z)mpeh4DeAEmP4MfG3X*P1FuccF8D#}9*(^Jv}t36!sd7UT=b1$k#7%!3DfkAYj-jo ztvx@Y(K8T%TYtpU^rIttk?DlbQnp~Pk8Ngv#&~Mb6?S`wxY$U83OxC)FV$w1X*-@X zfQ$q@lSV4GB@VPJlZW!&6vZ}otyhX!1E0QGZ+H!}5$Q+L@$5ZI^7Hd)wXhu}p;7uk zyIqh5Y+k2gIWAhpd{W`v=Z^VN4gQ91wTdmTB^=uU(u9Z?h6bJPRkg-`a)RSpKKZm8 zLylmSnoy#ripkiiK!(7iWua|0?@TfzIg;@}jltDvld(W-KEMi9iv9&6t1Pu6p0zSX zdtsF)U{GqmklW7r2zw5a@u^pg&!xUR0Y}4Qv3}@Er$E_g7c!ca$Vm^gj_`JRR(VA@ z5vWCtDfY;Ds37lBF4BYUF;MZCRlF>Q&L04W9*_bx7v&&?)uFUV_{anFJ@#<3bt$Cr z3LmtnU6CDHG6&Ph0*#c&wnxfC3>=wMDNm?^H&YMv?8V2H5mpHp?k>o!(|^8b=Uaa5 z`+7#?K!6uHf9efP?>T;8G8x*FnjI*#HhSNN44nx>11hm$2} zsfJ-KwVABjH52hulJf(zESB0-EP?-YnmbIk(@$v$C-x~sg=13y1php2LHxdc<4<#W8P4b2a!J$#CRcaMs~ zLBUV!=1Y$?+ehEUoFJ1UH;V~@WG>)A1~bW(-nX-mDu;YA_;%zP!knC-ksX+^c?gb3 z^D_nOLe>cKYXtLH!6|rafYY`B(dhBlvXW~gY*Y{Q%3-y}1)DS!P;S5KCJ?5Hg7jpU zJ?}azVBp7F9AJD?dER~PjJdpFOcSJ*Leu3(w~S61A!1#X;#fUse2}lDdyVYMLXY8x zVv=V&PtA$Yz{LW}3CjWnT@*587hzF(HX6lZ%}=la%Wy`P$LusLB(iy-93bnaej=Cb zLaJEKl0VKLd*3X+)#%=oYmrQNe0bN9osKaE#uya-6 zdo6M4(kWQ6*ib~IZ6wXWn?iWJPX@LgTI9D zn>Q~2BA40+A=Z2Lb05arzXBJ!Uw72+yWIrQ7!BR=6E^s2GJ51s32DEk#S6UxQWPTg7P^j3&Co`21i)#}U3Ib= z-{0AySF|~lip8a4WCUkOJ@i>wK9RXPOoIKohOhp)t4J! zf6Ov__;y-6`p8G3m>>NlD-#(krIGRigS^JpBgp0VpAuCs>Xo-rh|-EycsWGR5A+1Ujzhyy)r)V`vj3SL@qUg=GME;7(g>+vlxaIU6+ zX6z-sD)sGf|1|Pxa+c{IN;BVDM?gi6pJXz@yFh~e8Tym2dnS|y8$Y_)Xt6cRB)I<| zvxuAZKK4?p?1M7)=TJa7?ljj&GNHF!(2KwXoO7M4sP-`L!6hYQ;qxc0w1-n)RVWMP z8tUN^STX{sDKrwb+76*!`(_L?v%{mcTko9p+vVp|W-hv|&_N1QC77{GYmD#*C~ftC z35Ks>Q`;4`igRl)TvJnW{0IXP4ByJjcYWBH>*>_!_oja?kM~PmT~x>s+h7D7UAs$2 zxqyUwY59+aCs_K^K{&tlmwfHl1?HkvSTxf<>Gzu5G52_tFLZxvFUd5?>29&MCMN&+ z0Y_he?9ec@i9TvUa&m|Np1y|bZU@!?5%?rOh_AcUENXGllBwI?1|DLp6Eh<|y%N=c zu3$Q{MGmNO`#$xYFU!dj(UnZ+W;IRbIMwqTFTt1{JF^jJ(bJv+!K=v)`$T_die{wk zK8N6O7^=G+zV^DgaI?LF2=SNnL8G5JdbjwRs&XJO9fcq;XJU-Y<_t?}@XYFGj>uPq zW^q^LW7~J$v1}7INqONt*j!<}ukE{|N9vUz37&;3n0+t^H{4wnn*edwX;(DAlaZC%>!oV23&xNU zV~i$G)w7p}!jrFq4+#e3>aJ~76AyX=A>O^D^M`JIt=tt8Pr-`@?<;yuaGdni<;6FJ zrps45n3j&VP+H4aj)+T{Z13!#rQ3&w69FMF93;oOHP+EUc~TFvOCiRONWv9r8TYN6 zNfZoG{6*`>Vl6-@*ip~~Q;TDtYNG@K0zPQ?aCWwb?6ImxLc{5%kY)I%&F!?pBjYj zi^OP{x#BfGy+7Hn*?R)5vv7EkO7q%4yJBv2T1FD1;(90)Y2uJaNVIRO6gBQy+YohR zXh>p2*Ln&W^$3~Uvb9Y&?k&$hi!A>by0FG64t=NbrPM~wewG@6Zi?K@S_?+zyrcMe zlbVE;HuNZgoSN-a4y7{$4wT~%0s$M+Xdr_AJeQHylI=;hFMz#I5PnowCM|~F1r7tq zu=&waKRun*R4AveXxMH-L$mTI)Wk)8J;No3g3>dQ`< z-Nf~44PE3{$Tvy0sqB)+W^=I@ss|Fo1%IL5vuw9qwwyXu{0@n%r|v$H z`u86eVVToh!teX4NBU3lgq^T0yn-Tn?y8Wg-Un88(dXhC7d*nXb#Ri@k0NA+$m+{z zt545J=(v(8o|7UZ+*>70R38#*&)yHfUUNP6#ODqa=i@WPqTJAMbKD@-78lnXrZ9&? z-2yTsZbrzs+>4V2M`$!)PJ4PHF-L7{*XFf(%#vDam9qm_IzX8D z_?XY|q=X;c{N!u2MNCk!=6S^5z)30fs3y-0F0>BXwSVxX>uy}tQ|KnC9qD(7x`MtD ziN#YLXrxN~6jnOwRytd86PRkJwvTksPcp<0M;RJEl!vtx(;_vIE{S7rJEybJO?{){ z9DNwDxH#xd;tt6ND!R+n8^76~)0(~;l$ARV-nkhE>%tPNb)`I;Wnq$s3FXGQ@-iug zx3jJOIZEB~yktA!xIdQbqjjg;`0*KUgvpBommC8X-ItTM33x<9L1$>Ol!)z7R?nHQ zxP0tQQ#cD|kt)1BhI+7Jsm|$Ngb=FfRSZh}*+faKRTtrvgFjEV!y#9dTd!XCgsu83 zi>)JWotn8g@qSo0ee0>92l%Ivkntd2bse+=uUns%6}4C(;qque;>?lNECJ8!YZ znk*sXgVSEJmLVjM;@v;&{CWB@HTioC!@5d>Q2d=JE8uWYry~mIqOia}Dr{C;*RKlpJd>8Y8_d4Tsu{S*7jMfalet8o05gCdy0kx>8& z)P6U&QOuFxDIWZV@h42LWO(QR*j?1;kQjscoR;}lY8s`;YUrPi3h%phG5ez`f#Se% zHb%A#f~Dk;nZm^2kU;bC%jVz^2i_cUKvKdIS=~TGy27PI` z0syo7m&R(jcTgRE&KgonwkLm`_OE*3nUKEZGLLHpa?&p>+4#X2=WAr;C{m&nzLoJ= z)K@^8JmZ}BrIop|q1^#3Et7G>tTNmqK0H~uk#j)DhRuuqT#N_;fVSZx5kRk}56&Wo zTZ#?@AMK@9|G4?62%do%qrPdKH(_D7#YTJnY#A@BLXh8GxI85@USQE* zP#Yx2C210S#oTit!|{YLT2Wo!v{Ib8Cr*YFuou&Pe-9KD z;D2;n6UI@M+rw4YYt4Ajcm<~5SNq7#smWsbR+HV{JTv$;$}l;N75#ck%5qRF3j48d zb&_bueu5#*L-d9yo@*^vf&0xKI@1%TY3rUVivUS*4X`dT`02I~o`VP!rOA%d<{Dfe z6V6kbUV1L7x+YrgIpKS&gQcFu@pzXp>$)(RWJvK_e!>&1bjmJNG&xLpoE zvOlsb3OmL?I@~}DEf~N&>Rmft@3p6NfjrI8YEo*H7I&q@5W|R!DsMgQ%Glb?gAAxO zV)?=N#p=E}?1x~E2(ueOL+(v3$Jjd+d*@VglXjy{PT6stT7hpcAgNjkRmmq{>+h2x zQ_QeITQ@%f5a0{e!Kr_0rB*E|)__lQK4P^%CQ`h3@AQ5e0?-Rlr|U?>f^F_QWL^e4 z^P&x@ELzzHy-I8%sZcIa9y;-@=V2rHpRCPZ*p1gR%9Uve?^aZEZ&H!#L^Z>EQ#Ze+ z3ertG9#)m8`BU#MU7ZJT&rm(`KUXLiqB#&=7jd6xTb78Wh3!u>iexW71^rCT__%Zp z^kA=cJ?Y5+52VY;QFH$Y(kq42-UvvwCh}{N3%N$*^t0e9EC8|7vOD9&XTfV{G@F=1 znKN}a6+~frM^g9xV2#pOEg58SqC!Q03)mNRJ@8H)w~R)cSXfXxW+zr*hUQTt-VOBiojn>4wHIm5ZadfLf{ zU}_JNdX)Wn<9qbCoqMH1n^AyXVw*DQ!zm5wDyq^dRbl-u5&Y}GNj@s^V zGtr@iU3>-^xyX{a;|BRQEnrNhRN|v;$9(UqbD{wpkp<-X5JfUPEn7swIwPj_tzK|q z3$TQNUHXqAOoQ;XP%?b1ICVZ{ZF)mDmg0z^Ig?|a<&U|&pw|?bjjW=C>KVD87)pi< zX&(wO=z=d7I0LkoW~0bB_)kj$Sh&vlm$}b*Mzwt57BP2@u(*QlScd4rx#T;w+GrKrZ2?q6X+Zb>^ea%8 z0P4{!A$@A3DkX5tnyAgPP2d(J1~SaspkxyLgV=!Rp%9aH13SI#+-n2K@s%d|s;%yc zB*>R%>UZ?}1mwvg^Fr|JIjm1SkUTc`Pdit0kjn>S4Ryt}mBb!i{a6k04QBj7GsjUc zZ?mbeTCZ@&yXCPw%|63tZ`|^Thtr8NCE93-5awR(ujS_4x z!QTeBU2A^~2d%C}?afJ!KQ7+bOKZ%35Bj|Kv@14RC4I#Bz%Y0kWqFrSFY;-QC)-IQ z%%sAdp#xI0wzWIlq1_Qus??p&1e+#8hbO&VB7MM-J*nmfiO(D@b-bc*_R(5f#+B%i-TZiHbfK9kch$YN1$33ni9FdB+GOyt_>QvN7Ni{- z>OjOlnOR35!95H!5OAJ~rrO^&R-9~oeM-#wr4Ii)<0!MQG&lq&N}u#BGqEYrnMY+T zH&V7!-%#n|Yd~~U`6@jeS>ZIS`5u*}2>dz6o3Jm{=FxKr(d~S@V@LiYk|0+JA`7la zMoaJcp{ueGBxb`2y&FOTrN^hqUeZARaLYz}K;QP08lnS%`jcO>bSzd3U?` zVnz^6rSg|q>WH~Rx?=Vuwe`E_yQvruxZ6PUF7{_AXHuky+-Imf}Ne&<;-k#~_I5uwDUwKD!;|bnK(H z%{`$MfEt@_OI28RNTahyM-MjNqRXlr+}}2I16r9vzRPbwR6?2npkSu1FGjfQsA_Y!=R1>(chn*UA97IBI}E= z?D1`W5DPW9PAJS6r z?HH|B>}vMzf7E*B_RYl1-ORNi&j^mv{0)r#&D zUa75fSiQJe91cEZF-&eznvokkkQ{3>V$18oT87##B248o$ZQ=(th-39AvYyOxyn|* z>AN=KS<^lR@rBpmX*rOsmu(&YUItn;tkqz6WVcsg*U6$J)rA4Y=HMbkMU*OpP=;a| zZd*K2-=7OcI=V+biiS?}b`ck&FX$-N;75u%;0lKW9Cqu&nqYbZ{W9%6%(zq!r zR`OxoD(*V90!76u$C@NqcW{B47h8FfHFxe%!49^KIC}OeXG_Wz=K^X78+BBtQqLa< z&M!{8_*dHfB*CAadRDXxP}QqoR(ws4Q&FO@Hg3ChIq2V4@jpz+RJ#36FPz3WKkCV_ z!67S*8E0D@eA@mBdvWBF6@>_zi5M$o)Ur`IWiIRyo;?{v2$coT*#^1+;Uo|yHH=yF zP{m2HKkWPd|BivXXq0p!EL3@DZ5o#&sjWRT%ysBV*vT#?%AFX3G56N-QUcuI`%4Uk zAyu-vM}{2vfxeM**>=c?!LF&zc#bHgGVlJ>-Lfy@g%2P1$g`@D`O2dF1Fyc%84wML zBaN=D0U}%eqV^rao8UT?mI)_$>2s{Fn*E9Dw1%r5Pghr9IEmb6G5AuzIX@xV74C;soxd=JDgyQtdL=_d*S;}pJ6qRtZaSs#DySy(DaEaF!cAtJ} zv1b}j3hv#xX0sp$il7ix#u@|(P9hW-E%TxVqaXrpL^;}d-Zxb9w&k`PCX%Hiy5-Nn zMWS1ie@2-}^iUTR047Y*?hX&sn0qWYtA!7u+yX#Bz0)X*Gd)*hgEOfTuYodepW$EH z%XYfn-EehMwL52K93Qd2Isb8#74;!&;}hm(6AdTM(Cc>+;QR--DPRJB307Bo^=^n5 z11YX^2=HmmpEY)5{M{d|k@Qc5-B|B8GuT0f7pVgM)L=`Ogbov~Ryd<`Md+EoK{kDt zSRE)Ag>YkII5vNc;8N4G&gidEwTdZmHI|ze>er~C?CihpW<9vd|9QSl?7{AqIhF={ z;InGneQww+h*!6ghCwLGzD70u;o<>ls9KbSp%@r8XanU9$5eY^9=mQFUt6{`h;E6m z?^C`km|ns!Ebavj^Zh)}XFsJ$fxy?XE|`D`68=gY|VuOC(~ zMA~hsd03&=wMcmwb1t3_*rv(zw~ooXTF*_$qHMoFCk#71(k-|tZfv}Hr3i1lLS5Xq zg)UcJ%Q0kgH0G_`^InwNt0qJ8&LHp2XWB=xV>Lz5h%EHDfi(JqjD|Q)f=EW6bMjKV z-kfM{N>x@*I}gMw_2NQgD5TTx<^|=d>bzj-j1g&Pmxk(qIV z*nB3hpmTn>z;+#l1Qp{96ja+g^6|?gc${`li#M=7h}&^>Z4gU}&4Fktf9NiScvtNp z>i&`_SJoM^6P0=-5z@AiVgbzabNL(DY@IzfO)-;>=EXYL6X@EHp^P-%<6-eVM1pFQ z>lxvRZl=&?78}$Li6@e&?t|6&L=uPAU1IIKn#e}s%3NX)r0yQ$b^*sqYP))r0@fd9MrRDYullUWOU8-an!k#RcZv*H09l3=ctVHlSWH z;1ultShYapK%TjQjC9b(J)8|}F>2@bvHRi|6z}ZT;r-K>xLyD^s-3jUh4^Rd+4oi39P7wT9@2 zA5eiA2Bbo4a1NgjgPsqX9U=VuI1y2?2F46JeL0A?LP~h?E#O=a0|(rvsX+;8?phG$ z4Vou|^nW*@{SFjjILo9pM!s+&9|j?g{J?k!ydSqE>toWWy&cl|jz~%EM`qmot6UPz zc@AJQ$U#UGddwZ;**o&vg}GyW>Au_$9PvNlzR<6%==b7VZL#U!QJ6hF!!%5eRW;}e zMlxH+CbWwA^FT2q^&9y!QD9)to&Z0XZ@@4MP-VA{5ZXVYjEc(5x?hBhL778_??0-9X-!;>_Eis0XD86tT0Gk5&X7ZF!+xn{^{`5~XG06Qa|krI+MI#&be z*tJ6eNJUqkPTleGI+^W%peGG}05R}$CQu3Ev@``8+(xidP)z@dC5EogP=;%~S=RwFXOx z%>Iv7i)ggVe~dtZTF|iB2{hQrG{^lqo->gz| z2AfNJkB@fHdv3>qt92dC0wFDr6aHo4!H&Ga6Fs>R9vKWC{>B>-8AR?s?9P5{iy1!I z+fd2FT0v!lX^2QbPB@2+d+tPH1YYkPJokE=hU(}_oP1vw!!o}%qq0-$I`i#24<;7 zlH-Bs{&S`!QC-cC_a%6Sx02hn9`#=)+Lu$V$No-H^f<8wbv6pCt;6)?M>ji9$X7Lo zgS!{^$A0Em5Bdyg@RYHx`0sfS^C(sKi8pVeXT-Zr9AGgye!ipx$vh|4cF2&4ZJvo5 zMfqEwX4QK=Da|Hjcu_PFiP@u{>|wrwA-GU|CI^b^dhG^M0rNAR-f*!Jm^Pajtz=ng zqFP&w_5Hm`?MSQN=QH4KeE+ix$)hB4j4jS&LU;EMf!>;Ny)64-p)>+T%NQr~*<4o( zZ-Jp;Y`2;1lpKll$Dz-pzyPZP!gB|uxhx5`O}uUXUt^ap+_pdM7{P$|xnpGl-@zW~ zq-X7TJV|s*V7SVTC{3H zk?wX#*c?srOyh1%;vyQ}(sJ;C{5dXwdcH52VE92n$yH0s(KKc*G~YNfJ#637FRVI* XQ|HGb=&my(|BJaIoG3_Yj5Cvfih0k! literal 37855 zcmdS9WmsIx5;i(WkOY_D8k_(@f_rdxcL~AW-62?T_uv-X9fG^N>)%s5O0M8JAJ{Wn^T)1uLK58E9DKt*Vp z=b{uYP*o?Z3ylH*Sk;*VuPHM=s<#22iMb*6X5ouBqZNQd(oVC1SIWU! z=IDrj_W4mL`NV36_uo*m&}F`rB)vu#6{M6y3l{h)N}SIxNBk|S5DB&zU64vCHdbyr zvpgsVoKhiJunOBuSCUb+3NrFFwusLc25bNTMh7{U7yemZ7~sq37s^$5DDTLO2?jlZ6Ba|Qkt|K7?t^)vL>e2zgW-#a(^mzrK3WZ@p=Itv|k(|m_kOjb2 zb7oJ@zZ(Sze+NvwlYnF}_RdJckrW~d&HzA#`XaR@Vl%jel7+#;p-M;u@cB)QLBY6$ z0YUJlpgj(i_Q>a&ys+JgHm^OxZ#4(ggtj{bk@kK-#oLSQKSeKlj+Y7H*cHH5EK3_gq{wFIykQFwOqgvpR)T=9g zVo|i&?oUP-biH?l$u)S6$r=H+T(;N;jpj2Jrg0keF50RzOV!(tvBKdq?x4^SjJPMd zH1$P;v-?gKqkbn&w)@iT0k(}6RS)xxdk)@m(JKfFg;=)p!+zAr&AsFV1d-WTv2GZY zbnaM`uHD&*Y?T5n&NC7*aHvgHq#rlikYwB)VK}}h^wBCm6Nw>WS7jOTC4#-z{Ps1X z-w1D8H{AAdCQUH8_y+3n`4^eZLhQ$Lh`;dOK56>s|a?ErbVP3p^cOG zqiPu2N#iBsQ-yRCD`sto1s5rQ=jO&P>!LoP=^S1_5=*MMXutGT)?B56xMOMoO_r9q zwBq&K8~$~5Svt~ERuaKlN}abbGZCL6eboJEh>Vr?>@ol=YSoJBO8F26^B}4WB5|d{ zAg;L+X4B<~O>1WX^$SP1_reJ$Us`c!Y^tdN0AxTt$yZ3IgS=xREZ6W&gryMA`K4{r zA_fP2eTMwG__EQ5lAgjJ7{7oXl&NmV|4oqIvLaUD4Plrq%VgnK zB3nehH}>TS!!Wt;!DQ(K9r3^$1nt+}E&)w440I^8`2;Q1+S|%yU`?j@KI!<>)$9_- znZ4adPh=BYZgl@5$nb-Kh2kp)F`5sc4hhXz4LnR0?& zKQ48G)1^CVfi%f|YX-EM+P8c}+F@1&LqRwI>yZe6Wu~WR6*b=thYw!((P6G-D zvaX13E^m4wt8OdI5-u&{l4OXF$GM^X#a?Tt05orY*s>;K_Z-E)v>tBWMao7Ei&=A5|;g|JQhN0a6*Xk(1NVY zNH17o@D51MyOVP^cLX}^>uRX@qBd6P`+F^I-=$ryJU69*jCxXJHXQ0;2e-b<$2Wce z8a^+WgsZ?t2yk@LAi}I*+d|Ts0?LNLy>=vcegd!ZMh$gNsN7-S3T;w?FCweXzHvgV z4cAy;IPHqGPz-Mgt^+wsEWjqNc!Ho77qx^0xb;&Dt$Hfz!AY@RnMR(BillK;reA<~czaRX81Vrib1@v!A5N-! z-p>v0>g}mvx%CB3eJ)eIvkbB6OMh@W>7ATph(rbqQ?PSjRF-C56me+@OxslX1f#Bv zsmoVvie$O$V%C10SWju|!SyR#7ipN%Z`5B7Cf1VwEypk1Xk450m}iI;-7~cCnix_*01y@J+_}mKw!-w`V)vti$<-$XAQbA;K3h!6 z^<}K3&#inyArRC=ObwNh(QyC)ka0f94)auyPvF`7xn_fdAw8&R?x1%Gb z*^sMWS5BFlmYTpcdGaOH>T(wRI(#F~u0UVsFpLgN~$_Wkvv#nsS7up40ceODR!L3hrfdMjj+q_*}hkeYs z?QFI~#)+KUjO$ob;Oz(ZqB$;duV~X9;U`+-i`+gKe9U_A4zh*=!_@;1q@}?uMF+If zi2E$aV3NcI9J$t#er3@RJ z9Jzl?JfsTZ&lo+S1^*dE6LqnNxY0lygy^1q%yo3ES6i?3hyleCyhxDz=?L`N?MvH< z0|`x^1-}_j>l~cT2#)cYPI*Zd)V{r#eHh6eYug3Pc!kV5foAe?Y?!>4Co|UJ2N1HG z*|=_W0`q<*zGB4d3Csjm1KqmNJinv!O%Gc#8K13W1F^WZ%N{g7+cmd;VTzd@ryIRJ z9HSOW-XTifjU+_?QhTwEzm#cn#xvNsHjA+thpKETaj7)0o{ z7+FOfM>=h&%ZJQow`@A}2=aZ>K>AJCQCwj7$`V-B4XKDj@mh~$IUDXZRcSIw?QCk3L@%&S zf_msPgZFnx`pbgl#i5KxoJ=U=(dxqr%~*# zZHQF@gnPiHW7H(@XSDY`H@ro*Hp`+c$dD0QqLn(Fa$qiIdyGpJJsdk~=x6_8uyyE= zxM-I8$vZ4I$Nh7_Da31*x(3cZXqIW2DU*V(J3Bhw6}u|%0=W2q9TFgV}G)} zaBQ*|F#pafBB93f=;u{8CVtA9pm)`}ou%a1g&~=6H$Q;yfU#;;wZ?js)QG{iF>{#D z`?S(3#SdK^ec8P%di+_6!vJ0v7S&^WS1tBI5)#Pz-lVy<5*z9?^UUss^U?Lz;L@=t zf_`*iZC+q+Tg+30Al_648_5p|92%AnEz@I|0b=4x-Jc4hYgfM!iM`cRU@l6i$H6( z{FFtfy1aJ;%jq3~k&wLtKZDoHnJFM2Qs)wx;kNdy7PD_Q<|Em9bq3vxG30D6xT}~8 zAcdVXMd)E#hA#Q|^EHF4aZY03HDlO_VK3g@+C+mY*n52`h2fKSRGS&@U4XCTuj9n1N2KDW zqQ7phZA9c_!ZK4^zjhLXNX)k9UoqjBL^E&-O4%x2mu5X7vr?*&u8t@qAV=__e2nWP zw`?n_>2yz4bB=WCPhR$jAALNrJz=X4MnuictHixH;yFrJ_H0)8Xgfl7Ont>;EEcyh z)%FCl7zC@i2Z8{v-r zc~g-TqMPSK|7^Y&f~Udu8}#$eM8qkI*GNfab6t+4Svy$glF+c>HAe<)_`aD1gClI` zlr>vcz;VuEweJnX5Jd!KxeRAPrA+aXRN%zBy z7tAJF=aT!`&|S1mgPg*83SZI$r)Tbh)=MSnZ*viXV~OoJju7&?2_VL7?t||!P&+QM zKWbjbp0e!s&Yv8)i;~Ydn24QYaIE%VkMzrTrq# zLAgSD7%%QU|=4%Mht}2Tzgj=Es!#~E=p-F_y=Bf>v;gkN094u`$-Ob zfTDb)<`Ya{QOELE3SN=@lN}D0+3mR>J(dfAEYBTWAL(4MpCBGSWVo4a_N=GMNvqiaMONghcQMNtkjJ1c zn~VJ9uP8lI*2A8E{4UcwvXA;;XQPkLl^GAnZbaZq2ZfFz6Rl#4`fK9^AACv(MASx0 zu36=95A^m>jhP~m$k7R4r9J2Cqho3>!j4ac+-+6GM&G$x-W~s#b@O+*7tqziM&qBFo`>_2vf=TK}+4QE z6bxH(Zz04B{E!Y~F82m$JYJ)9DzieDX?|@?`08|WyMEtb`>N9C%!{M>go&S^7Gc4cO-9 z*sfbrA5oLT>1him1fkYrqYU`x5r>JL3AIpf=3W)oJk0|}6C-%)q?Dt`r(^#I9Mz{h zr{?W+_w0}Ea>=1VO?6gQN{3UW)Qxb3yj-t`bZ*$0 zH+*ue{g`k zld_t;iN2{#86;~*{ci2O#&7guoyRM)b8yf6LP>l*kXnZIQ_cC zC&mQX-fndXbp(UuE$#mP$UjS$l8zY7e$8*LMlrFyik?xIp9UN4z$?U?k-RzI4LcQK z0z9wsn+eZq}Mt(6-9IgyG`I}miM7^pG`X}(ud-43)wk;dEK zj5^Liw>OU}yPMC=@QS^CgIG$wEbK-(cI*h*wl+X6PmGczxEE*h$=vmoKhRzUQ1zg} zIR1v5{~JhBdkg!D?4j{)CHSLZ^n`ciM58^laCanG2xl!f-;7m;?@%b$o(RH4wvV!?U;(+qub7> zAl^oJkRwzFbs&t#t`NRalt(_NNXyd)3PYJ3D(V)dLt%5_bGI^WIu6f|A1+IRwt51) zPbwS|1XGF8`3D|Y9mOp@o+cLR{J*S^Gd+D{X0c-7YbJ_DG<*=uMLI;{Z8Z=c`wn1> zmM}q~l**yJ*`+Ob*dpkPkKxQhO>BxsG)a18oC#KffU?lGO3MlRqv=+%SMi-p%@VQv zd%$ePu|z>m&S=-NJFMf)vNkz#76k7P$s1lf;``R!lum{+0#nK*Q}NMOjMvoq<89*n zwu|U~#&Vt>YTDGvID05jeQd?IY7z!CT(t*P6q%}JaVhq^g`8fyZ1NfK`xF$eypo&J zLCO3HP7qidW3^QQRlW#J*0Z5q&^eJZW?*-XKcaXjIAMi@9*m&A1~n0xZ8re~x^%$M z=)E9igaF{wUnGwQX3_L@lM`?+#1}yr>`F)94-?aZYQzni;YsR?JM9#3G;o^5Oi4+oh%UzfW64 z**H2{3GIc~synhsk^x`t?IA4^fcCYvcHbR&qcT)28@ z4Su<9b(?lvmqE?7&Bw0GhtD3XZk|}V-e}coHsS)UxPxZF{)V5GaF&;cKrMs+3PnoS z$32+Of{tBRbUv0C{S8j~&mhonDlBpZQw&uUMpsm~UJ2(oZdDy|e-ZzuaD`Q{%0HG^ zd!Z|et)z4FO>JOLSC_CTDw;v<7nZ?95(@;Qkdzj`{dxQjm=&W`v2{jJ9Lx03 zPh7A7zm90X8BBc*$+CyY(X8@(RM}wbUU=YdnL9t4S|6!)&xBB{r#8E2_LN7Bx(IPw znaIl-zh>t|7x96}ZeKN3B_f-Rih4GtiYSY^U6jZ>yB_tD#wf|@C6cJ$AlQtyuN5V^ zuY@_Bz_X}1`ad3vBo^Asu}B<;+KUNhtreXhUg97*f2+kVmH2jVjvPoDA0C}6*x(@A z-SB%P@`6s{j(~jsK|1?o} zJ^bZ?7dMq0rQP-5-ChFOj$7`ITiRY1{z0Yp*1sNVzS0Lk{Sng}0IENyYkNFcf4;bB z`R*U1{>9c=8{LZPv#*Qw3Rw#a7sBtYSKM!hU0=jE{JA<00H63rq6h^P7AoD}oFSB9 zK5Jv#P*|k%>?^02K8lvdbz%UU497SBm@=cgCv6wTTU$I_{UWQpH@u&_JvI1wDzePW zZ9fbZx7@05PqtS0Un+l=wKak69yHA9EUAG_*1-k!3ZOW9bI!faQ+q`NQ5GXg7$3ulH%vEXP}v= zkfIs4>#ddQ`_n(`OXLzEb_dZR|2)leyzAP`vg3}J_e9X&B7NYA*i+uqc;2&X``F~# zO7Q;lgd4j0&{b<@+=Fg?=>I3K5ema*`ZAW^u}^iV_t1Hkn>yw$b9!JKU@)W;Nt<|9 z;Z${P(2izPfY*5oV8cGFe6&A5RXBNyJ@rW+7;`ZmaVx8I-`$7{sFT)r0?ftmx+l5{ z|3>+rRvdZ%U(7u8=L6EUs!n_C2I_eRDeC{^vC%%`*!(3WHNFIdrQNk9t|M@!c;_V`?*0z>#?#+` z2hD{7u>JwPe}H-g?|K90SLQl^sxJOj17BF^bCiWdpetJHP?dkpUoR}O;5hAZ2mKLm z`+r763V`{~WcLBQut5EMr!6Q+%|LJePZ!9ciHsv9aS|xs zt!y~5ao5{2KTa`oB;hzdT!~lD9o#P828PrpqAp`zb93IM?R2;%fw&nraDG{M;n@|< zz;KryP5Wt3<3Qlxa|+>he<>sucVpks|4jC3$2~Y39*!@i!U6!N`}+{__k)GfON!dz zxNJUlS-yiPEf3ZI?UW5X`x*XUDGJa2`3*ClR4NtKosWC)Kr3v|)nuXNZ$7Eg#{#SQ z@Y~ZbPO%K##N7)8K3Ae8Ma3WNz|sa_$@MROykr{@f4{KB^YJ<&(Mb>!7oo>tM;eW> zN4JjlQulQ_B2p$@0mry0r&p^b=lA%=!``dgvwpqs?5dH;xAkthA8s32%GBNVZfdqm zPv7LNjU}1q zpVi~^-m%rARtVX)Wu9}?Kq)a@jqQi`Oqw*UZzMhDs!&BjLxVz}Da=VErcW+MES5^4 z0Oi+5{{}aVUt+qz`{FAqGBG;c^?W^rin?)*Uy(@BR?`kJaMYd%uOL5AzMzy|_(izp#Gox%96% zCnhGYylx~bxc9F7$N<9vtG~;>KY??Um>F5=d*UhA>S~Vvr-bsia{CvsljD2`S|pdu zEj37`vTNSoJg1?FoQdCTw+oK9tuax|v8nwnwb@C1^w(0ydNpf64~~w_vFbRSK|fB0 z%BqegZpK6I=}RrWda<3$Z%Em$HCeBuv;Hc}|0)YDctJedFjU{`^`90l0d0i-Hvcm? zf6ZZTJYzJ|dcCmZ0HNVmzgto1?zG4C_!;fbwzK~;mZShU&jzLswR%2+*QWTUT8B3P zOT(rV)ghh*ls2q98(h=U<2)kMiIls3TUR}%QjWN_%I}DG$%&rHrBNi~9FkV&wfq`o z!*?Nk%r2i>;qA(vvaye&Gf~LI0zLwMB9VkZ9ogtSsdx|ie>Bmb##&J*87C3>Ci3n1 zaE3xc%omKh>q6do!?SbO!ozk{2Wryacxu1onRPA0?`gZ@iqM~ZW z&ln$VvQ|{Og4X=iuPZEazussD{RaHML*_3K@BTeGyoAa$=#CDb8)K^#r>Dngy9E?+ z?sP-2?DiC12TE_geu~w^}3LFc>iQa(( zEdt4?;mRtnE78wSq9<^rBTIxrPl!x}H5|(>m9i)QeebWG929!uwn(CPDA0tCMq_u6 z=RS8KX;-#bq`kU3)F+Q4ebzf8>#gx=obJ9`+`1ccSMKRXzu0;UWz#PZ9l*b+KNA?p zwx!4EX3YHualRC_|6Vksq6?zZg!@`DYEGdp zK>ln~9b|#lp@=S5LjMryfDlkY9%Os%uuyUrm6#-Hvx(hAjeaV&*82hP-2^$60l1fP zar%OpB&UF{a!>=k2Zo7$nHYqSCANN+4gzVrgTry-3_McX8_5%q*=T}q9Q<*Kj(rJ_ z#RN-{^4g5_Up_TNOc5|Nyh?LL8@sndv6c8DtrSM|pi|(#cEZCV=8?v|w}Hdbao1Gt zU3SyBM33lAqg4lsity2IobcOXO_}j7%n~E)ib_j**KkhkATt$|;6(%{t#q)MbZWm0 zo2biDL8*4DRr^@kczDpPRB%^1U6ws9W2n&iQnfyM0?flIFZT@%Im6BR+M>WWhuGr} z1klTKy-fxnv!&*Q{Pxt@>D$lQ-G!WS^RgkZuZJ4WJaLwf?d=%9;lMez;>=91nYbsL z@*p&HPTc9f@x}RuiU#jR=o0m#{X=O2bNE zR3;8vW(Sk4(}02B`@2jqSZT`Z&JzOvG8N&ouF)$Z{I|Ld9m5gKFnXl^NIj~z0#a2% z2zeq5mI=^QrMQ|fg(E^UKRL56w%|14nVegEC5eYTLoqW+XdOQ?On1&4g=3t?An8vN zKp%=8pnrvGbAQEZi?h~=n(ai=1IO!sdXJiw^VqUg9hM#;$YcJ)(t7DDLBOi=M*(5i zT^Xen%wo=ynkUyLY2}>5+6C!@Ow=0#?G4tsnjunb+AcjmWr~0%|jNs^4^T4DrYE|7&SwfO`!Wc9D!&Li~QOa{= z;CIC?M_dR;Jmf>iw%7Mn2oEqkwAinf^6FRamy1}U5D}xC=+efuOvFcU3rheG6DRwG z=~qew3n{4aHk}^8C!=Z(PBXz*`ZJNzeXq+dpQe*d8dE{&@s}Ygq092B^T1v1bq?fR zAK;M_8vX@7!wvJ=2z7Ju>-k5qy#@vxj<@>Uot_mB5F3Y&4T<(R5A1tW8vRs~&?C;m=}(G#iaI%JH}mc=x< z2w~((HXVFIw?C#NQ$m4~#~(DrVbZf)gP}wxJ=|AJ=wfAST)GWtG+jKUH`hRU(1=WF zwR#Wz^+S*6dY13v`VNb4m9bhE-237IsdFQxq)rcbLbu3^>&aX$(**k0i0T$li)0M+KYun5T}J z7BtD8L;hJ~|EyRaJjFL07ny2$mMu=gJ^%0XX|8e)W^|K z(vVC9)pQu*C-yWf=Xu|6H}N!Kv^T4pyuD~|ckTQ|dIuSi5euy0Cr&bFT6AYZ2zIc4 zxhSLSt$0J*#it7P*-44?6@7|T$CRC)Fpfp8B4A3Lo|t4l1Bh){BP$V4-lGph=e3cQ z_u+RpJryH}uJ=MKZru&`P87`XEF zA;|3tx3nZ9>}Gls9G9+8In1F(&?9`E;QP#K?Md3?!h#p@c_Zo$k7^BhPNs-$5n0V2 zXT>0wnk-Qz`YFpZz1XOJk8r6ycV9;%Lg!@n^4(?#5XX5W>%Lg9A$b^%l^bB#-f^?Gue5bhc^wZakE7a-51x6Ol#hqK3J#qFv${(qElg5on z_`oM$KIk9HfgN!JK9!^(x#}BdHpS5=EYW7)#s@cciIT@GRq@Ij6P+kfvjwTaslsy5 z2q)?7Wouc2_F>mr)F|+Y+aGrd{76_}K(5}crbzSARciFwRw{be`b2R!O{&|^{AXb{ z#K4h9>w#Nn;nm$7YF$Wh@}xoQG8~!QxBcU{XWT)vr2b4!O9QCl4^$y7)GM{_vl9LN zyYFdt4^$g)xM`Dff-|>@P3tMP))dz>oo-j8;^fLq9dE;L$;W%;pT_WZfz!Ug1?R(E z*Rjcw3K>|>!=FXATifoRdBPqO1wRhI7Pkl|zHIY$%s-#rFQ>j&N{+xIaIN8Biw&Y; zDNt%K0ctioc#1=Kwe69VyE@L-OG4|dl=1oQpE6s|B{pT3r1S``blg$j=d`;ssl*K~ z8-*boePon%wUkrvcGk_j*BR&8NL6N{r&ypSrlzW)%ZOJ`=c-el74E*FYK`a~bKi>> z**p&qYO=dZ+57B#obvigGDXoQd$r1jZExsa*j#I3peyy&yLIAsnBe4ymXwF>{#V*C z15dgw!=rR>(Hs(8v{QXpdV06L)PuBrJq}xhFa18xKic$jm@8;VN&$n8S5gx0u)5>? zM+Sj~rfr8D*e*$lWzg$UE)R1qevXT`oa)uA7FW(tbeXnCHMH`Kdrhd-+`{)7SU>2P?kJh@{%F7TP5&SV;Tp4Tp)MGHU2fWp zgQcCll03GXq~*KX<>(Ianf-&eg*kWA&gHif-;cL_h6>q;5eHZCx4;IUvZ z4PzWTc6TTt9pompCOX0wLr!&y&iFXrUB)>*K1tLYwQO)Uq}BFs3Cy`s*gUC~u*QPgV>Q;wf#ew*USRV7`t%C^Eav3StddPV1)9db zFOF6^xZJjQl&!vdGGn z@BZDRKENV@fXU{a!xiv?#wZXDMe&;!r!ge!(;C9_pA=oFOl-r~5MTqxQtbjjSw^o8 z+=2bvg&Xn3Y_>dbYzuFV#78L##fPDd-7#sWg=J;ubq=f<7Le3p;k%U7_21bGfvj6U z=)}G1?7iLI3V(7V+X?_LV3>=1@NHP#z#*h3Ls;9pMOvg`T}phj+JhaV8<&$Z55m$; zFlnvm4Vgt4SuqS`>$Xh;wT#)`F_*pD-oECJ$BRHCQTRxuty~~L!Yea*n^n%Z>w2b` zcAU&%+cP7M7r$Jxb-VaLbdoZtuw3u3_w}5VAm)14h@0*M3&&2tSGS_nuDN0-ATGhQ zHuS-Q#=v>id|Y=+S$Zo_MQKIE8HMdkW>M%MkM*_lGSskgek~rdNN4qkQH|psxkEUH zrBa+B!<;1=Y+4=mQAsHc%l+<<`dO0ln*S|_VdBXJ#++Mc=Xx=VG91~%y$iOB#AW=U zB+j{@C*nxVtQ+o%ucxam|tVO3bRp>6KGvLBf`*Va^y4}0?_CGrv3T!t{=QT>*t zr+aQ5g%-z(u9w4MVM@$hw{8;9D~{t_(8pN=F*hDtgl24}h7Spe@td_XaeG)bz-z~dL|etD?xNT-4^eo;pGg^Kc+o{yuerlNj`$OKtR0eg zPGh-*!4)JODHs?L6CgS~g+nZa*WPsQc+863w^AKX`3}~rG3hX1DPI~dF3j9@ozI3` zt2kQ%t1->HQc|_Wx}#Yr86T_*!kgM|SmJK`XNL`I zil;6Q+y-g5)%%D-qm&l{2W^?Sj!51mADy!d#iRw{NHV1v?=fWOaeejN^6g;F@;`Uc z;v~RU!GH-%eVR+1EX(M#UQax4sSDg~+~H%Eo;r^&nyhPGWy%VFjZS*FM9gE(O}@5y z;CH38%sj-6s5Y}VO0z-Ob5cYy)cPgG{KUiR`u>oUWOF5Fj-%+Rl)$n_GuB_FcEbLs z_H5yPi@WIgIHKKjNnBxP|J2i4pVhuT#%Chl& zjkOq19mDL1=POUbV?#4D%J7QEK)3gS5`y-UaINjbnr`%EW*sgr8S;~5PC;ZN*ID=h zn>&h#%sFf098WflrMTLu`toSE#R;0cV?7tdlCoTy4V%yD6VHg<8W23rNl0PP0YV0+DPgy6Bw2$fQgS%@D!di<|<(D@>Qcp#A>QrOU8rSWvu4ok4 zw^)NvOTaO%`AgxPpPzN8DxAfeO1D!7o>X@0-N=d?@wmgEXCama9d zBL&=!!quBAujdQQ5k@uL9tn~I0h8+-k}Or_f$qnQ$#XXrb}bF$>NREOJbSHc7(ie5 z#jCFU0JZlsI-dH~)An2Ne%WxHXToM_IW>Mr_ds$5n|u*y7#_Q59~8o+?9=;Mtv#!y zK4Yq>4*~`P#gq2%A59pB_;@*&$xYK6OK?*I|wME53?B*7@H#!Ro^M%#Bllco{ z`=W|%r}hBix{%+TWx64tyx#cx&z^2OD^Un{^_8u%w6u+BH}k^U`}M#|r5)#|HPZ&G zhJODhS}gTrHx;$0Yi)8tBdhPoP*5bWNZbDJz2q~jCs>o*)4dXIj1?7$9Ob%DTX zpIH6xqBCa|-}g}UiPjuplru9AG7f)|tvw$DHS^qURVKL^wyrMR7Clxc*WQa$i_sdX zPT{AwzN<0fZQN3rj;66UcG34Ztfvj#=HDf2W^)vun1Nr|f@Tg`Hw=tW3x$XHIIo%QAw15`6B-JTA@=Iyq1L$NH4$GV`Vk=&<#$Tsr7a zqAsb68sDup!#AjL{l05aafVs$TYPA&9oHTkOnV$bVMGQlLFg#}P7_JOO_{m_8LbXd zdR2yWijthw;Kia>iCFh4Ar$A*$hN~7oo}{<+G30L16P0M8axT2Y^-3&=Y-v}kxID7 zN*ky5@A@O?nq)u8>>%`Q~n?v0a0c5&6H;EAw~-| zFaP-RBJlR`PT;t|fqG$eirB32)0@!dG+U7pY;pW?eafrqi!#U9w4UmALpkGgx)tU1 zcyeA@K|y5eNeoy4Sy@3e!R{V0B0_#hA|jF~5p3L4&I!_6OLNSmyZGFls6}9-8OHgi z)IPn>cX%~N%n}gY7xwluAJtrZ%(%&b-sFthGy=pkTxfY6W;iJRE4<#dqkjg2?5QCjnlL- z{I92$9{!J~ddMoKXVx)B^8P>4NYpGlzSYOG8m{@43e}RY1vLAmb9}U{io-YpW>njB z(2z2$1CrmyN|Pbk!TBDyUfUv7aAfafB%bf*T3&1Kk9a}XEfc4rF^-z@Nz|7D*O7j7 z7{CO(>tK~7eJu@h{#f9k-OSF6r>L~Eqcc&qcb76Z z6`aC;GIsyM#g}a6a=ayNXhAz(1x@Rp$z`VBXxX#sqd^GwfbvjlzT9FdPcf^qZ6pn| zR!ho*X8j2zfpb9`Jjf{KypLx0Fg3M2^obJkA010Wfy8<=luM$;GF(^hC=lm|(%@r) z2kh%RB&`KLRYC-e??3QPnaimxI=o``qJXAuT=&AVz-6Q8ihNs!EmuAe>PtXdn#~~C z&gQ0$1P*&%8*|F_LC;HHW(zLyyM4ho;CsCc>%n;#WPC zDjHBC`!tfw9h}PIBkFV7wlBMV37Dpd&lbfi+9ecVkn&I$P#b^GpNs&NqUQ%)6t0E< zhij(tK&vGm$?Mthx&W@B#|2$L!ioesn>Jj6jlsGyJ)<0n;Uf`F{PYO7?_(%FWIT+% zhz%X6Fn}`_FUQa%2uuKnS#JX~oOAX0H`AYx{Q9vNE(}drsQCbuJm-Pi)j$J2GkKRP zVaDrr=3x1KxnPSxt_Ao$xxscnJRt_6MDe-FRHOU%*?xu+R7_oT%gz_{H?RjtCQv5@ zMx)4YTb+>Jc!In*cASd4n?0fqaf?Bq}*PN{{Pg zqyinBOJh^Ytd%Jcsed+-0aF+%ZXgzbj^1|gR==~QnL+nHy#hNLE&CmR>4!c{_)b{# z8ibH$0J`|vj=VY1ijiVeGqb0*I!^qena}P%&_A>fj)!pw?W6?WYa`i-+W3|F+gNCx zv&T;|Yj^&{630B9vITGJ2FL;tDSXhrIUnU}+62&ZIE@f>ueAK+Y!Ha5PBTQ@vXL1_ z;{Y+a`cTL^W~B9H)H6L%M(U?4sxX_6+51*}*A**Yuy-BI*s*Wu^86Cyy3w0byqF$T z6vJ8uJ5PD}oiXX=O7aUB6wcQj%UbLE(Y!AaO%Sj2qt0wgEbClF zeBf}5_5(v&yU^|s&yp4?iQ(pO$spU#{y=epEng2n;vXB7tn1>sV!;<|xC=n*P1xI1 zX}}f*=SN#TFmyf*Ru>9R=Rcak%$m*e))|d?`z98l%sK1I*Gx$hqPXTGM3dy_>&J*I zeQ&8WkEx60muB0|<1B zDZw9OAU!baZxY*cD7TT`O*~6H(Ls$c9yq8)Z#3y|6h*I*3Naa|c`=PoswZ|t?~!5jV>@NuJfTcvIvbvP&p*sfP0ZaG`? z_7ztWrsDcux3=AnEhn&B1x#)XH`iO$h3T5N@11iQB-{o4TFD~x+qGY1QPMe#yo+og z+QFi#9VrG#wi&U zS?l4`)?sFq!YukR|9HIY-%SE1pT1I{ff1HY!XI*$*MNaai@|HzUwPf<4SeeAk(>F_ zkX~ZxTQ?b&TOs5C7M;NO9_-rM=F|>DNuSESG5=5?-2y-5LrdnZI!mB+_^@E@ys_l= z-1Xa-!zVM7t;sdzwOjb(uY~$E3SG2mj>lL!3?>fgb#o7dm~$UP+vOB=pRO((jqLD8 z*irCq-L@$j{o;*_aV!Bk(}R?XAiXnf7cy8^%&*kxRrPx6hGVb1Q(K&23VWeuId-HA z8K*{`cH3#ndqS0i*@x>#*u)8rS`N9FxmQ5ox?hq(zLi+%Hd}FJBayRD2Ssuqk&q(K zFZa3>dJsEd#@I7>zTy5*UmG+7*fkKuSxU`|V7^OpJKTfw<@Ki+o0Z*!E#85xq-d9g zOoOW*27ZzeY_OU!G|ArFtV~PM-@M-5Njb>_&(~`!*!=k9`qH54k-gl%l|vq>e4S(XhOddOo$_$qYiF_!(< zw~C;EbKdbF6s*AvfSyO3FPd)Cd_xg5sY6gP{rvCqLrVuC!Y8YngZpIoTdi?Fthu+( z%_<%Vd8C2O`oY&?End+b_r22P_E-`gRy}bX}*zJf; z8Ky8l|KGKi&yJcFzcp&sATG?x`Zp~*-hDWTFuzn=b4K}Dim^Kg14k32`mAA0%No|Oy)%x+yf)Da`;Pszne7eTn;kcxv*X(2 zNYulVOK?KsuNEU993b#QpI@%uBxLY1@IUfD5ZQP;nibHK>~Or23JAHncHZ?SJ`JlQwu zbEaoR{oOwNgO);HQf|BaKmB<%Q2_fR+Goc&MQ{Kt)Sw%qPGC8eIE9o=&r(Xk=I?9;Mzn7%Vj z{C61okJA3)UF-w5~%e*ah+_#4Lk$9nO@>l?1gz4P1uuORkp z#kmQ}a*gAXqd${hE7|X4s%G;q(%yf_i2pRTeC(`gtN)y7ZWgt>{vX=jF}l)aYZPAT z*tXTN)3L1%I<{@QW83Q3wr!(h+qUs#@3Z$l=e^$<&9&rB%uMZSM>piGz&=RL#=o>a_ z_6WWueU!^S4e7*xYVLE#Ki0gRA%kv?{yiqJa9=e)W~zijuk3UuF%QBc0S=7eD8u$? zZ-iQAPb=u07%e>;_*Jv}J8&G~E?^8J*5#68sO4+vh|-8`*!>4E?W9w#cFt?xdG z^7#pM{~Ev4`~Oe2|9iY>IhLEx*Z(hg_`jgUzbE=f?yru20sq7j$DcY;pA-Ls!~TO+ z|7XX4N}v4wiJc7BzX3phknNKMCz+q=?%z-VKrH$v{RpbU40qTp7Gf#XN zZJC*j0s28Ep&_AML=)biQn7-SJLCO2KpwhEt0zV)2jqb$e*ra&$g=Ie(W&QI7PHZX zu$bwL#yG+qB@GKaSBtTmlWH#cs`sSDl4DNTO+LK3^fq*>Ej5h1By>f`v& z3y7kbJ(rA08~Wyxlcn02B;1Kg9i|Y#SEtB6b(<6DM!W>Rj@l09Q0%cYnr!g}2R`Re zW@Y|m>${pcsaaul9ZHt>3$@Tj`vr4o!WraA1T268r=dmH<08_qg!GC{9gwb7kTprH zIEgo&wGIHV0)R_%R<}B_T(fK~Z**F*Z1{f`y#cVLpVm?>3!3v47ky6*f1JPn2@aaS zorTxX9W?v?Ji7cJCO?qS`ErWl5qjvii;`Ia#VNeB(bke#O+uT{f1n>yczYKKq2xa~ zt4m@1i0+8k)Df0rrzDuZEFqm$>_C(pb&&l5Wbily6$l2nY`##3Y;}lrX`KE<&A-{< z?;OZ~f&EeEthtb|_tdFC%a&wwtWa+{q}GZhQXXF`5ZXX4q__@X7>=xtX_o&o5^$SX zu7p5uYPLo_l=J{5ptC{)p;JN%?No+PEeTCsCD2bzUDFMXQdKhwLX9*sohXY^XUPIg zppJ^l$d-Z*it0giB_~f#Xbw!+u*NUb9Gpe4(jnJ179y4x`d6fGBlL>oBO-v|3l6dT zt^;6x8)G}+a^t88X+S2+G` z$zHPQNw_C(wX}Q4?WPrexDeT2avh#6Mp{Rgvt{HGd{K@FZF_D2j&|6Y>ZGuw)rP;5 z`w6#HhBI+-p@+8wctNw+&bKJ@Tqs;jSizqFG^6>LARkUWb}uM_CyJ7&BA3dUN9PPU z>fw<9{j9`}o1$91K_~D?a?ko4Q1lw=k|#1{$yDy64w5QtzQ=z%pPTV`GQqa6H2)rABqTo&Po7)t7FlzTU;#j_wm&W5u#@E!Ra33~_^q2@BCz-k4Y3h9~%G*9+a-tUtI607USa{FeYk z66+{Rm{$cV%3{mB`894W!tLY~TCda?`#X64PXb5+ddT;3)9c>MKq2leer0w_Y*jXi z>ALCXT3xO;TBq}p(13{*SobkZo1I7o!~qcek1{095IM85kFt7Mxfo22(qc~6@eVoR z!Z>&RN+HnL*i{C!+BfT#;j092mgJ$*a70v-v;q6_|@z(kMQ; z0~}cnJy$mZgTHS8e(BO}a1xmD>?B#_`+tD9P+MgCN$siDZzCJxP3*K5F0^Q00<{tf>hVq*(sDa#Q?#3*3t^f3slr_Mo!jFd+Qqf2)`vU z2Z$;xeUI~1>9uf}QlA$RIzGYHs}dshx*I|K|r7hFFX_-}=W`5!gn z5`w@`G$D(v`#Gi5zO)pHb2#!40QvLvm#fP|H{Yj<6##|hNdx2atu+aW)fSsIwX}@u%ws(;z)lJ;9zm3Y)=q6G^uv_n2D-b_4D}s(H)cQ z{8t7SeP1X!{K5cL5=He5lyHO1G0B1Y;g?T0lJot`vS&uAn6gxOwtcmiq^%fZ@}M8E zj9K_h#mvaXx$kUgg6B6TP+wg=y*ivf%)jC!Mj?NDg>K6XTL^pkc~{iwejxB-f_a$z zm516mYoGMN@fj`L<=~_Gy%1!S7b&9asega?>bYIH&La3r>&3U>eCc?-qO_l;UtW@# z-PK^(mlo_LG$maG9L{)tqVcA-pq>EDC)yoq{v4i;xjviPl!|s zhbM`M5rN8y2xcLIZ)ZuC+4R&F z5C{n`=iFqaX{2W;BLFt6+w4RT-9|CX*On5_b2*dB8;Z4Wx>52}JIDM4c}>oE1}{k% znB1~CRg7EwCmGpH+(CUQUwmKRV6^H_BRR@*y5<-?7{Pwfix!8hhQt>cBm)54}2<5LMlWe$Qs=X?^d{#Wgc zcV=^(!KLr%L0Y}j1jX2DAyJ@iqt;vCN#6%nuf+q{7MwVsDVsFQiYY}T;d0**sVBaI zq72}K*Z~z6_0{NysP60sJM?||46>gYob$*{=GKPW}NK<0Qj4q4seqJ0HaSI#@+z1zY7?6=Uo6` zdH`Sy0AKxNyjXf!!IO{4o`K%c%(HDCWw>TP z+&8If8Qq3Tv^|PGv)<;)$r7%0d=5c1B+mSubv3`G8){ybfF=0Fxr9Ctb^DPO>!i zAy7Hx$29nZ=?3i;pe=v-ddqMCg2EfgGG$4!&ak)(u&|!1=wATccz1om5(lMVpx9Spl)bUuc)~ z*la=m&NzYt&wfhzTEnwkz4^ulVObTQ!db5^@qzpGnSpyQTZhKQxM9hU@xxI-d!hp1_>h58A;(drxvoQfD3STP>^-G$I5 zBU;u4=V2I|JJKV*lkaA>-p5|>uM~=Mtbb9Yg-Khq^&AboMwf0nY5=b_3`cnkpAdy;;n&`2NY~#m9z(pLE(nYY zWc|2R**rb2M2ibGEV-wO+FmC%;})7~q=Bws2>;TldC2m|E1(XZ-=OA#Ns~$mgPVJo*olW`v&XD*v^{*|$6Xiy!}BIw=svrJpjIS08Bw zvzD%vh%SAvA147Xb(&AzI3hh(gpUTGZfb&I!rxM?iiRX6TR2m&XB*wGTI_ln`{0Wo zf;u~c10kFUWt0aI-DQfexs#SY^zYXj?l&6W3qRWRU-0?&UmyQI8UFVtcxD#>=;_QG z0Bixk{`>8C+2y}C{s(&1_IJ}yT+Vd;1OKlX@Q9uNXr1w2+x#2IW&O`IRxIl-|5btX z@B06lb6NkBn*SQ#{69WsMg2bt%b&CSC(d^v{jovFd@V@QisKe_L=|cx%v?WJN~Ot7 z>41TFS!fRER*<~Y2^ARQ+(Z#@RR6r0yv7A0qEi+Krx>Mxnu3A}%VdB_s z*AXYj5g=We$9bh|ww{f;l;VJWNUi2+o4|76prVfSr4fvL-B9HT(_S0R)F~R@BzB&| znfj^;2P9If~fl&5Vgm+fbi$tZeK^Dg83A;Lfo1O|GAM%`g)tCq2w*17v88CS$ zx`hT#{>HX=aglp#jyC5NbI1<$O1Y$Yy^i^|IJ+LC5VpZH%NOF_{^zbP_JF*m5?Y5f zGKXre_V?d(tT-9#pc<-{H;SM}wuyJANl8 z=BHcOQTsHA=DC?Myu0vm&bgi*UqRW{N zcv9~GLl81+>IPeY!F0LIQ{Z{@XoT4JfkR|f&2~5@+CsFd z3U`XX5Ci`b&lJ#>G*4lsxMw`_1EQtyhBV6D6zbC&bLBB4lcB|DPvE{b^XHt_hburgU))LYI5AV{!E#P{SF(m%c zK?#p@T+Fq*TsyLIJXgf}b|(+wOyS5nC%WWnKNADmuul$*IeWExHR>Y~giL)!P08h3bcY zo^}o5vg8EJP)D(g;h8t=f@Mhl3iDU(Ro|fVbO;@)XQ~NeUvwKb%;G~5>Wp413l8nM z0vzgIw5>H8BT*iuUNV5U*Lg4x&veJ%vOhLF+{`zaGC~2* zWc#bNeGKS?6^^rEANqZjD9K+7BEvE+c#lkIM6ynQaSeFRKO^oE%{M#jy@DEC`&BrAPRcOD$-=AJ1UdkxzL^_OuSCq_t3jPbNF z7FS?`IeFd#ljA9F8A*6CMVgcrLaQ+iIWky^by#bHesJ+#Zwg6fcT%4?$; zj3CN$B7$GkF0zKd9*GhH+>!4cG#J!)G2NblP&;9>dX~xkqmdVopzY753T~-+jpoB# zJL}(Jz^#APXGOFc8@@In^r^q+BhScW1t$PWdnaH1I2^)5ZJh+^BX~6uXIM>w@Cl{I zY=d9%q&VW#T?(!rqrbrvp%Kf}Eo|*YM1z{t1-s#)u+tD0pvLN5?bhhL|825wk?oZ@ zpj;ayYihLcvCfxaw1Z3lR4P{&O{C27VY zg+l+s`#DNtK$Kq65b2hvYLxM9yj;~xsIZS*A4LK0W|swO z8BT+PdlMF2ZrQp8(uiy8V8@+grZgKtz%0WUhWlCxjt(Aodm(*UU8wXeA6#;*O-`9; zv>+ilg4;}i{7-hn;2n&q>6NWSLv33K6K^I5Bxd4R9Wd=}Osa+#Oyt+yQ|@g7uae3R zHyE4EYgqi{&IntG@?@MHRN|Ty<*Pwx2PXT!w@Mm@=7VyfXBn(2Eu1 z@kIBDv1qdNnlOv0UqC+Eg0tj@$hoX^d8iF;L`D4{PfB>UdM|&mhGibm!Z|1bJV_?1e ze)?Xnmy@XI+hUD!UC4u*rQ|hmgQ#b=!jdZ^!T{P>iqbJKjX!n#w-)Yk!i+o!$0 z)TbVSyuL_4Ajle{K4Rib9$Y)5%s^i_VZOeqMJ6bGKh(Nj>X^=IX`+oqH~28vc5k88 zDp>u{!b^3zYq!|3Ej0W2!^66o&0A7$k~nIX+=*v=nP;fgy@!dpt%gD zH3ur=?86lOeFw>gZg2JHTswiV?|l3QLh0^FyPCju6=}hZcYVS+g(vP}ghWfQZE9N1 zoZzD!qof!r%0==pxK9ot=~I)b?y{hkp%aiv`OPuPKBC+(&RfZ01k|OE()v3NxLHI$+O;Biz;C`6 z-!Qh`B4?d02jZ=r0bt#6cq?X~0fOe+`hi2g_cIR$l4@%v?JIR-U#%TF{F9jFl{ttt zSns2a7ilD*t<%u*Z-Yf}Bsola=#)jn0}4>Y@$iQ`-SAbgnln_)LT8nKY!m^_qgz8+caD)l}ly_B3?Zz9vL|i1qu_0 z_@lcG(0!znwKV$>)sY2eD>;-xRV7C3_?ryd(}E# zXEfq3@ZPrWL2_V-syL*eJ9;R6B^U@6w1#C@9Q2|D%#UHrUNuk4CisqJrpHY3*kiA5 z7&nhW&G$d`O{MO}y6l$r!1*VTi_7ukfhR;MG%G>`ZnuY7ILRcYhz3tr#~6y*75Bfa z67!BM;$d0^v1_q00ijRS@!zC$si+{$j{OJ4v&qirPS zzx21t)d&bb)$to|&k{R&_H2EDNM7aN&j%e|?6{hYp*KLR>+&RYr;Aib-&>UOP7(7I zsFWpe{2;Iku%!5Yqc-<=>EkXDolQCE%nUAN;VSlyKH5XUU(O$sb4er-f2vo=!SxkF zCmRPIFD9LS$ovc-4pGY)ZE<SnnU zQ9a?o^|yraA*liEq-eY$JNRXCIImLRy4b)SmsGFc1)7KCb6Z^)jU;{-kK}kesrYsy z)lUoT)VW`RDDW$O*?dpp%UpOI@Zt)Gkx7^-G;(Ogq|+;Psv_G{uuaT*R=LmrTA#$- zh^~p&Sa;%*CDJh5UN7?dC`OG887(4;r#sHyP%IGWD44IFk1&x{#Z8D;oc)?0$TkC4 zfGmuMU5DFwck8>@O?i~MF@M##DB7Fl_JQp~?Wz=^JW2J&<{e%}W1G;VWmOmdRT;Rc zjJ5|Xg*oKXL22hCNeQ<9DiN1xzy9?MF-BD@9PP1>5PtYV*C{^fs^z z9w0)@^%E)N*a}ycZD!4BfiR7}y%8(tWQ>!T;F^a!6Kp%G_Xt^he1n)SUkJa;d*2L4 z(8PUfBnIR0idY}qkcjD=0LQOYv>~#2VcR5Nk?Y;T5#ChXN_;y>%g-&hS!**2N$Sc( zM<>6fmIlZ8SD47~0h>_{5kPl8k}L%@3o7VQ`R!K(Rf7kCJ@u-qGlc8Nfa8dO(MvrE z(HY9qvVSezgN0L=Kf*+4L}#;yV?qD9tG*t28Ci2H!koRH3wb`0X|U$X-|=Ph ztn8aXa_1=+r`=dsthe{_`d}E9D?+%UiU}GRE39;oN8r=fZtU0dxE|@fI1&hf!fWG_ z7f=++w(s3kT9$8TGSNKWN{@T_AF4`c;6Kb=+oC_TVb!H`VGHRy@wNts{4SFMxY(wX2X6(mmkO!VmtA`R&EA0*Cs8J9_#UehH_UI>o07MH9p z@WRz$br)R&21YQ$XwOKyW;#JhPb#g(DS@u{fB-D*K$Y=>bVsBNJ7@P1Q7=YwJ3)EV zoRmg}8#u7x>{$+PIW(z*pB|bws|HyjkI=?>5HoQ%x9DjUuim|#cte6+(4%Ta5TiA# z?lx_roLV+g7PKu!BhGkTB~g_>pj@>DVc#vz7nuhMw26aE`X+AjOu&++WhL85)8sJ$ zaaJT!9uiPl`;b9IH2p zrhx`r`bb&c{9WGG4RDUa@hvip9;26?@6FlFa&4<@P*in*_*ulw`Zb{jGk_>9y9&D}+G3J4Li z{)hwlFw8o4Fp-6s=Y+T<2UNXzG~MyF6*4ZZ7gd5}x@K6d z2hA3kujh5*4AVxkZx^kwo!tplTB!jcwR)3?fhP`@wX|=GBB|j<43>{34z5%b-7{-T zU<-qY`6W)}ymRYlNnx_?-C~!k`vZhxw#>5N4Jkn~ozs|_Ts%?*3=5~%P+=BGK zS)?bdpQsG^z|lPK%(?)50X96>8Y(9Ly!r8(ho(mR86UPQ%(5WL20VFs;>3w@dI(f$ z?5qhP5(_ecpWDFX#0v@>sI*zs4==zT2#^q2u-fvH!F-YGQlPt@(`H0d->XwmZ>LF_quf*HnE-Ha*3t zMf=^8he>SXu;g5j>AJc$&Vvrl1L4)0uDu(_E|9w?7He&*qiNP_G>mif(}|{axIckQ*Wv4FR2=~$D7X)7!&@(tbtfGR77=v- z?M5lwMxv+F0aVtk^z?MV5*)(%*x4W>F(mC@IL3|0*XhAG!vuw>{T9p5fWW*YztKF?!^yYaCS!3Mon2u2r5$tAAIR~#v*nX87SUeeusc9810+8a5BxN0It!~HQ+PitL#8bn?13d0%xqO z6u04vX-N83QALiEPCYKPlHI6lsCA(E;RijE^^8|F{;y6}cXi|g)u_O1_NpT{p$paaqGyotmKJ(}~_z=QR(3TeQv(ib$UL4nRquo=TVr1WjdwkFNpD>(pGKTS_^ z72@^gV__R5<`Gzx-P<^AYhoZ(_^16hjlX;#kyQkBb>i7FTspqR(9nwk&rsobdaCQ# zfybc~JtnmC#FjUL_N>i7Py zFZA1{IV9lR=}zY}0Ig+y=z&5Q=lZeegoo>_Q?}01eOSSux^T@)Z;2eOS;pse8-qWi ze;$xFmpll6{&rKgM7_{9(>xISG?k#1FHL3zV~RWfqxHrAS?-Q$mehq;%=c%g{!Y>f zQ=T!pg*p;#(IFr#p*$^g)|B`|wQ{3xC8WQ~xWtjTK~>cgi~Qla4ey(Ni81*!Vc2&j zN#DD@fTT|fOq&1r~S+jc=}F-0pa4(mH~9rOgq{%X=YF+Wl4M+ zXUjYbsQi~mETDiML&65ASl_QQ4v<|TutH90cTUC{YX+@jM4FknQ2n=nG%GSCo8I>w z!c_9x#;T~tS$&8YM#KL8H|)@3pd;pEl+D0KZ=pCLFuZQeTNjL|;+>Z+D$%D~J^qCF zU6Tpk?d+*GMP<5s!Lvyr=Wuj9Hm+R0FWy_|(O0=Zb16RwYq^Mue)3xU)CYM98a`QU z$2)+Y^+M!tGW|e#(x!hsaYNw2Fl&FFV3k1ra1OYfjPIyxPjpn6#haFUV+TJW@G=;f ze#2J3(w*H@E-e1$#SO}kt}s*tp~(p0C$G54m?zHUy{i(yQRLnG81LJt*3J{KCxU*) zCx3nHMerL8qa&Ye6E=F8bhud}zqi3;G5NU*m@5*RxzZ@@6b(>LTts!z7M^!@#203} z72jrtvxPT3Op#625w4A{Ks98nm6{o``8MjPYa=XY z#P&p^sAYEawq|4Qz_x=yzu~derPI)<$WAt9Ib(0*d|=SE))Q`AH(kv&-lE@C_tyJh)b5MILL}Z?J9rp#S$#u&(JS&J*4W+@s0WT=+&;*;nQdJ){NQial#`TXCpbn^ViG8F|(A5KV=EcPp5=nOB(B4 z2B<5vs*Y1L7LqX&4H}puIC7a6G>{R6=Kg$BB5Ny;@Q_+er-Fvsh4Q&PXz(!A7%vcZ zKdf&oF<|c^)3dQ>MoeTSVmSSh=oF}YbA)`l631SsNj~4Jv+n9cg?q;-<(s!MFQ1%& z7t2|DKY@)mIR+svX2b@w2Yrr1#OfdBZh9*b$Spc%>183$=h0Z(woQJ_=~E5waR=4> zbycp1CL0Nyz6rzL0yn2guSE<$)-18~^XvB~YX{R6H3hNm6&Qt^d{`<* z;E>0U_53};tll7iUWJRm$C+hS91T;Orl}E-*i{bDbfU zWd7DD)zN73sSZPDp77r33?1=qQ?P>e!#{)|`_SO?ayUFkuhk~HE0$crnoG~FT?R^% zqwPATh|^vY*gH5oEcftQ4(L`x)9M>knpFXd5V7^h@zf9X%C74wWqagneVAh)&^eNJPnrE=%lN2gXE}VfA*s>mE zSyPvS-{N}9A}TNnZ^0WS(v=<)tHt4T!h_3uN4EO%OI5>&n7!6x-f44HfaAHR)u>b6 zsKsL{b84(9AOjSlx=UMFUTZi~UU&xxy?8FQ*_|c54nqIKjwo@EMqc9YdCSizjg8&} zd<64;p}N_MYmKKN@I`Pia*YJwF!P~j~{Kr;e6xvEYHxJnfOH1nDBZsEj78C z6;&wu)=5MY^8At?mM_^um3>pvBROZ`(HoxXL0VDk6_M-J%{nZMCNnrX`p@&X+;k>< za_5q*kdjZdfZAB1a{6@V}DoBlhA-BAOYxG@!yD-5{mSVCO zCt4rNHh7s!0exqCyq=_6Rps9PVUV3#dS8g)$L*S%g1J;g2DiTYyc?_fyEbHSw-fL! zFBrFNs8mJS0L$jneqw z4V%>2NcXrQc+in7=mYK9qa}@)8zr#Z1^f$ez{Lrj4oPzY)Q4_2gn78&>=hd#GQ#n8 zs;Cj0!GUKLh4c;W=)MP{Cav${ZLieSUJX$pzjqz3+Kcm+_Q-%5nCs2vBncU}gZM#T z9^2`N!>v3;-~~R7LFi_XYj1Qnqo-N1f0caQ19&TJzF9sr;ZmUUh0cizHLda|hwIUQ zy3huaY)G5czfn)e#`!gKJ<@2`MJE;hVBfcJY=WEZm}Od}dD&6Dovfi64UB;$z{rTi zS5Z$NF%y{m%p$z{HVK`0c3;^&Xpi5-o5^LJNhh3yku~2p5gme?^B!4Pd+B#aoG(A- zMXyHBwPcL`K4X;9__K3W-t0Y&Z~_#K;Y!J^pC%LtG-YM?TrQVfDBxbEt4i?>;XTyh zQj`h;B%W)Od&%*G+2zt#UJZX9c97-fJM5) z56p_LZQ+jzGH_6!uZAR@TS13g`uk0|C6!JsKuv&^*T>QeUt90~PQrRM7}z4xaV1#B zJQ6z~WZsL8_)FQEwB@6XNJ(imi4>+6{4)kyRkXG50GH+7ps>qSS!QhIi&5eR1#BL} z6O22v;Ga*lFKb9yx)1_0Em7K7I}41kndf{=Px{UF&?jqg znsl4ZF>pQSlzO$4N)T4J=J1O9htQgTrL`Po<$sT3;d!j6>nFr#2LIM$X~BI<$f?c< z^kUk@!upb^-2|*uI|L7=gydTI;=^pktvJEl%Vj6WRjKJqKw8m?MV~}35ht*P>`MSu zwFbM?1$20Fty&5?E980zIVQZCdr7=fSvZ5UE;32XT4l`hwR7sU;ciBC9r3BW+_Fb| zw_kc2HQCb4OCq|Q)7oBYwmlIdXG78khxq7o@l~ zDXTMu%ctm3vjy>anc0no@iWj=gGqW%BrXpYLypUP!1mf@3hFMGugTc51Xi43@$JSWLrRb<6=h z>vbh^S(6lJ(0dqEPvWkvKL^x4T)MyLQ8^e3g}cM7TVqSQYr<@NA#S|2V&D)W4%l0& z{?^wpcIWWY*4@)~#w^jyXdXAVG(?Y*GSFX)SuL^n}*L4(3*` zwzX25xX{mD7^ZM~=|R|FE0%kaP1IS6UdD0xO?TKUb4*iQj*xPaw0Mp5&MR44aQ_Ht z+Ph%wg;#VD$Uh&WgAQV?ny?N1JB9XyxW~Ksh5I>vD?IGgvtXh@0`-wH!MspPgV*oihM1_C z2V~jLd;L~}fuj(WJ~;SH;148M1&E`WAbHR&Pmeu&=>?oInUmZ}&+k(;hnJ%WHn9D4 zhhfXR5f+P0gVrVPxwU~G15^0W!%M-7uQkG5&J-N!Qh#l>97`7o+DeQ7F zWUPKM0G95=Th-~Bn%o=CF}kYx&diei<2+?3_(lZs3iU=^z-{M&`XThBXaC_MCo6XS z313A79Wa+VP7e*5Vu##(UwIK=k5WvZr?GM}Y53+62EPx}+thhHRLP?_T?XpYzB<9o zn|n5Bbq$F6R>zXJJOhP6wH>JZ<+$KWH8Ohaj){`&csZAe$X0&Wd=DQb0x<^pP`G1=BegHhS?*cS6`de#7sug0hz4yPM5 zG+BH!wlPh?%P;fG@w!ss&9z&Elq>C$YJ8g|B%NQ5Q)^?|F95Wra&dGn6seYw@JGC0JdA!MESyd-G4(aC3Cm$X zG+qT0EjCVZC>c#-;)u@sX{f&-#uYjJ$j(n$&>q;M2N}-$jW^mZ)b%`^mx`c5&wBC| z$I)x;-ZsZs^wD}+Z=Mx%Z5fRfBFv$4mK1ZZsZ+zs+|o`ZM%F_EzfIk~UGQ?^79)wF zv8yiguX0KY%LtW++C;@6!QxyYlOu3w_!%7G`uUyfKE9-Vz2m^Va7&KFHdS*XQ*eAL zT{`k$o`_4pT|8uxRBErYONQy@Yhx?Tq!K#G;W`jtuQ&rzV*T`p#tff3fN?yhmpyTY z)o5|oEON*G&ws=4xQ$CnUPp*$PAz za>N~;d`ltL6A})HjS=5OrG9K=WfRdh?(K~wzB4lO^E?hQ^fbYvD?!6qHZ5sx2r34I z21mUKW#*7nSP7Ba`Y|C^W>%Dz#1cpQd^AgvlXEpppSVd&OsB}3N)v90THHpUsJ#4O z3AUA`D^)ahRr^K>oQ{ws;Kl7Thcu1-GvxK8kL;MqLWeGYT^8TFkv;pOaGcXwbtVS@H|r7qz`^STva;^(-E z`P;C20ey42jP>Eyry`62!Um-$U zu`Mp1#S9DXUC_c;etq-U%*sj>sXpOd+rkI&?{bpnnP{yw>;Sj5dw#hK7p^*aBZ?SQ-^equ+6j!MQ#T^FUSJ+~1~w-qI>@wdT1-pNaK z*NLb?czGui3l6seWoL*_q6%HU2s9CsF>GR3L*2h6UErHGaDNCL|MtJn4mD6s2U10% z0vcuTUpi*<%XN9t`9J&THo)Eg*y6Yf*WiCa5WTW#?5qer~6PTVYRH zt~Uttg$ugZYrB+=8_OGR5 zZPoMPWa5*f-J|G4!)wZo~fF+lv zo^HOu%P`1H3sQV^p>z$&=3Qmk{S3gn#&E}lORKrLy;t_lEr*=`9-oO3sGZ6pk=~k$ z+)=vTdvM1iEZX^ni&@K*7)qYCUI~P3Fuco4Bxv@R28yxX80#*O|8{TSLq;$=3x}#l z!gE7=MMzq!SblyWNNsRr{lTOhp)Lo1!JwwVgWW=?GCpbL+%?} zGNX~%frB)>`*^+JUM@c~Iz?eP#5F^~nd~C)4Cjxgxh%>fgNdo(*0=<{}6-6L1`VAPB01(Tp{i zJ7b^;jGI2bZ1=4RE&<=Im< z!bV}g<(Kt0H*=YDpRwIT{8;>DEME>WOEA8BHr|Czm)HGfuPE+0#)Ls#87mxAxt(3& z58LzcsLE#D@=M-v`AwnwM>Fo*7xi(@_mCZJFDt{r`{J7>r@APQ1e6+i&bPUJ2;&HPOxELfba2z& zABpmf#EpGp!i!&E=w07!SLO(sQ!_O%?&_pPyQCqh?RElBALxdDz*@ZM@`tYSCAdkh zeFMs*#3?<~9r4Ma^LSza+5^Pui!4JxRd*59NKw zdr#82qBnXkp9OJ9X1DDqM4_1y_QHKGSrQaf14&(d477B=7CS%uH}YXDYSOV2N8?m^ zc2p715qn~F#Gv#TbEr;u1(G`%RB*F6qPJd_U;UfTH4fX}!A1GceDUmcvE|sYjtorCNGJMV;BN4fyN*Uez>d~D#HNPW6?o@`m(7UqIAJJNqUUGV~o7W#5y(BOwh`q}MK<7WgW(cbO z`%vgBj0bovb5hFCKjFFU(al}nJKpusi{3PH(VF$vgr|jvYcMfA^dm<*VbcI42DHQU z!ZGE>7sfHs(0Q%ZDgSrE0{ZVNi=HW-vvcsMyKGls`#C^C5fhq=AAo+wWNZGcgRV%| zLf8SeNeM8r&nl}k=71qDWmTu(g$ey&&Q{-s$|_DXxV$3&p;BsaiJbVy_2e?7Ti@{Y zqNM^PqkQ4w{66g@Qcg47QzfX>ktH!Sd5LeYYJg7vhdOMelk-TiLS7(=xp1T+D;cKB zLcgTPw3^4@Lo}v*UCe6Qre+@b?dQPRyJ7cpZQWGz+fSJh=%6_}e0z=aGM(PwLyP*? zr|#sfP+`<1a&Q;19Hzq}z7Pi!7My*Rk4n48u*hi+fszjfo?VHh7^|UmL(F556!$JV zHcGS04ffDu|JeQ(<}6pV1^!JdTElIr z%PM{E-Qa+U3-(H?Lu!Wwqp|P?!RZ(MCh9+c%s@nIPEsrZxxM3vSJotuyq$I0cGO(~ zig<8EBp%XITMS1)UK5Tp=K&KtDLQvhUcriK^CNV!0MZ*;>>tx$CiD?=ub1q%E-B~R zh5HJ9ivFZjqAmu;jz#vxibYu1Pxm+=0f4mmXT_xAp0n?5Y-38u%=>aXr3wD+=v2!4 zcPx^$f8fut9hNcB1B1{a<*5-6)cY>&-(qa_hY40S>icF`vCSgCQjq@x6!zGNOJTfP zJD>$~*ZU_W=F&~_>X<3bdpPBYtK4QNe>@AjbrAw#exZ?89r24<{n_tjpV)o=oYeOa z!^Qj8Usu2yT56b1nRh~;O@Ugnc9sCZMXHBcu7I*IF^mUPlIeL~(DRPAht1@>xImvg zg<!c=!h1XYi*@e@rUTHbaInG_x+m>rKx Date: Mon, 9 Sep 2024 10:21:26 -0400 Subject: [PATCH 12/46] Fix NEWS.md (#126) * hot fix to readme * Update NEWS.md * run pre-commit * Update NEWS.md (#144) * run pre-commit locally * Update NEWS.md --------- Co-authored-by: George G. Vega Yon --- NEWS.md | 21 +++++++++++---------- README.md | 6 ++---- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/NEWS.md b/NEWS.md index 615a2837..3cb700f2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,12 +1,13 @@ -# wwinference 0.0.0.9000 (dev) +# wwinference 0.0.1 (dev) -This will serve as our change-log +This is the first major release, focused on providing an initial version of the package. +Note the package is still flagged as in development, though the authors plan on using it for production work in the coming weeks. +As it's written, the package is intended to allow users to do the following: -- 2024-07-12: Add functionality to fit the wastewater-informed model to an example fitting COVID-19 hospital admissions and wastewater from a few sites -- 2024-07-19: Add an example in the vignette to fit the model to only the hospital admissions. Plus a few small tweaks to the vignette. -- 2024-08-05: Add input data validation with informative error messaging -- 2024-08-09: Add testing and additional validation of the data being passed into the model -- 2024-08-22: Update `generate_simulated_data()` function to modularize the model components, adding additional forward simulation functions. -- 2024-08-23: Added new `wwinference_fit` class with corresponding print and summary methods. -- 2024-08-30: Switch from asking users to pass in natural scale wastewater concentration data to asking them to pass in log scale data -- 2024-08-30: Fix bug in how hierarchical standard deviation in the wastewater observation model was being estimated. Update model definition. +- Provide basic functionality to fit the wastewater-informed model to an example fitting COVID-19 hospital admissions and wastewater from a few sites ([#5](https://github.com/CDCgov/ww-inference-model/issues/5)) +- Performs basic post-processing and plotting of data and modeled outputs, including calibrated, nowcasted, and forecasted count data (in the example, hospital admissions), wastewater concentrations, global R(t) estimates and subpopulation-level R(t) estimates +- Provide an example in the vignette to fit the model to only the hospital admissions ([#24](https://github.com/CDCgov/ww-inference-model/issues/24)) +- Validate input data validation with informative error messaging ([#37](https://github.com/CDCgov/ww-inference-model/issues/37), [#54](https://github.com/CDCgov/ww-inference-model/issues/54)) +- Provide a wrapper function to generate forward simulated data with user-specified variables. It calls a number of functions to perform specific model components ([#27](https://github.com/CDCgov/ww-inference-model/issues/27)) +- Contains S3 class methods applied to the output of the main model wrapper function, the `wwinference_fit` class object ([#58](https://github.com/CDCgov/ww-inference-model/issues/58)). +- Wastewater concentration data is expected to be in log scale ([#122](https://onetakeda.box.com/s/pju273g5khx3y3cwoae2zwv3e7vu03x3)). diff --git a/README.md b/README.md index e8b7b924..74d51618 100644 --- a/README.md +++ b/README.md @@ -61,10 +61,8 @@ If you run into trouble, consult the official [`cmdstanr`](https://mc-stan.org/c ## Install `wwinference` -Once `cmdstanr` and `CmdStan` are installed, the next step is to download this repository and install the package, `wwinference`. The package provides tools for specifying and running the model, and installs other needed dependencies. - -### User install - +Once `cmdstanr` and `CmdStan` are installed, the next step is to install the package, `wwinference`. +The package provides tools for specifying and running the model, and installs other needed dependencies. The package can be installed directly from github by running the following within an R session: ```R install.packages("remotes") From 494ea8875e4165a81fac808fffecc7b8ddc7fa07 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Tue, 10 Sep 2024 16:17:27 -0400 Subject: [PATCH 13/46] Update DESCRIPTION (#156) --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9ddbbe64..782ac907 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,7 @@ Authors@R: c( email = "xuk0@cdc.gov"), person(given = "George", family = "Vega Yon", - role = c("ctb"), + role = c("aut"), email = "g.vegayon@gmail.com", comment = c(ORCID = "0000-0002-3171-0844")), person(given = "Damon", From bd05d1a2ff68861a0563e980c53beb9a9bd1ce40 Mon Sep 17 00:00:00 2001 From: "George G. Vega Yon" Date: Thu, 12 Sep 2024 17:08:51 +0100 Subject: [PATCH 14/46] Adding new class and method for get_draws (#153) * Adding new class and method (expected to fail) * Addressing issues with names (expected to fail) * Adding the what parameter to the docs * Addressing final bits. Now need the test * Adding plot method as a wrapper * Adding some tests * Fixing test and setting default y=NULL in plot * Adding some lines in the vignette to explain the plot method works on wwinference_fit_draws * Addressing review comments * Typo in length function * Reverting R/sysdata.rda and ensuring tests run properly * Reverting sysdata (again) * Better print and fixing test * Fixing tests --- NAMESPACE | 9 +- R/figures.R | 24 +- R/get_draws.R | 444 ++++++++++++++++++++++++++ R/get_draws_df.R | 224 ------------- man/{get_draws_df.Rd => get_draws.Rd} | 42 ++- tests/testthat/test_ww_model.R | 63 ++++ vignettes/wwinference.Rmd | 47 +-- 7 files changed, 589 insertions(+), 264 deletions(-) create mode 100644 R/get_draws.R delete mode 100644 R/get_draws_df.R rename man/{get_draws_df.Rd => get_draws.Rd} (53%) diff --git a/NAMESPACE b/NAMESPACE index 6906d367..6adf538f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,11 +1,13 @@ # Generated by roxygen2: do not edit by hand -S3method(get_draws_df,data.frame) -S3method(get_draws_df,default) -S3method(get_draws_df,wwinference_fit) +S3method(get_draws,data.frame) +S3method(get_draws,default) +S3method(get_draws,wwinference_fit) S3method(get_model_diagnostic_flags,default) S3method(get_model_diagnostic_flags,wwinference_fit) +S3method(plot,wwinference_fit_draws) S3method(print,wwinference_fit) +S3method(print,wwinference_fit_draws) S3method(summary,wwinference_fit) export(add_pmfs) export(add_time_indexing) @@ -19,6 +21,7 @@ export(generate_simulated_data) export(get_count_data_sizes) export(get_count_indices) export(get_count_values) +export(get_draws) export(get_draws_df) export(get_ind_m) export(get_input_count_data_for_stan) diff --git a/R/figures.R b/R/figures.R index ee6b95ae..d9177b8c 100644 --- a/R/figures.R +++ b/R/figures.R @@ -30,10 +30,23 @@ get_plot_forecasted_counts <- function(draws, forecast_date, count_type = "hospital admissions", n_draws_to_plot = 100) { - sampled_draws <- sample(1:max(draws$draw), n_draws_to_plot) + n_draws_available <- max(draws$draw) + if (n_draws_available < n_draws_to_plot) { + stop( + sprintf( + "The number of draws to plot (%i) should be less or equal to ", + n_draws_to_plot + ), + sprintf( + "the number of draws in the data (%i).", + n_draws_available + ) + ) + } + + sampled_draws <- sample.int(n_draws_available, n_draws_to_plot) draws_to_plot <- draws |> dplyr::filter( - .data$name == "predicted counts", .data$draw %in% !!sampled_draws ) @@ -97,7 +110,6 @@ get_plot_ww_conc <- function(draws, draws_to_plot <- draws |> dplyr::filter( - .data$name == "predicted wastewater", .data$draw %in% !!sampled_draws ) |> dplyr::mutate( @@ -163,10 +175,9 @@ get_plot_ww_conc <- function(draws, get_plot_global_rt <- function(draws, forecast_date, n_draws_to_plot = 100) { - sampled_draws <- sample(1:max(draws$draw), n_draws_to_plot) + sampled_draws <- sample.int(max(draws$draw), n_draws_to_plot) draws_to_plot <- draws |> dplyr::filter( - .data$name == "global R(t)", .data$draw %in% !!sampled_draws ) @@ -222,10 +233,9 @@ get_plot_global_rt <- function(draws, get_plot_subpop_rt <- function(draws, forecast_date, n_draws_to_plot = 100) { - sampled_draws <- sample(1:max(draws$draw), n_draws_to_plot) + sampled_draws <- sample.int(max(draws$draw), n_draws_to_plot) draws_to_plot <- draws |> dplyr::filter( - .data$name == "subpopulation R(t)", .data$draw %in% !!sampled_draws ) diff --git a/R/get_draws.R b/R/get_draws.R new file mode 100644 index 00000000..f5035d34 --- /dev/null +++ b/R/get_draws.R @@ -0,0 +1,444 @@ +#' @title Postprocess to generate a draws dataframe +#' +#' @description +#' This function takes in the two input data sources, the CmdStan fit object, +#' and the 3 relevant mappings from stan indices to the real data, in order +#' to generate a dataframe containing the posterior draws of the counts (e.g. +#' hospital admissions), the wastewater concentration values, the "global" R(t), +#' and the "local" R(t) estimates + the critical metadata in the data. +#' This funtion has a default method that takes the two sets of input data, +#' the last of stan arguments, and the CmdStan fitting object, as well as an S3 +#' method for objects of class 'wwinference_fit' +#' +#' +#' @param x Either a dataframe of wastewater observations, or an object of +#' class wwinference_fit +#' @param ... additional arguments +#' @param what Character vector. Specifies the variables to extract from the +#' draws. It could be any from `"all"` `"predicted_counts"`, `"predicted_ww"`, +#' `"global_rt"`, or `"subpop_rt"`. When `what = "all"` (the default), +#' the function will extract all four variables. +#' @return A tibble containing the full set of posterior draws of the +#' estimated, nowcasted, and forecasted: counts, site-level wastewater +#' concentrations, "global"(e.g. state) R(t) estimate, and the "local" (site + +#' the one auxiliary subpopulation) R(t) estimates. In the instance where there +#' are observations, the data will be joined to each draw of the predicted +#' observation to facilitate plotting. +#' @export +get_draws <- function(x, ..., what = "all") { + UseMethod("get_draws") +} + +#' @rdname get_draws +#' @details +#' The function `get_draws_df()` has been deprecated in favor of `get_draws()`. +#' +#' @export +get_draws_df <- function(x, ...) { + .Deprecated("get_draws") +} + +#' S3 method for extracting posterior draws alongside data for a +#' wwinference_fit object +#' +#' This method overloads the generic `get_draws` function specifically +#' for objects of type 'wwinference_fit'. +#' +#' @rdname get_draws +#' @export +get_draws.wwinference_fit <- function(x, ..., what = "all") { + get_draws.data.frame( + x = x$raw_input_data$input_ww_data, + count_data = x$raw_input_data$input_count_data, + stan_data_list = x$stan_data_list, + fit_obj = x$fit, + what = what + ) +} + +#' @export +#' @rdname get_draws +get_draws.default <- function(x, ..., what = "all") { + stop( + "No method defined for get_draws for object of class(es) ", + paste(class(x), collapse = ", "), + ". Use directly on a wwinference_fit object or a", + "dataframe of wastewater observations.", + call. = FALSE + ) +} + +#' Vector of valid values for `what` in `get_draws` +#' @noRd +get_draws_what_ok <- c( + "all", "predicted_counts", "predicted_ww", "global_rt", "subpop_rt" +) + +#' @rdname get_draws +#' @param count_data A dataframe of the preprocessed daily count data (e.g. +#' hospital admissions) from the "global" population +#' @param stan_data_list A list containing all the data passed to stan for +#' fitting the model +#' @param fit_obj a CmdStan object that is the output of fitting the model to +#' `x` and `count_data` +#' @export +get_draws.data.frame <- function(x, + count_data, + stan_data_list, + fit_obj, + ..., + what = "all") { + # Checking we are getting all + what_ok <- get_draws_what_ok + + if (any(!what %in% what_ok)) { + idx <- which(!what %in% what_ok) + stop( + "The following invalid values were passed to `what`: ", + paste(what[idx], collapse = ", "), ". Valid values include: ", + paste(what_ok, collapse = ", "), "." + ) + } + + what_ok <- logical(length(what_ok)) + names(what_ok) <- get_draws_what_ok + what_ok[] <- FALSE + if ("all" %in% what) { + if (length(what) > 1) { + warning("Ignoring other values of `what` when `all` is present.") + } + what_ok[] <- TRUE + } else { + what_ok[what] <- TRUE + } + + draws <- fit_obj$result$draws() + + # Get the necessary mappings needed to join draws to data + date_time_spine <- tibble::tibble( + date = seq( + from = min(count_data$date), + to = min(count_data$date) + stan_data_list$ot + stan_data_list$ht, + by = "days" + ) + ) |> + dplyr::mutate(t = row_number()) + + # Lab-site index to corresponding lab, site, and site population size + lab_site_spine <- x |> + dplyr::distinct(.data$site, .data$lab, .data$lab_site_index, .data$site_pop) + + # Site index to corresponding site and subpopulation size + subpop_spine <- x |> + dplyr::distinct(.data$site, .data$site_index, .data$site_pop) |> + dplyr::mutate(site = as.factor(.data$site)) |> + dplyr::bind_rows(tibble::tibble( + site = "remainder of pop", + site_index = max(x$site_index) + 1, + site_pop = stan_data_list$subpop_size[ + length(unique(stan_data_list$subpop_size)) + ] + )) + + count_draws <- if (what_ok["predicted_counts"]) { + draws |> # predicted_counts + tidybayes::spread_draws(!!str2lang("pred_hosp[t]")) |> + dplyr::rename("pred_value" = "pred_hosp") |> + dplyr::mutate( + draw = .data$`.draw`, + ) |> + dplyr::select("t", "pred_value", "draw") |> + dplyr::left_join(date_time_spine, by = "t") |> + dplyr::left_join( + count_data |> + dplyr::select(-"t"), + by = "date" + ) |> + dplyr::ungroup() |> + dplyr::rename("observed_value" = "count") |> + dplyr::select(-"t") + } else { + NULL + } + + + ww_draws <- if (what_ok["predicted_ww"]) { + draws |> + tidybayes::spread_draws(!!str2lang("pred_ww[lab_site_index, t]")) |> + dplyr::rename("pred_value" = "pred_ww") |> + dplyr::mutate( + draw = .data$`.draw` + ) |> + dplyr::select("lab_site_index", "t", "pred_value", "draw") |> + dplyr::left_join(date_time_spine, by = "t") |> + dplyr::left_join(lab_site_spine, by = "lab_site_index") |> + dplyr::left_join( + x |> + dplyr::select(-"t"), + by = c( + "lab_site_index", "date", + "lab", "site", "site_pop" + ) + ) |> + dplyr::ungroup() |> + dplyr::mutate( + observed_value = .data$log_genome_copies_per_ml, + subpop = glue::glue("Site: {site}") + ) |> + dplyr::select(-"t") + } else { + NULL + } + + global_rt_draws <- if (what_ok["global_rt"]) { + draws |> + tidybayes::spread_draws(!!str2lang("rt[t]")) |> + dplyr::rename("pred_value" = "rt") |> + dplyr::mutate( + draw = .data$`.draw` + ) |> + dplyr::select("t", "pred_value", "draw") |> + dplyr::left_join(date_time_spine, by = "t") |> + dplyr::left_join( + count_data |> + dplyr::select(-"t"), + by = "date" + ) |> + dplyr::ungroup() |> + dplyr::rename("observed_value" = "count") |> + dplyr::select(-"t") + } else { + NULL + } + + subpop_rt_draws <- if (what_ok["subpop_rt"]) { + draws |> + tidybayes::spread_draws(!!str2lang("r_site_t[site_index, t]")) |> + dplyr::rename("pred_value" = "r_site_t") |> + dplyr::mutate( + draw = .data$`.draw`, + pred_value = .data$pred_value + ) |> + dplyr::select("site_index", "t", "pred_value", "draw") |> + dplyr::left_join(date_time_spine, by = "t") |> + dplyr::left_join(subpop_spine, by = "site_index") |> + dplyr::ungroup() |> + dplyr::mutate( + subpop = ifelse(.data$site != "remainder of pop", + glue::glue("Site: {site}"), "remainder of pop" + ) + ) |> + dplyr::select(-"t") + } else { + NULL + } + + return( + new_wwinference_fit_draws( + predicted_counts = count_draws, + predicted_ww = ww_draws, + global_rt = global_rt_draws, + subpop_rt = subpop_rt_draws + ) + ) +} + +#' @export +print.wwinference_fit_draws <- function(x, ...) { + # Computing the draws + draws <- c( + ifelse(length(x$predicted_counts) > 0, max(x$predicted_counts$draw), 0), + ifelse(length(x$predicted_ww) > 0, max(x$predicted_ww$draw), 0), + ifelse(length(x$global_rt) > 0, max(x$global_rt$draw), 0), + ifelse(length(x$subpop_rt) > 0, max(x$subpop_rt$draw), 0) + ) |> max() + + timepoints <- c( + ifelse( + length(x$predicted_counts) > 0, diff(range(x$predicted_counts$date)), 0 + ), + ifelse( + length(x$predicted_ww) > 0, diff(range(x$predicted_ww$date)), 0 + ), + ifelse( + length(x$global_rt) > 0, diff(range(x$global_rt$date)), 0 + ), + ifelse( + length(x$subpop_rt) > 0, diff(range(x$subpop_rt$date)), 0 + ) + ) |> max() + + cat( + sprintf( + "Draws from the model featuring %i draws across %i days ", + draws, timepoints + ), + "in the following datasets:\n" + ) # Same draws and timepoints + + if (length(x$predicted_counts)) { + cat( + sprintf( + " - `$predicted_counts` with %i rows\n", + nrow(x$predicted_counts) + ) + ) + } + + if (length(x$predicted_ww)) { + cat( + sprintf( + " - `$predicted_ww` with %i rows across %i sites.\n", + nrow(x$predicted_ww), + length(unique(x$predicted_ww$lab_site_index)) + ) + ) + } + if (length(x$global_rt)) { + cat( + sprintf( + " - `$global_rt` with %i rows\n", + nrow(x$global_rt) + ) + ) + } + if (length(x$subpop_rt)) { + cat( + sprintf( + " - `$subpop_rt` with %i rows across %i sub-populations\n", + nrow(x$subpop_rt), + length(unique(x$subpop_rt$subpop)) + ) + ) + } + + cat("You can use $ to access the datasets.\n") + + invisible(x) +} + +#' Constructor for the new_wwinference_fit_draws +#' +#' Constructor running some checks on the contents of the data. +#' +#' @param predicted_counts Predicted counts +#' @param predicted_ww Predicted ww concentration +#' @param global_rt Global Rt() +#' @param site_level_r Site-level Rt()s +#' @noRd +new_wwinference_fit_draws <- function( + predicted_counts, + predicted_ww, + global_rt, + subpop_rt) { + # Checking colnames: Must match all exactly + predicted_counts_colnames <- c( + "date", "draw", "observed_value", "pred_value", "total_pop" + ) + if (length(predicted_counts)) { + checkmate::assert_names( + colnames(predicted_counts), + permutation.of = predicted_counts_colnames + ) + } + + predicted_ww_colnames <- c( + "below_lod", "date", "draw", "exclude", "flag_as_ww_outlier", + "lab", "lab_site_index", "lab_site_name", "log_genome_copies_per_ml", + "log_lod", "observed_value", "pred_value", "site", "site_index", + "site_pop", "subpop" + ) + if (length(predicted_ww)) { + checkmate::assert_names( + colnames(predicted_ww), + permutation.of = predicted_ww_colnames + ) + } + + global_rt_colnames <- c( + "date", "draw", "observed_value", "pred_value", "total_pop" + ) + if (length(global_rt)) { + checkmate::assert_names( + colnames(global_rt), + permutation.of = global_rt_colnames + ) + } + + subpop_rt_colnames <- c( + "date", "draw", "pred_value", "site", "site_index", "site_pop", + "subpop" + ) + if (length(subpop_rt)) { + checkmate::assert_names( + colnames(subpop_rt), + permutation.of = subpop_rt_colnames + ) + } + + structure( + list( + predicted_counts = predicted_counts, + predicted_ww = predicted_ww, + global_rt = global_rt, + subpop_rt = subpop_rt + ), + class = "wwinference_fit_draws" + ) +} + +#' @export +#' @rdname get_draws +#' @param x An object of class `get_draws`. +#' @param y Ignored in the the case of `plot`. +#' @details +#' The plot method for `wwinference_fit_draws` is a wrapper of +#' `get_plot_forecasted_counts`, `get_plot_ww_conc`, `get_plot_global_rt`, +#' and `get_plot_subpop_rt`. Depending on the value of `what`, the function +#' will call the appropriate method. +#' +plot.wwinference_fit_draws <- function(x, y = NULL, what, ...) { + if (length(what) != 1L) { + stop( + "The value provided to `what` must be a length one character vector. ", + "Currently, it is of length ", length(what), "." + ) + } + + which_what_are_ok <- setdiff(get_draws_what_ok, "all") + + if (!what %in% which_what_are_ok) { + stop( + sprintf( + paste0( + "The value provided to what (%s) is invalid. ", + "Valid values include \"%s\"." + ), + paste(what, collapse = ", "), + paste(which_what_are_ok, collapse = "\", \"") + ) + ) + } + + if (what == "predicted_counts") { + get_plot_forecasted_counts( + draws = x$predicted_counts, + ... + ) + } else if (what == "predicted_ww") { + get_plot_ww_conc( + x$predicted_ww, + ... + ) + } else if (what == "global_rt") { + get_plot_global_rt( + x$global_rt, + ... + ) + } else if (what == "subpop_rt") { + get_plot_subpop_rt( + x$subpop_rt, + ... + ) + } +} diff --git a/R/get_draws_df.R b/R/get_draws_df.R deleted file mode 100644 index 60d2eebe..00000000 --- a/R/get_draws_df.R +++ /dev/null @@ -1,224 +0,0 @@ -#' @title Postprocess to generate a draws dataframe -#' -#' @description -#' This function takes in the two input data sources, the CmdStan fit object, -#' and the 3 relevant mappings from stan indices to the real data, in order -#' to generate a dataframe containing the posterior draws of the counts (e.g. -#' hospital admissions), the wastewater concentration values, the "global" R(t), -#' and the "local" R(t) estimates + the critical metadata in the data. -#' This funtion has a default method that takes the two sets of input data, -#' the last of stan arguments, and the CmdStan fitting object, as well as an S3 -#' method for objects of class 'wwinference_fit' -#' -#' -#' @param x Either a dataframe of wastewater observations, or an object of -#' class wwinference_fit -#' @param count_data A dataframe of the preprocessed daily count data (e.g. -#' hospital admissions) from the "global" population -#' @param stan_data_list A list containing all the data passed to stan for -#' fitting the model -#' @param fit_obj a CmdStan object that is the output of fitting the model to -#' `x` and `count_data` -#' @param ... additional arguments -#' @return A tibble containing the full set of posterior draws of the -#' estimated, nowcasted, and forecasted: counts, site-level wastewater -#' concentrations, "global"(e.g. state) R(t) estimate, and the "local" (site + -#' the one auxiliary subpopulation) R(t) estimates. In the instance where there -#' are observations, the data will be joined to each draw of the predicted -#' observation to facilitate plotting. -#' @export -get_draws_df <- function(x, ...) { - UseMethod("get_draws_df") -} - -#' S3 method for extracting posterior draws alongside data for a -#' wwinference_fit object -#' -#' This method overloads the generic get_draws_df function specifically -#' for objects of type 'wwinference_fit'. -#' -#' @rdname get_draws_df -#' @export -get_draws_df.wwinference_fit <- function(x, ...) { - get_draws_df.data.frame( - x = x$raw_input_data$input_ww_data, - count_data = x$raw_input_data$input_count_data, - stan_data_list = x$stan_data_list, - fit_obj = x$fit - ) -} - -#' @export -#' @rdname get_draws_df -get_draws_df.default <- function(x, ...) { - stop( - "No method defined for get_draws_df for object of class(es) ", - paste(class(x), collapse = ", "), - ". Use directly on a wwinference_fit object or a", - "dataframe of wastewater observations.", - call. = FALSE - ) -} - -#' @rdname get_draws_df -#' @export -get_draws_df.data.frame <- function(x, - count_data, - stan_data_list, - fit_obj, - ...) { - draws <- fit_obj$result$draws() - - # Get the necessary mappings needed to join draws to data - date_time_spine <- tibble::tibble( - date = seq( - from = min(count_data$date), - to = min(count_data$date) + stan_data_list$ot + stan_data_list$ht, - by = "days" - ) - ) |> - dplyr::mutate(t = row_number()) - # Lab-site index to corresponding lab, site, and site population size - lab_site_spine <- x |> - dplyr::distinct(.data$site, .data$lab, .data$lab_site_index, .data$site_pop) - # Site index to corresponding site and subpopulation size - subpop_spine <- x |> - dplyr::distinct(.data$site, .data$site_index, .data$site_pop) |> - dplyr::mutate(site = as.factor(.data$site)) |> - dplyr::bind_rows(tibble::tibble( - site = "remainder of pop", - site_index = max(x$site_index) + 1, - site_pop = stan_data_list$subpop_size[ - length(unique(stan_data_list$subpop_size)) - ] - )) - - - count_draws <- draws |> - tidybayes::spread_draws(!!str2lang("pred_hosp[t]")) |> - dplyr::rename("pred_value" = "pred_hosp") |> - dplyr::mutate( - draw = .data$`.draw`, - name = "predicted counts" - ) |> - dplyr::select("name", "t", "pred_value", "draw") |> - dplyr::left_join(date_time_spine, by = "t") |> - dplyr::left_join( - count_data |> - dplyr::select(-"t"), - by = "date" - ) |> - dplyr::ungroup() |> - dplyr::rename("observed_value" = "count") |> - dplyr::mutate( - observation_type = "count", - type_of_quantity = "global", - lab_site_index = NA, - subpop = NA, - lab = NA, - site_pop = NA, - below_lod = NA, - log_lod = NA, - flag_as_ww_outlier = NA, - exclude = NA - ) |> - dplyr::select(-"t") - - ww_draws <- draws |> - tidybayes::spread_draws(!!str2lang("pred_ww[lab_site_index, t]")) |> - dplyr::rename("pred_value" = "pred_ww") |> - dplyr::mutate( - draw = .data$`.draw`, - name = "predicted wastewater", - ) |> - dplyr::select("name", "lab_site_index", "t", "pred_value", "draw") |> - dplyr::left_join(date_time_spine, by = "t") |> - dplyr::left_join(lab_site_spine, by = "lab_site_index") |> - dplyr::left_join( - x |> - dplyr::select(-"t"), - by = c( - "lab_site_index", "date", - "lab", "site", "site_pop" - ) - ) |> - dplyr::ungroup() |> - dplyr::mutate(observed_value = .data$log_genome_copies_per_ml) |> - dplyr::mutate( - observation_type = "log genome copies per mL", - type_of_quantity = "local", - total_pop = NA, - subpop = glue::glue("Site: {site}") - ) |> - dplyr::select(colnames(count_draws), -"t") - - global_rt_draws <- draws |> - tidybayes::spread_draws(!!str2lang("rt[t]")) |> - dplyr::rename("pred_value" = "rt") |> - dplyr::mutate( - draw = .data$`.draw`, - name = "global R(t)" - ) |> - dplyr::select("name", "t", "pred_value", "draw") |> - dplyr::left_join(date_time_spine, by = "t") |> - dplyr::left_join( - count_data |> - dplyr::select(-"t"), - by = "date" - ) |> - dplyr::ungroup() |> - dplyr::rename("observed_value" = "count") |> - dplyr::mutate( - observed_value = NA, - observation_type = "latent variable", - type_of_quantity = "global", - lab_site_index = NA, - subpop = NA, - lab = NA, - site_pop = NA, - below_lod = NA, - log_lod = NA, - flag_as_ww_outlier = NA, - exclude = NA - ) |> - dplyr::select(-"t") - - site_level_rt_draws <- draws |> - tidybayes::spread_draws(!!str2lang("r_site_t[site_index, t]")) |> - dplyr::rename("pred_value" = "r_site_t") |> - dplyr::mutate( - draw = .data$`.draw`, - name = "subpopulation R(t)", - pred_value = .data$pred_value - ) |> - dplyr::select("name", "site_index", "t", "pred_value", "draw") |> - dplyr::left_join(date_time_spine, by = "t") |> - dplyr::left_join(subpop_spine, by = "site_index") |> - dplyr::ungroup() |> - dplyr::mutate( - observed_value = NA, - lab_site_index = NA, - lab = NA, - below_lod = NA, - log_lod = NA, - flag_as_ww_outlier = NA, - exclude = NA, - observation_type = "latent variable", - type_of_quantity = "local", - total_pop = NA, - subpop = ifelse(.data$site != "remainder of pop", - glue::glue("Site: {site}"), "remainder of pop" - ) - ) |> - dplyr::select(colnames(count_draws), -"t") - - all_draws_df <- dplyr::bind_rows( - count_draws, - ww_draws, - global_rt_draws, - site_level_rt_draws - ) - - - return(all_draws_df) -} diff --git a/man/get_draws_df.Rd b/man/get_draws.Rd similarity index 53% rename from man/get_draws_df.Rd rename to man/get_draws.Rd index ee6ec13a..3cc3a46f 100644 --- a/man/get_draws_df.Rd +++ b/man/get_draws.Rd @@ -1,26 +1,36 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_draws_df.R -\name{get_draws_df} +% Please edit documentation in R/get_draws.R +\name{get_draws} +\alias{get_draws} \alias{get_draws_df} -\alias{get_draws_df.wwinference_fit} -\alias{get_draws_df.default} -\alias{get_draws_df.data.frame} +\alias{get_draws.wwinference_fit} +\alias{get_draws.default} +\alias{get_draws.data.frame} +\alias{plot.wwinference_fit_draws} \title{Postprocess to generate a draws dataframe} \usage{ +get_draws(x, ..., what = "all") + get_draws_df(x, ...) -\method{get_draws_df}{wwinference_fit}(x, ...) +\method{get_draws}{wwinference_fit}(x, ..., what = "all") + +\method{get_draws}{default}(x, ..., what = "all") -\method{get_draws_df}{default}(x, ...) +\method{get_draws}{data.frame}(x, count_data, stan_data_list, fit_obj, ..., what = "all") -\method{get_draws_df}{data.frame}(x, count_data, stan_data_list, fit_obj, ...) +\method{plot}{wwinference_fit_draws}(x, y = NULL, what, ...) } \arguments{ -\item{x}{Either a dataframe of wastewater observations, or an object of -class wwinference_fit} +\item{x}{An object of class \code{get_draws}.} \item{...}{additional arguments} +\item{what}{Character vector. Specifies the variables to extract from the +draws. It could be any from \code{"all"} \code{"predicted_counts"}, \code{"predicted_ww"}, +\code{"global_rt"}, or \code{"subpop_rt"}. When \code{what = "all"} (the default), +the function will extract all four variables.} + \item{count_data}{A dataframe of the preprocessed daily count data (e.g. hospital admissions) from the "global" population} @@ -29,6 +39,8 @@ fitting the model} \item{fit_obj}{a CmdStan object that is the output of fitting the model to \code{x} and \code{count_data}} + +\item{y}{Ignored in the the case of \code{plot}.} } \value{ A tibble containing the full set of posterior draws of the @@ -48,6 +60,14 @@ This funtion has a default method that takes the two sets of input data, the last of stan arguments, and the CmdStan fitting object, as well as an S3 method for objects of class 'wwinference_fit' -This method overloads the generic get_draws_df function specifically +This method overloads the generic \code{get_draws} function specifically for objects of type 'wwinference_fit'. } +\details{ +The function \code{get_draws_df()} has been deprecated in favor of \code{get_draws()}. + +The plot method for \code{wwinference_fit_draws} is a wrapper of +\code{get_plot_forecasted_counts}, \code{get_plot_ww_conc}, \code{get_plot_global_rt}, +and \code{get_plot_subpop_rt}. Depending on the value of \code{what}, the function +will call the appropriate method. +} diff --git a/tests/testthat/test_ww_model.R b/tests/testthat/test_ww_model.R index e7c77c4c..0e9b90b6 100644 --- a/tests/testthat/test_ww_model.R +++ b/tests/testthat/test_ww_model.R @@ -62,4 +62,67 @@ test_that("Test the wastewater inference model on simulated data.", { tolerance = 0.0001 ) } + + # Testing draws + model_draws <- get_draws(fit) + expect_length(model_draws, 4) + + expect_error(get_draws(fit, what = "something else")) + + # Getting a forecast date + forecast_date <- model_draws$predicted_counts$date + forecast_date <- min(forecast_date) + floor(diff(range(forecast_date)) * .75) + + # Extracting the observed data for the plots + count_data_eval <- model_draws$predicted_counts |> + dplyr::select(observed_value, date) + + expect_true( + inherits( + plot( + model_draws, + what = "predicted_counts", + forecast_date = forecast_date, + n_draws_to_plot = model_test_data$fit_opts$iter_sampling, + count_data_eval = count_data_eval, + count_data_eval_col_name = "observed_value" + ), + "ggplot" + ) + ) + expect_true( + inherits( + plot( + model_draws, + what = "predicted_ww", + forecast_date = forecast_date, + n_draws_to_plot = model_test_data$fit_opts$iter_sampling + ), + "ggplot" + ) + ) + expect_true( + inherits( + plot( + model_draws, + what = "global_rt", + forecast_date = forecast_date, + n_draws_to_plot = model_test_data$fit_opts$iter_sampling + ), + "ggplot" + ) + ) + expect_true( + inherits( + plot( + model_draws, + what = "subpop_rt", + forecast_date = forecast_date, + n_draws_to_plot = model_test_data$fit_opts$iter_sampling + ), + "ggplot" + ) + ) + + expect_error(plot(model_draws, what = "something else")) }) diff --git a/vignettes/wwinference.Rmd b/vignettes/wwinference.Rmd index 347f9838..516206d3 100644 --- a/vignettes/wwinference.Rmd +++ b/vignettes/wwinference.Rmd @@ -377,17 +377,13 @@ state-level R(t) estimate. We can generate this directly on the output of `wwinference()` using: ```{r extracting-draws} -draws_df <- get_draws_df(ww_fit) +draws_df <- get_draws(ww_fit) -cat( - "Variables in dataframe: ", - sprintf("%s", paste(unique(draws_df$name), collapse = ", ")) -) +print(draws_df) ``` -Note that by default the `get_draws_df()` function will return a tidy long -dataframe with all of the posterior draws joined to applicable data for each of -the included variables. To examine a particular variable (e.g. `"predicted counts"` for posterior -predicted hospital admissions), filter the data frame based on the `name` column. + +Note that by default the `get_draws()` function will return a list of class `wwinference_fit_draws` all of the posterior draws for predicted hospitalizations, wastewater concentration, global, and site Rt estimates. To examine a particular variable (e.g. `"predicted counts"` for posterior +predicted hospital admissions), access the corresponding tibble using the `$` operator. ### Using explicit passed arguments rather than S3 methods @@ -395,8 +391,8 @@ Rather than using S3 methods supplied for `wwinference()`, the elements in the `wwinference_fit` object can also be used directly to create this dataframe. This is demonstrated below: -```{r extracting-draws-explicit} -draws_df_explicit <- get_draws_df( +```{r extracting-draws-explicit, eval = FALSE} +draws_df_explicit <- get_draws( x = ww_fit$raw_input_data$input_ww_data, count_data = ww_fit$raw_input_data$input_count_data, stan_data_list = ww_fit$stan_data_list, @@ -413,26 +409,39 @@ visualize data that was below the LOD (even though the fit incorporated them via the censored observation process.) ```{r generating-figures, out.width='100%'} -draws_df <- get_draws_df(ww_fit) - plot_hosp <- get_plot_forecasted_counts( - draws = draws_df, + draws = draws_df$predicted_counts, count_data_eval = hosp_data_eval, count_data_eval_col_name = "daily_hosp_admits_for_eval", forecast_date = forecast_date ) plot_hosp -plot_ww <- get_plot_ww_conc(draws_df, forecast_date) +plot_ww <- get_plot_ww_conc(draws_df$predicted_ww, forecast_date) plot_ww -plot_state_rt <- get_plot_global_rt(draws_df, forecast_date) +plot_state_rt <- get_plot_global_rt(draws_df$global_rt, forecast_date) plot_state_rt -plot_subpop_rt <- get_plot_subpop_rt(draws_df, forecast_date) +plot_subpop_rt <- get_plot_subpop_rt(draws_df$subpop_rt, forecast_date) plot_subpop_rt ``` +The previous three are equivalent to calling the `plot` method of `wwinference_fit_draws` using the `what` argument: + +```r +plot( + draws = draws_df, + what = "predicted_counts", + count_data_eval = hosp_data_eval, + count_data_eval_col_name = "daily_hosp_admits_for_eval", + forecast_date = forecast_date +) +plot(draws_df, what = "predicted_ww", forecast_date = forecast_date) +plot(draws_df, what = "global_rt", forecast_date = forecast_date) +plot(draws_df, what = "subpop_rt", forecast_date = forecast_date) +``` + ## Diagnostics We strongly recommend running diagnostics as a post-processing step on the @@ -516,9 +525,9 @@ fit_hosp_only <- wwinference::wwinference( ``` ```{r plot-hosp-only, out.width='100%'} -draws_df_hosp_only <- get_draws_df(fit_hosp_only) +draws_df_hosp_only <- get_draws(fit_hosp_only) plot_hosp_hosp_only <- get_plot_forecasted_counts( - draws = draws_df_hosp_only, + draws = draws_df_hosp_only$predicted_counts, count_data_eval = hosp_data_eval, count_data_eval_col_name = "daily_hosp_admits_for_eval", forecast_date = forecast_date From 50120bf87bb9e97c383144c785495cae0d4757a9 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Thu, 12 Sep 2024 13:28:37 -0400 Subject: [PATCH 15/46] Add contributors (#160) --- DESCRIPTION | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 782ac907..da43b491 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,25 @@ Authors@R: c( person(given = "Scott", family = "Olesen", role = c("aut"), - email = "ulp7@cdc.gov") + email = "ulp7@cdc.gov"), + person(given = "Adam", + family = "Howes", + role = c("ctb"), + email = "adamthowes@gmail.com", + comment = c(ORCID = "0000-0003-2386-4031")), + person(given = "Chirag", + family = "Kumar", + role = c("ctb"), + email = "kzs9@cdc.gov"), + person(given = "Alexander", + family = "Keyel", + role = c("ctb"), + email = "alexander.keyel@health.ny.gov", + comment = c(ORCID = "000-0001-5256-6274")), + person(given = "Hannah", + family = "Cohen", + role = c("ctb"), + email = "llg4@cdc.gov") ) Description: An implementation of a hierarchical semi-mechanistic renewal approach jointly calibrating to multiple wastewater concentrations datasets from From 40a9182b3b57f4caed465621b80eb1b9cdae3c09 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Fri, 13 Sep 2024 14:16:37 -0400 Subject: [PATCH 16/46] 163 expand R version (#164) --- .github/workflows/r-cmd-check.yaml | 6 ++++-- DESCRIPTION | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.github/workflows/r-cmd-check.yaml b/.github/workflows/r-cmd-check.yaml index 65f3caee..3ebfae2d 100644 --- a/.github/workflows/r-cmd-check.yaml +++ b/.github/workflows/r-cmd-check.yaml @@ -7,13 +7,15 @@ on: jobs: check-package: + strategy: + matrix: + r-version: ["4.1.0", "release"] runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - - uses: actions/checkout@v4 - uses: r-lib/actions/setup-r@v2 with: - r-version: "release" + r-version: ${{matrix.r-version}} use-public-rspm: true extra-repositories: "https://mc-stan.org/r-packages/" - name: "Set up dependencies for wwinference" diff --git a/DESCRIPTION b/DESCRIPTION index da43b491..3b4b35ff 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -72,7 +72,7 @@ License: Apache License (>= 2) URL: https://github.com/cdcgov/ww-inference-model/, https://cdcgov.github.io/ww-inference-model/ BugReports: https://github.com/cdcgov/ww-inference-model/issues/ Depends: - R (>= 4.3.0) + R (>= 4.1.0) SystemRequirements: CmdStan (>=2.35.0) Encoding: UTF-8 Roxygen: list(markdown = TRUE) From 83a42028cbbfa7f8b5b1f5712cbdebf4aae4203c Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Fri, 13 Sep 2024 20:25:06 -0400 Subject: [PATCH 17/46] Add hex logo to repo (#148) * update readme with logo * swap to svg * use use package * adjust size and remove extra text * try adding new logo * fix title * fix title again * delete old logos --- README.md | 2 +- man/figures/logo.svg | 211 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 212 insertions(+), 1 deletion(-) create mode 100644 man/figures/logo.svg diff --git a/README.md b/README.md index 74d51618..7f49053c 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# `wwinference`: joint inference and forecasting from wastewater and epidemiological indicators +# `wwinference`: joint inference and forecasting
from wastewater and epidemiological indicators wwinference website > [!CAUTION] > This project is a work-in-progress. Despite this project's early stage, all development is in public as part of the Center for Forecasting and Outbreak Analytics' goals around open development. Questions and suggestions are welcome through GitHub issues or a PR. diff --git a/man/figures/logo.svg b/man/figures/logo.svg new file mode 100644 index 00000000..30660d2c --- /dev/null +++ b/man/figures/logo.svg @@ -0,0 +1,211 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From 7a615c843759f7e6ff9484267f9d370e24edce6b Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Mon, 16 Sep 2024 10:44:38 -0400 Subject: [PATCH 18/46] Various bug fixes (#128) --- R/checkers.R | 65 ++++++++++--- R/data.R | 6 ++ R/get_draws.R | 65 +++++++++++-- R/get_stan_data.R | 3 +- R/model_component_fwd_sim.R | 3 +- R/preprocessing.R | 2 +- R/sysdata.rda | Bin 38039 -> 38164 bytes R/validate.R | 21 +++- data-raw/vignette_data.R | 15 ++- data/hosp_data.rda | Bin 509 -> 586 bytes data/hosp_data_eval.rda | Bin 593 -> 615 bytes data/true_global_rt.rda | Bin 2189 -> 2187 bytes data/ww_data.rda | Bin 1545 -> 1663 bytes man/.DS_Store | Bin 0 -> 6148 bytes man/assert_cols_det_unique_row.Rd | 36 +++++++ ...nt.Rd => assert_req_count_cols_present.Rd} | 6 +- man/assert_sufficient_days_of_data.Rd | 5 + man/format_ww_data.Rd | 3 +- man/hosp_data.Rd | 5 +- man/ww_data.Rd | 3 + man/wwinference-package.Rd | 6 +- tests/testthat/test_checkers.R | 6 +- tests/testthat/test_get_stan_data.R | 23 +++++ tests/testthat/test_preprocess_ww_data.R | 90 +++++++++++++++++- vignettes/wwinference.Rmd | 6 +- 25 files changed, 329 insertions(+), 40 deletions(-) create mode 100644 man/.DS_Store create mode 100644 man/assert_cols_det_unique_row.Rd rename man/{check_req_count_cols_present.Rd => assert_req_count_cols_present.Rd} (92%) diff --git a/R/checkers.R b/R/checkers.R index 4e28959b..3011baa8 100644 --- a/R/checkers.R +++ b/R/checkers.R @@ -211,6 +211,46 @@ assert_no_repeated_elements <- function(x, arg = "x", invisible() } +#' Check a set of columns in a data frame uniquely identify +#' data frame rows. +#' +#' @description +#' Equivalently, this checks that when grouping by the columns in question, +#' each group has a single entry +#' +#' @param df the dataframe to check +#' @param unique_key_columns Columns that, taken together, should +#' uniquely identify a row in the data frame. +#' @param arg the name of the unique grouping to check +#' @param call Calling environment to be passed to [cli::cli_abort()] for +#' traceback. +#' @param add_err_msg string containing an additional error message, +#' default is the empty string (`""`) +#' +#' @return NULL, invisibly +assert_cols_det_unique_row <- function(df, + unique_key_columns, + arg = "x", + call = rlang::caller_env(), + add_err_msg = "") { + duplicated_rows <- df |> dplyr::filter(dplyr::n() > 1, + .by = {{ unique_key_columns }} + ) + + if (nrow(duplicated_rows) != 0) { + cli::cli_abort( + c("The data has more than one observation per {.arg {arg}}", + add_err_msg, + "i" = "Multiple observations in a {.arg {arg}} are not", + "currently supported." + ), + call = call, + class = "wwinference_input_data_error" + ) + } + invisible() +} + #' Assert that a vector is either of a vector of integers or a vector of @@ -347,19 +387,15 @@ assert_req_ww_cols_present <- function(ww_data, #' traceback. #' #' @return NULL, invisibly -check_req_count_cols_present <- function(count_data, - count_col_name, - pop_size_col_name, - add_req_col_names = c("date"), - call = rlang::caller_env()) { +assert_req_count_cols_present <- function(count_data, + count_col_name, + pop_size_col_name, + add_req_col_names = c("date"), + call = rlang::caller_env()) { column_names <- colnames(count_data) expected_col_names <- c( - { - count_col_name - }, - { - pop_size_col_name - }, + count_col_name, + pop_size_col_name, add_req_col_names ) @@ -491,6 +527,9 @@ assert_daily_data <- function(dates, #' calibration time #' #' @param date_vector the vector of dates to check, must be of Date type +#' @param data_name What data correspond to the dates in `date_vector`. +#' Used to make the error message informative (e.g. +#' "hospital admissions data") #' @param calibration_time integer indicating the number of days that #' the dates must span #' @param call Calling environment to be passed to [cli::cli_abort()] for @@ -500,6 +539,7 @@ assert_daily_data <- function(dates, #' #' @return NULL invisible assert_sufficient_days_of_data <- function(date_vector, + data_name, calibration_time, call = rlang::caller_env(), add_err_msg = "") { @@ -511,7 +551,8 @@ assert_sufficient_days_of_data <- function(date_vector, if (!check_sufficient_data) { cli::cli_abort( c( - "Insufficient data for specified calibration time" + "Insufficient {.arg {data_name}} for the specified calibration time. ", + add_err_msg ), call = call, class = "wwinference_specification_error" diff --git a/R/data.R b/R/data.R index 1353776e..b196dcf6 100644 --- a/R/data.R +++ b/R/data.R @@ -32,6 +32,9 @@ #' units of log estimated genome copies per mL.} #' \item{site_pop}{The population size of the wastewater catchment area #' represented by the site variable} +#' \item{location}{ A string indicating the location that all of the +#' data is coming from. This is not a necessary column, but instead is +#' included to more realistically mirror a typical workflow} #' } #' @source vignette_data.R "ww_data" @@ -66,6 +69,9 @@ #' hospital on that date, available as of the forecast date} #' \item{state_pop}{The number of people contributing to the daily hospital #' admissions} +#' \item{location}{ A string indicating the location that all of the +#' data is coming from. This is not a necessary column, but instead is +#' included to more realistically mirror a typical workflow} #' } #' @source vignette_data.R "hosp_data" diff --git a/R/get_draws.R b/R/get_draws.R index f5035d34..c029726f 100644 --- a/R/get_draws.R +++ b/R/get_draws.R @@ -156,7 +156,13 @@ get_draws.data.frame <- function(x, ) |> dplyr::ungroup() |> dplyr::rename("observed_value" = "count") |> - dplyr::select(-"t") + dplyr::select( + "date", + "draw", + "observed_value", + "pred_value", + "total_pop" + ) } else { NULL } @@ -185,7 +191,24 @@ get_draws.data.frame <- function(x, observed_value = .data$log_genome_copies_per_ml, subpop = glue::glue("Site: {site}") ) |> - dplyr::select(-"t") + dplyr::select( + "below_lod", + "date", + "draw", + "exclude", + "flag_as_ww_outlier", + "lab", + "lab_site_index", + "lab_site_name", + "log_genome_copies_per_ml", + "log_lod", + "observed_value", + "pred_value", + "site", + "site_index", + "site_pop", + "subpop" + ) } else { NULL } @@ -206,7 +229,13 @@ get_draws.data.frame <- function(x, ) |> dplyr::ungroup() |> dplyr::rename("observed_value" = "count") |> - dplyr::select(-"t") + dplyr::select( + "date", + "draw", + "observed_value", + "pred_value", + "total_pop" + ) } else { NULL } @@ -228,7 +257,15 @@ get_draws.data.frame <- function(x, glue::glue("Site: {site}"), "remainder of pop" ) ) |> - dplyr::select(-"t") + dplyr::select( + "date", + "draw", + "pred_value", + "site", + "site_index", + "site_pop", + "subpop" + ) } else { NULL } @@ -343,10 +380,22 @@ new_wwinference_fit_draws <- function( } predicted_ww_colnames <- c( - "below_lod", "date", "draw", "exclude", "flag_as_ww_outlier", - "lab", "lab_site_index", "lab_site_name", "log_genome_copies_per_ml", - "log_lod", "observed_value", "pred_value", "site", "site_index", - "site_pop", "subpop" + "below_lod", + "date", + "draw", + "exclude", + "flag_as_ww_outlier", + "lab", + "lab_site_index", + "lab_site_name", + "log_genome_copies_per_ml", + "log_lod", + "observed_value", + "pred_value", + "site", + "site_index", + "site_pop", + "subpop" ) if (length(predicted_ww)) { checkmate::assert_names( diff --git a/R/get_stan_data.R b/R/get_stan_data.R index 3e72d953..c63e4aa6 100644 --- a/R/get_stan_data.R +++ b/R/get_stan_data.R @@ -14,7 +14,7 @@ get_input_count_data_for_stan <- function(preprocessed_count_data, input_count_data_filtered <- preprocessed_count_data |> dplyr::filter( - .data$date > last_count_data_date - lubridate::days(!!calibration_time) + .data$date > !!last_count_data_date - lubridate::days(!!calibration_time) ) count_data <- add_time_indexing(input_count_data_filtered) @@ -674,6 +674,7 @@ get_ww_values <- function(ww_data, # Get the vector of log wastewater concentrations log_conc <- ww_data |> dplyr::pull({{ ww_measurement_col_name }}) + ww_values <- list( ww_lod = ww_lod, pop_ww = pop_ww, diff --git a/R/model_component_fwd_sim.R b/R/model_component_fwd_sim.R index c0d032f8..b5449646 100644 --- a/R/model_component_fwd_sim.R +++ b/R/model_component_fwd_sim.R @@ -339,7 +339,8 @@ downsample_ww_obs <- function(log_conc_lab_site, #' site combination #' #' @return a tidy dataframe containing observed wastewater concentrations -#' in log genome copies per mL for each site and lab at each time point +#' in log estimated genome copies per mL for each site and lab at each time +#' point format_ww_data <- function(log_obs_conc_lab_site, ot, ht, diff --git a/R/preprocessing.R b/R/preprocessing.R index db622e95..1a8838df 100644 --- a/R/preprocessing.R +++ b/R/preprocessing.R @@ -112,7 +112,7 @@ preprocess_count_data <- function(count_data, count_col_name = "daily_hosp_admits", pop_size_col_name = "state_pop") { # This checks that we have all the right column names - check_req_count_cols_present( + assert_req_count_cols_present( count_data, count_col_name, pop_size_col_name diff --git a/R/sysdata.rda b/R/sysdata.rda index 69b428117c2b7062b5b92c766ab6d995d2a310b0..beb919b8985998bbb58200e9b96fc75b512d9fa4 100644 GIT binary patch literal 38164 zcmd41WmqK3wgp%?-MG`ZySqCy?$Wq>Sbjk~+MyL;nqjk`Mx-RGQp-@D(NnK$!e zzS&=qnU#?d8M)TlD|S&Opk~5O&#y|Npt{LVmGyHI0&f5S;KxU#{jmc8)lr;#TU-EuEP?jD-Ml$Dg4%%2ow+yRthu{z zHorl%Z&^baYhA!OB?7Ls6!>F{FSs~fbJa_>gSw1B(VkNR4O7gxwU`p`9!iYeh<%D8$g5`aP z>&5GIfMa6h6upZ~2_R<>vOb=O!DNm*OP9d}+)n`mgbzf-8wmhJpPgNRpJl+*C4~W< zl$63`0xse`Bbk&Gj$a^&L;*wOO(^2c1i}YMB1uM%V4$ZjPf^TB5`iA~MG9b=%eS0j0(7dtX9Bnd z|1;!ACky~!1`lBJyZguA6j0WjlFYk|XOWzIUN^X8Qg{RmfWd%iMi6g?P?97`kk0@b zeg;X9KPDuX4_u1DVA$8h)H^(hP%<2EI(P`3BpksXfS6gVm?bCm<5ji?+WQvVgm897 zMnOgv90`8rYY`I&f1HS(x-!r0$@6X;(C@8 zUG!u+DJlPD$xptzqmbtz)zc~o z6u7(UYici4-J*N$_%42O+^#$i#zN+3k$N>+iri?(rD1`KJ*SmBoDgez&b-tt{2mgX zJ=ecO*<(?iaYC%5JO5f$uF}D=6LuWo@jl3v&jO)VpAj-y5)KxVSS4&e!e9UN$)4 zBJ2DlLB0I!xy1S;h^n)oN1WmM%8}ny5H$=+J5bqep|Za7L}&DQ#x5| z?(UZEa+fha*mUkkf#WM~@Cm`6A~+#Bz;D#Y(vLrDqfX0!xuS8mr-uDn3Du0|(DqbFMvWBapVJ=P84wGMY4kj)nv zMmqD=4v9C`$1vts$CKF?%W&jx*W-y1pV0~03?*PGaGj{vn9avpsCbriawcEsiV}kEJIP0_k5em5+zWrm0(^19*S_+OZ$$vim&^fVud;$ z1pqT1TB1~~=gV^&6`K$AS%`mHmY1fyTJxffCSk$cYNESuE}%_q{e45m%cHP=`yxgb z%VGV{a`lR~ZIpE3x~+W2s&CDa<;J$(`RLX|bKCWV7!3TFN)C)~=*-y#GZbG;$s5Ij z9~2=*m_!iYrko;79QIo_f3+G`po9W!$5pJk)5@3cN@!{c=0}#LK%j$p!c-f&N=oH- zdCEh5fRzrVQ)N3|nfB76T8TBOYT%>Kz#z(uU*rjjPN(IBSWJpgp;A+%_~&PJ^(-%_ zv%{KZ6~VrRg`vM;l#((3A|r?+b4aOIO9f_gyycX^GP7joOcOo~?`UoVJ{xaQpQjBA zWAT^Qo`wojVGo@aC}k3e7N(=InWF%+7P;k@ZUFK#2ER&Bl!HoTFOn^W?SL$R29l%6 zX+v!bN#Of|U`4gAssw@pB(V3H(njy+_~+j`u>vQV~Vcuy_Ua>LP-q zJ+x8@K|oOeo;UR>7={v`qA4;OJ^~W#Rj`Vlx2lgDJRc1nu%ZERYN(10@TvqVMYY_w zP(zgAzH2?mrX&(MAY=gwGI=tfPChXH(?V7-A#HtOJ|U!rJH$|6S}GyXgDXv9{-4jt zZacl?zjnfR$hRF1w(pgl^PFO3-Z*X6Qtl*?sZZhH3t}(#a+qhlzmUqi^5#taEa&FqLsIG| z^8umEh2pMYEfgxEdb}Y_RONT+Y*ZEpK$8%;TnF>frg`)lyST4UUuJmGI;dpZjkc6B zghn10Oc4P1D(9qr5ts}kQkpPMu}3YMB`>=RB?m3PKoqf#yjgS%e7cK{;NFbx7AdK) z|8BPDsYk2F`t$mi1Q8^XpHH~WCS(s^4`+Py4aQLd~rBgt50SL>qHMZ&is5j7L5utOyNBi7w@nwC8v`O~}I18ig7wY)S_R9&QSm2<=xq z23|`kV7*FCAv&pPVzUU}j|>8$v=VeeDzazuU^>R1Ge@{2-IxyT^Q5BvbW!aoKhM*L zVog9m7NmYY#VBj;?`tIqONd@{BvQc%RiTC#Wl*mT>YJbI>?IVoH*8XpP%o@y>HnWcG4Zx*z!+*fQ#@l{K7>(61W9LoU;mw-4j zSg^WDOSgN^He=o73v^&&aDqpz&y=YLEhQ1+sI}Ulp-tTjRn`KAk9F{ObqSy7G4PU| zA(4~-IyX9i?IfV5#IYC=R{*>xBDs{k3Ux-lI(H_nLZ3+o- zeVbpuYnbBM0dMwX5(=z{h`1~yyxXXP8g~#MfX^O`uC@->n^;dw28HK&nnUtR(K2c3`9zrL!!fmos5@oNpI0Qk5K!>LapN{NiTDF0vHw$L<$O2vIz{788 zD*faZu*$fqJa@0E&%c_FGY;xKB~qg=zQJ^;l=1%dXn;x zdljFTjCUFB1K7Rz2o@b!L`D%K!YphWIvg+8`aZvGqOLuZ7sW6wO zI{dtZWQ4zl6?-&m1}51D!C2vTxBNbv>W+G9o*nWtI#q%vQ4qOsb*WwCT-25;nc5l` zrMNVhPS*pw-U1{OV|=MCbb@UB6Mf@j1_`u1|DIE_MBO9VcXGc1)kx|5U)&VA5cV!# z1<-?m@c~KA;Rc#tBKni=({F}v>OWKUnZ&G4`~YS2zlgwhzj*zI7ZfFbLK+6Ndv=sq zMbxGz0X065<*960tz)9cu2(?w{M{*Qy=H6G8|aV^iipqqzz-O#)u49ExQ>p{O0GaI zh=j8~Wu*ODQLxkR@-g(~JcaItDkBblGYOcj3$>p@SDro)$n&0D?+l0k3Z&k(D@T9AW zvOX;!oG11+7QXSG=(uMkJ|c2)&N1`SRf_X1%Dj7KOQ)!1@1B}V^cEzBHN!^Kfq2Hm z=nS`j{7CBka+rG^J^BRk z=$6e+v|+))?Y?AeRc{u-#$!0y&^-H*aaEKMF*Hf2jDl0evV|Bu+AFx`H1gZ5=A*I zNkW7IYLyu!9ANyg)j%sC5ViQ$drx9j+H%`@>Sa%;l0_iV20^{zv##nxM}t4JmDBwR zuZH_1gzvp&AKF_v{)T$jbfDGpOxyu9#n-TBzsH0%*n7^y6Yj0Jj`J71#+>+G1LcsA z-H?tVx)JiQUykty&23Q1u9|l+;t@gdMvw?6NmQ7n~k4Tp;YA{6~q*~}AhPid4Sjo6x%^;#g)Fu@n z(?BePEWVn93w1>aSyKq2Ab3ZUN87*?V1U2}2Zs3>#Ts@i?A60R4zjjkr&}%jP^Fz| z5iKPa)j_uF)E?}yl%Yg{E7hAq4>y4GqXSobDruON?(KGMT z4b)n+bS^uHN(mmHta{!|47z&ic(VnU68ikXnEntH_p#r48vK_w%5Md&`=zc3;ZYzJ z-G;c^lNOMc`-P3jbf1>g)kNjgx~zLRQE1sP5nc#N*4$77VNNk5kU_?wN8aY&#@QS) zlo>U9Q)w-xAI>}X&J$W-zfC-$>G=IfGXVRFAAZP;r(^xCyj9n^9gXvP6UgmnoxW?u zH;?h!bYsL$jbY#U#g%#lhm8t14LA!z=s?OWeH z{P0vjCFYN4%;dM~XOX(=LS7t|W_Z?cBHUWS93BFUw2t+<47A)pv-LEvBJUw>_T_N& zfbljur@fp|vdt!}NS}pXs-Qp?#n?3)BCF?82CB7#W>s2Ed9}pRk4kRdv1D%h6ftjhXv45K z6P|Hb#2R-tZxoAq2S9rISx}7+s^C+wr|p!llA?yIxJd5NfDFqP9gB6cP7;b7SiAz4 zp*`}ta^iWe<}N7})%Cg_Ztn5mQLB4~k^bcNGDjQ141X$V+J+%MA?{p2`FZYT@No1c zt%n!)vQ>hL>3UzNa&PH#T8EA>*)1{{^!T?)tk33-okx{{m_%+(ml90io`KT1!6fqd z%k2$rya$WCxKMOaI30}mLhmk-2BlK;Eg0z6h10W+3L}}yz5e+_YypvIRV~XtZ^ofb z!jz!viB&OW{kwQDTzZf-d+e*ehu+yTIM{6^8bO6IkGpQ5E{_R5{be3@p%+Dpsdtx> z!pyjg5!JsY9kECPGin4~qpDf6rOR!@sBy7S$fr-Ku!cQEYb@hwFfpuU+do0+W&ezO?WYf?lhLVI52r@ z^2*A4aMJ3H2=J%&r1 zHobeKLE7T?$-w~G3?Zj0oWOB@f4Hq0Svoi5TpZpFF|7}ByiD|VdM-~>8l0W`n68~eUeQgquC`Cojr>O8 zl7B8a=;0v4wPPQVh9fPdCQOzpIR%yL*|z7O39PlKW-yy+Nh;z>1Ermqd=L4Aa1pY% zl}IcD#m(0F3~`_ovlAW$ z^D3`6>_7;W+^qLHZ{t{^M1xr2Gdxe1jF(pn^1 zxEWY4IDt+*$=aJ}wk^|Wn8<2CV=lt1USa&oE7lyJdXv~X!KZA~h>>n(0{HaaO>|a& zV9#Sr^H`DcE$eN9#%`gAJwm29V{u7q?PR?w1tNAac+{f>hV6TB0L7AKf@BQH;e(X! zk>RKL4e{rPat?NGD*EKy6!C__-9()RTMc>%!jh81iGP6%^tCkL$oKOBJKm}k@Q!cvvSYOlsCppePLhJ4_WUu-65miv|`g{ zXjnbU`BH;X;g(nY7)_hq+BXIb-<7e|GSLfOwYW{H3g-%OYb1?30=E?Q!uT^FxbVme zV)K|%%Q}V3vIBnw;MVg@{(No3QybT{K!rFczWv0G_z^Dm zE3PZDR94u9sg(?bSrr7L&P+}ksI;3?p$g9EvFA~oxsM(WwDcWU<)n=gPu6AzbUpNX6ea>btN;LCo-$hRlF&1=!=O1ktL0$W8c%aWH@0X{kp$s&Ng zC{OnyXdR-|_u1FR09oM8#9mP>Z}Ojumo&UHJ+!a28IfN^V*wI86ZlUv_U#dNIb1u* z3yRYbhlqo!Y$?2`X+}speip#r$Rv-Zrb^e}LB_8?8Bn02O2`r}DP*N~BSSa%@&1IH zK)E1POa08#*){YmV^gl~JRYNn4nvv^pTH=9dx+@m*FP&88V`l1pcAc(iT-YiM6#sa zWT5K2*g?`b(gs>OKu($Qm6GXkL@m2p)8||ba%SJ4D~#9EzeQ7B-B%HgNVwz|7wiv# zB;8ZxBqMKJmtW=g-ukvXg%pTSr91Ka1c}0CW;fru&}W(~&RGIK3w!FN$e=>~OtNX0 zua;~u%-KWGE9+^ovDzO%_n@op5FWr8%&a24w9i&-VBMHhfW7j)9{JwB#AELe3yBzz z;2Hp08NT%txth;y(UD8TENg;;n$Iz@i3rP}!nR#Hoy zN+-FkNxfItDLsQ_i|!$9_pPd=w@Dnkwa6||JJuva;b`(4waRO}+qrKjBCR%&da_Zg z#WkU=GEJ-4F>LxvC6N)kI-CqY*>EF%8aWuiy{2Vvy8GuvYh=WgcANK2{9Em?P>iaE z4pVas4FuEoz|vaTK5uVzIz{L&cT*6pdcv4}qnPKMGPn8$!WT+Z^~+>_F;rM?E}Ln4 z64a^7q2Eb3uGV67m@Vi)!Nsg7_%RMF!rUJ_F4il;o}((C=^ck`0z-v$T61~yPGl|? z;^}NBb(g&84+IMN^>*2>)K&1+>*4pZ()p}!ufgQ}4aRaDKx5ae1eiOYB8Kxq>}6QD zBpvgCAD>jOnhr6AUdbcX@qj+fp6w9>&$8-l(`z7ttQgg_RSDY2D>vFj`F z8JtiUPU`5u8&cF8`~sfr3c$SGYTQH?L%`$y@$c*Zr-7m*`k!6El;r>O)c^PIo1L6= z{+D+}QR4gfTEhnz6cQef&o3rzNEoyB@v3}LUF+4{M0Da4QqDVZC2k`1R2GD)UanwObfKm;z?g=?orsxgP4JXxZlC%w@?F(M?Nu%@R zv+x==g<60KOMB#G+YaUd*#~wpMkLP=B@ZFJ^Ih^nEP6y{K$d4sp+CN;Y{TTjoMM6~ zr9-tm3((mSW(g{X&G}2$hzM<&biO-B|xQ8KcSKrudm});$wM0z3(ca4uwIF!o3vidPq`3 z=fhVnZ@_Uy%W*}hxyBW6$$yO?E^mza`f_u%`T9vbihs9c!JNDPeZJg0!>Rq;a4=s< zyri-Hdg8wQOi4*FgHP$-A^6e#_ZZE;z?2l3%RwqQK5lnVQsT|po+A{3NMsU2@Ou{= zc66J0in?T@ya6|7;7?}=eNX@FsAc3F1BxFZeBL|pvapuXio@fop}mEZ6A|J%&Zse&(Ouq_+T%uG`q8pViw zStV_R@=@XabL2xH1(00N8Pn0;JY~AvmSGz;vFdu+5oHbeT6{8Q>DAz>^=v#*u4E+^ z79pG=AtA94g+ip+DHMz4^TlKS?8X|~&)wDyxfcqtA1-&)&O4sZJGwsqBZ!Juwz1!F zvL6ldU%38T0m?QTg;;w=Mn=XutnJ5tx7Sy=tlzgM;>0T%0ZR5$ij%v520hc9HawXt zK8Aii`)BClE)baC^83)wel&`b?4-7~#@N`=&A!|EecMP$DZo%M?;}K~b44OBm?EKx zcl0k;4d>98EZSEYZf=~rxNM531}W1LBKYJ2pW0%CW7JOF4;J&CS{g-y&)Pd#oWZOj z5j7nY(GcMA7&@~!u~p4?0pH~TD95fX6}O!rRZ*IMP!(fUw~v+Ctct>>pFg(z756v9 z4lOIqL~9m5#kif;8+~x3e~ZEPH$Sm|vlIKF3!)H2Rw+vRiD*{IJhA>3>15QyB~sKw z4g>WFAkh*9kW|A7yX4Sy4LO@6VS=Cm^yVg8$_X8^@NaJJs; zF#e9(48H#g>)%YNeo$bS{1NHi>-WDi_OG=4!1_+ZRY@rcxHQA8z!(65{baM@@i5=| zTLvxv3|$C-X8ya+@9Y=k_VBP{WGtOY|2-dyk}{xpC6$8vkJ*V1E7vr+DR%b-cN9R- zA?r>F>@cBCLEeyh(gJm9ONoWh6BC($4y8k&sSrPot0;*qJiW5E&1iekiq9_n(A0f^ z1Xp>*Fwweteup?cplOMG=(FOu=ZvVB0yhPP&|Nt&+NvfZ5El>#KZ)B!{Rdps!@r>= zp;A!Vz?DytX+J->^5`FSfU5Hs5pHq(Ph!&4^A2My(_?Kc;|hK^Uxv|QlS+o!pTvdP zr!!E`)O?+*uhW3*>N783ZAOdqQK zV8=-PL-pqjnJ|Zgo?Omk%&g`XhXe>trUa&Q;b<--9F3F9*1H!nW6%0lEXCMqgNC@R2!EcTb``&FI))_>DK zNB;@4W}?j*c14(cDI&CJ4LLb5av$-P=fs*v#AcC%X8EM1P!qAg=!b zDZ}rlbop`j|KFsT{OPXJ_pB}BF!=M~>Ae22Q|8d+c>|Yz@Xf1n8Dq33(B`!OS;$W- z?>XT;@fy3`AM6IS7|BND%mAq9R33^pZW@3U3|rbh=Vp7G{+CQ=%i8`Dsx!FlY3*}#c7Z+?Qa*disH6g&~!*nEDh>$wb{tj##r#UU+K6r0sBYI%Fj1D zY?B{ZF?QMoG)eu(Z0v?U|D)IP{STAbSN(7+mvo;6jq6G7zw9W(^|&J7qu5aOc38l6 zSkU~ENDXkkKOFS9-~YWTIj#L`{0WySXuHurn*USQFh-a&GIE`>&;OP}ypl4|$NUyF zjSGKojohqOUpF@1K%#P=WlCS78g^Em%&E@9Juv(bn?$L6i>;g0x>ClmrD`)>ZAa-s z=$klbP?uC8(f6KK7KgR>33?bS)bzDXD_}s482If0uj5 zjK6qk&pkQ|$KENoA!4lCOSgKQp}g2peGfo6u3af95(FbxV$-TdT+B%@_-^ME+lsNM z%|N?a*(7=^rY_bpiJ5Z;R=n`E>|1!jpE-i+4OAix2Nn#=ng?`~$I#Kl(9v(3a-Bz1{z_+@5?O z@pqih{Jv&vVikaOJ<0X)`ZpWK|E#rtoAZ~5u=?h_BSD>N-IxNLGHna*c8)I!_zL?1SDAYkiAY%yluh5Z2KZv)Fh!$3YWNoWbPoG}Z9*Wte1!Z(WAI}Bz|6Ah+?u;zZBJQc8J=VU2cNtZ*A);wQ0?UxeEPRs6agaPrWG;Lq05@{|~tLIB8DDe+zH%-|OK<;g=5*lGB?2|5o7N zxKFsBdv{sFNLU(ezW;C!K5ZYEdSa2Gu#l6PdRFR&sM!X>-pqCE3nZ|1Uw<% z53mpj5bzGA)1~9`IUG2oe;m#pawrsjd>r}f6h0yXflwH*kbk%+uErVtsZSlJtkE zX%d49r8~+U%Qqh1kV5IylBOlzg=zA}K);YK0t9}5hEmB{PNeNknt7W>4&48+i^uHG zghPId(z@oouD9?CRc3ET^au%XSBNgA>!p&Bl7Q%?-Kgrs7`mW4>7Mq}!L>c+zP*fN zfj6*i+twlxV8AamVt_?A5saz+DX)qk8rTXc;`$~7w6oeURDR6}#$(M#eeYh#TO7!^ zSWoCX3k>7Iy38rc;;M^3ry%Ju6q?VLKMQKD+uT8E2Wk(qJ+cEl=C&y#sYv7H9KjDlax3NS+8JxK8Fb#Z|9b(*?(QK8ium zLL>MW@g-iO5MTYh#!_N(Ya!GcTofmDoO-1B-pLh7sTyau*Xhw6D(u8UXAZulUC?SH ztClp{2B*GNU7+}B@;sJ?z6|b#`V3PPMYUA!UK@m^^Al)2Z{#ql#VhVb905BpSZUImyz4)VAC`KOFA^RO<+0B?w;$ zP{nWk0khBZ>kY-sw2|$elam@Zy_Ik_TXVhN8js}o2d+_ADr*OXS%%>l3ZcDtc~h^T z+6fnDVQ6>^wA@35ajc!!fzzp_{k8F5^q^p$&@!9|l;%cg-%yU}8VBh6_QOaoQ-3Nc z%AiPVKKuA7Y9am@w{t{hS+SylFj?|g`uz2Ny;u60x$q3E8YBUEMUKzx|owE>a6BlfqHXdJXXp8|m6Mwo!)ZTfPTu8Q_@b3x2)@3N0 z7h`OC4;&7;SlB{~Ug*=ZsK7pSTmtT2Lu|aUtI@Fnp$XvyURd`(6;p zqM|*Z)!c%egiIQBu76P!WaV=!#16)64OfxaEH8${%|&yJRXJ*wX?-)3ut_=p#i*5D zfU#_Mh}V}f+IOzg(fG1*#}x6PhCz)x2obk`AcQR7fZ{ghi*EnWdcUs6Z&VS)Yhw`? zBnZ}f@u<~|eB3-!D)&lZ!OOymNXsqihJ)E|Woaz z-6gyo2b0;Dk(JqqfaWBQ_e!m{jIZZCkEEdL;kO$HyLZz^P-Wc5TBqYgUTWkOj3D7G zp-%f@khWW=W}M1nV{_`xEu%&^Gz}h!?(wDmOOJ>L^oZyC_QoLIvNhfP;x`usud2*Z zS7TC-I;4A2DYo9r`H`iU9r1a+yE_uTzb+4KBu$$R{U*ZiW}K980bY&4i7 zr&qZ&)8)H~+b3<@xxE}?tmQRNH@{J`E!klwt8(N{F9(kS*31FtYeT}zRV=A>!Ie7q zN`CREY{b;@`G-BP8YirFi5CdtQQ?9KCZXALtJG5|Fk;%Mm#U3Rt2fh=bJiKh?k~L5 zv##BBi`SP_K~egSE^ORq8%x^w(@#ftYVj$!XihUKYcgFbo6RpruvVk3;>C-4r>txi zyXTo4^=orHuSO|}wap!FGK3P1PhF!IOlrcU)G#tushTQhmwi1Z9P&(U?w~2qP~n1o z<@*AiNi>vY^B6A+BPR>u{HX0mwb(gFKbMNzFgbEbz3w_qQ@w^m!<-9P0?|;Oy=u?i z)ML8LChuyY)`mPm#|moVijm`DYd40rRV(e~WUAwmquP03o+=ndWihv$qhXH70`1DI zvpXJ~M6BwXy)wEyX`H#TiS;h>Qu4jBCtloea!7aC7DZm~4xT|eY$;pWA5m7ZcjpW9 z8?pAEdD?qv0vZK*<9qz*e;9YL}z8fWUKC6hTeXCvnP)`VC@_{H34ov*F_t=frg>q?Z-~@hgnCYJbfJr zqb(;jBk)?*r_+8R?4Et(x~hlF(N-xH|V5lx;ENQPzslQ3_ix zw+QYE5|ACTXeatX(E(bQDl_}a$ana>Pz?%8r^m$?Ws&z%pSZ+$LxtVvFNDSfB--_t zq3#@o?B~)Qte%~756hkXJlQqTqj&cRifs#>f+`y*dws?!h8&01(vwb_X_oOg^5?Fu zX!`BbHZ|N6R?;;cxEPl27Au@#ZS|Q6jWf3n?iHEx@8{?Hs8vH+zpR_s+XB28Tj3)W zFu@ccY;vBbdS`^SpC7PeraTTKc)cLA_xnk&+DncPU##m}cq(j%UZSp$gmDh#YvvPh z#1u^T*9;%9VA*JB3NWiLJA@>5F|b(S%+`08Xjf~F8s~DKu`LISox5J}8^_lD7^iI*ZfvVw87#iBH4s**dvHUfCfhzI`s%k=3*AcvW9occ z`6i~-2kzG2EnncZj+^%|?|hlSK0h&$Lz%c@*g7$+k>fF?qlUz+Tu`zD-F9QZL^zP4 zt-n~hZ^iWt=?t}cudWz5;*Fd*NtQTOauO66)@eb$c~Yb3nD4eI)9+B}$=%u7rnb1G zXnSJ&B+eUz`yr>oc+M zug?_D6YZ0sohhI8GG|&9(?M6(hKrI7z83znw8)n;&~|q^eup5vi`Z4#bg9EV|Ag}B zx_{9V`;;A_?Z3HWl_q6)7dV5juq;eTEOdRnnR6l|KF#jD;MlsBC>8djCcw4u+#o|g zV=1(A^@4cK>k6EBW7fj5Is}ZDS_6rC_nLBP=LrL?vmYA=45!g?`lOv4^w2G4Yj~Jf z2Do%ju!3+n2Q1j?Wab4P_=d8sUeaN3rrJxw z=_|Ug?PuiKSpq3F^Ok%FP?BcPH#emxN4Qpm2;tEWl8+?7g~i+xSwIKEnd zt&h=ELbZ-6%>rUYq?tyR=L>#5YmEu3-neiye+DYp{6<_!P^D&<>V+3FJL{tn4Y+~_ zi0X)nh5!@s0eniO9GlO=S!r^H6A&#SkFky&Z~{>zd0<*n+;m1HQ<_%5wG!1S+T|Kw zEEzB>!M<{WHJjPaHOpudYi0eQb-G+5kFu(Ic||lg9*-h_P6hHpT$Pb#>`rv_4vr|@ zuGgNNJ!6TaFDo`I)NPl=re?lcgYbEhJ0NkjDa=eN%f2O<({EFyiCTBDnGXfuDV81H zN>i*#k@3sFzpJBQf8&j3(ho&tA8_nY;}AdiRaaKQI}QqqcwYHB$M^8U#v=r_KKOWZ z{mbnM_j5@<6^ujMb6K3xsVS+W;9y?l^t&-?vLelX!E?mrI$H8%yCLjeN@LAK+hCvmOevJqDF0q%D`#zRIQ#UIb+qEy66S#+2M{=VxT5_}M zuI*KKcBfw8TCI=yO6^xZK?Fs6Ywe=6k;C_>Eyb37&-$!At*3H~S*-!H!oY%y*M{cgT>rT;a?Ge^LPE9ViJgM#4pDY!m;*%p^JzAYM&IYS$ zKfb>+$1-8CU~jvh*_XT2%{Pzg({rR6b>=>Qj-I=#V7|MZ#bt#&FN11IGnh1F*|?X9 z%be$8IdZxmhnwFEbTr;efJuqtK7CL)*_=$fu(z8vxwl*xOIvyMG& z+#G!kYWi|s^jF?xfzeOKzdYaB&?}j=CvCt+%yyMZZ9Fj}dHBz#E`OyS8$XaTRevj; zlhA28rI=b8T|e4KW9YW3Ji2hERaFW8q-u4W@VV3Vwz**4A)&M(QMBIU_3UbEDR8(v zL&j>!Vq*XNLM_jiliqKI^zq@xx)+v;X3n7JK1sPI%79bTJ^yPH{dg6OlLu)9@_u2q zY~aYsR1huv{WUDx@*a87_a9bInI5l(qw^jPwXh`ys48X;&(Mjaqth*__blHqV0dG; zV{y!d6?0EzXo(lL4GikMDDUEZ<*YChV6JL41E3g-mM9C$j}KOmhpSEW5ViHsTd*co z%t7kLmDn_2qm|`(PNpVlgd8j$-oZK~jHzwKoPb#OCB5l~46Zygh*oCSTXPEnikh7! zUB7Iz@~}HEzIHap`?1s4NCphP1lv5hrkoMGYEnXLIT?C-^^kQwa$#4jwi3D#>V zr|o(WIiVGLE!pYYSjWde7RiyAR6NOyTwGb4$Ud*i7)Iijke4`Xg^EN%(A*y=QU7C6`CpCv{{+ye{U}?w-3_tjRNj!cdA@*zTl8?y;D8c zJAXTP&E&P3cyy>3(M@Z;)nb*ZIgPX%c0SFHH`UAv`R1H6(aB3ZDmh~Bi6s)D-}9tv zw~^jE%;;(QAO~e#^9hA>b&zv?VY8)me&>jDt_JDL9rXqtJN0U=_&d z3y0#ht(xL5&JG7Hn5J`cJTICC0y#OxhM&E_Pn{5ZavY8%t^Vh@Xc986H} zeuW^s*wtlAR24g;;WX?IG&Me2KGQn&{p=2s{^Y0<(;nDbdAJAvRHv>?m!c2cwTo0a z=#JrDKC+N1TWNta!gK9qYdZgx5(@2k*=y>pbe;Rs?RYEh(uT&MDHf?$ zbJ26??oLXL8&gJr;9(0lIrDgHgQHO!3WesCq#BHoN}FdP-QC76U*iaawY7a_>vAO! z4xDxCBsY^g^4D7Vl!09-+RC5>k4rPjjND^!vdR-*O+|L5cH7RTCB8GyYT0;3dX#(p z+0ho)d7G;M<)>HJPMN}>n~OU))y#gO@(Q1G?z^7#bncUCE5-ygri**(nKZ~%SfEDy zfFW}W!aVHS^*vI|9q=6OvD4d_{BwTkc89y!RI}&r850t$J&FCM9hH#~cQT6i9pj2^ z59XN}Qn|imUOt*>9;IP7hvDTmJ~O-Tk>c>*2aRrA0P7Z=X%_btWUyEBpnC0QRG73(-2*AtncCDNgg#i3 zSQ6nTG68XI7cH1(@h`q#UjYh11J~%B*F#+%wslikGW&iK%>oe7T`@3`BCM6CLZ5m& zJU#;(b(DC*BXsqd(rid?L4E<3iDCzDpr(ENx-_Xewa?OA-@eRr><4Dd)ZehWq25Sz zW7*tNN)#P<{c7pr2GPB!MiGa7JUh2E5W7ZZddCcAxbR zos@{CCVjWP^$W0|*qG=lFDkDP$5Yu;)D!QK6Gx28velI26&VOYsZ2^|U8R+cixHhBeDjHlti26M-nVZphh+GhLfBFqzSH?wkfT42exBZbVtPk(u+Dbd$SD0`D7A8@Z0iNKnK4T*c>R}+�}(iY zKa+VDKW(iD(r74%-4r`9inv|bJgB_O4sI-nXG^Y42;%wv;3+)GO-YtoW}+iG3P&Noc1)IDn=wmh*%ezPl0`*9XBKTfLXaI%aV@MyZ>FHSaWK6PrN7Mm;uMJedsn-b@DiDp=@+B#+pJ7HxYyTMui z6Duut-#@HHdZCbsZ_73tuNyt#y<#ftX-*D$xOh^B9~j?CrePvdF=s71^;`8qM-2X< zvvIR;T}yFFQikwF$W=x`^`X<_U6~Qr=GVq%Jw;rhY-8`Pcyy%I%&$Ij7ZV!bnSP?a zA;-1zh>Y2^84Q_ zf-cx{W?4+tgm!}Pz?o3I=q zbZ~7@bagH7HF@JHwSF=rRAmH{o(~+lVi_ft()xP(uX(J{o`JpOUHI6AH@Lo;_!VI)K$Fb4`B7mKBP@uA3e2K+_8 z;Iq5Dnj(h#Q2ePm19-{cjt<&muSll(WR@`B-J%MKPIO@?tg6W54YXI_It;sV9t zz1U4?;^*s@fk#s(y?H|X!6xhTPaCGFq08c;Zf0gp-Pa5z+DztFW}&zv;a;gT-#b*m z>cjMQOcohivJL5Y`-*4y1T)Ih3IiTVHI0?6F01#U?f6d7soHUAT*nbm^yEs{)Y;F& zOrAQa=}VPok4v%nIjdE2d>3fc3)o=4z%ZAea0!oAFinGvXF~2|IghTVob}rkv2dz% zz`X7B7>Y3D?{XTpniBv}6{6&V=(+C7Zk`JrnJTS?M0xE6`KjyaS@Ui$Q7<%tNwrzR za37-$^25JVq<5|GmUsBz&^2}{c65fa>4K4pdFjk{*bH#bNF@s>VH-w}K5(5@5RZ=W zXy~+s`UY$VKH9J#$hp2yFIx3PD|qhPHfsVj^0cZBPFIkhZGdF@C!E6Xqo5@@^zHPB z7nY+4rhj5B7TJsj1@Od6_e5|!TV=E2_akXhObI#wfm7w5tw_|?|H{C#X9eM~l(*L~ z|LRbIn1^tYTV!E9NxPj%qwxf_GMH@Q1}nQT6T|eddOO6ETW`Cv@1X@2pzGRfrA7a= zO;&xwlG=;?&>ys?z2es;IDTj(fg_A_;7r#Nxap?=Md%-9fa3cmduPuf^j$&GIiXLbZ@HaG ztjIHtS^>cv;};mXj%1TS8Cn?(0gOf4=W&^2t( zj|3&Hz!4zx)u_+)V{s*-4mmwG8J^_QBihm;TS;lyiq_MsUhgJ*K*%VwM{Qjktu%74 zFfXDELR}&w^~o=!*YOilEu|=7N<*}YDwC&U(KeW;R~;?Wkja=pCS%yE6F2dh(&alp zCPaAp^N8mNg@9kF6yK2O^TYr?e+I**qF9@bx;d+!EFw=g*HV2$wD1&2VBZ-?>@h!m z#1&;JCs^Jkz5Dq2BV>-Xvk;ImGC9H`m$75cHyb&Fn`+W^L6aKa2==FjGAHL<1!~-Q zx;JjxlOKB3A>YO%3HOr;hA#?!3P;vBECWyw^!YH62JSF8TM%8;g6*xNZi=t1C^}N8 zsxZoGp?#&PSnR49nU1#`pp}4OXvi!Az>nyELXB*U+bWqW>Gd2uBS~}WIH+xiG{K17 zc$|K(_F%=^vSU}yth>eH%~qz?REf@C?emIoS75ZIxq~d0y6Z~Cytq6WN+%oC#n1HV z*1D&-q1)W?aQZCfP@f73^cT@j*WTCHEGv$BSE01HdIVB2uG4@M&(S8^}g!Ty1 z3G&Xc;2d5I``wZ3Fb>pi6%TI71guE4K`w*HDc8h!#kv~Obo~FI?JJ=2>Xk)5+}))( z6f5rT4#nM_;_gmyrxbU0cX#*V?(P(qM}Iy4UFY3<&s*z-kZ&@XNhaAd**kkpvNd_t zSr|dlb46|&9is3%@!9t;SYN{RfkM%IB7JU{jd?t5D@7*;u=kX^#LaADa6nX?T~K75 zX3^o!k6IkQ)$Tc+enB8PkU>idrRaX&M@ZM3J6T28jt>F~qZZMNeC$+(ROkbu`J`1a z*I%0ZsbZ4W?&0!zy_-?91+N?Y${_wGglqn4zc#|PO>+;U&MS=T;bgq*vA+QK(`X1` z%K~FQEW#T4k4q&CUOxl~oW)gn*3CO7#sjVZ5fB>5gie?EF*T%JAO?f{vVHK*5Kz|n z@sKqjTWxr5HQFIYF17_BcSIsWh}(>x!F9s2B16e0xb}_#-EpZD_vI=k8Ps*bnJ8#< z!(;)gVrohPMHgqIcbeVbJAu9$h$U%24&b0)e15D815X6S6$MjYL^#AVrD?i(@&sG* z4xf8_;qf5<_)W22CIphWNvxBd7KDzEowfFJAv5k?TOsAnHR=-(`@%LIBYtzcb@A2s z{XzFYeAsiEGIv$P{S%SEdk_l_eibD86&Qd0{~m}Lej)yYl=k)IbbHNO|El5s98ZUF zY`1kyc}OL7B+28LRNJ1$=(;rCb+jpAyjp3WVNZwSzbiUkUAxnAu4#S~nSQ#`TxWM> zd6<)E-P0V|SEIa6vZqZmEEzW%ZFh{VU{7H9-xRTqtR0u%I%`|fc94!;C&XF*_cfF^ zkBl5AeUg87l#W-TR8lNzcTStvsA;}7^L(IHK`zddD2}HrRxB=({|6{}&NzJR^m{8u zTkmX2f7kFYpy!^emeu(2Sl-=Eo94f-=^e}2a@9PVHlMO})tXQe@-OWF01KSGRMg_$ z1@m(KhhPeE<$2DYu3FkM@9jM7G}Z0Lr*Kwq<~^Wro|g>OtxZ2gaUOS2l`gIqb7QQh z{cKx(+dnxb_|+nBWO zsV!Z8o3J8v-d;gA?=E>p=De;FXWo`~hr;?N#u|g6fx;byH7rTvTU$s<-)PyecJJ8M zp7JiO!34+o@G*eS%-u!cT z+1ZEQ<^5N?BL3an7=D@F?*{n4OBrt5oTIo8E)QGRxYBimcUsr%ehtx|&Hu-88}t{H zH?O0+Ofbxy^Vn-%AMTgC?5DHuN4jpO{|?Cgtrz0I5AlDd7bvNzJNqAhjez6OdQSYi zIZ=52abf@8rGD3lQM;!0NLS~B>mk<_w~z9BkL+qJEr03E|9jOPzbl)z#k-+4wcA}; zI{#OF{Lkwi@N!&_pR+h?U6ec@@`@jS!5vGRPkOh5|Aj{Vcb62;?GIsp&2W#>?^B%n zcu@`QyY;LbrC_ycj*S;p{m&WgYjcjW_>|vfY3JQ@lhoXB3cURA8%V`(-S`tVp|+%uhb}$sf~mu2(_T36;#YnmsJ_MX0{Bq@w$aMpbTj?CQ&NoE zW!t$IYuj@)*TePxM2wQsKlVu>=;-Lk{tJffH*cxG5D-y#TrPN-4u2uu0bG~M?Eznn zma^4f;rch1!C#*A{}SJwGkpMnUv%$3e+9R5_w|T#-M{jHcR%jGGyfw5(x(#I@N0L# z(eJ)otx7J%|761Rc<G{{U#j`D?3cf>Hpk(+HgKh^-SYj32Ee_)yn7F8 zztkfG&-qs)cXhw}y=lG^{V{@nk-u+Z`3wG^0R%K{%Aad@9XM+n{~!kX&$|9M@4Nft zf0YU1w+{d2rTc4x#_yNoZ;pQt{p#|s4)gH+S^i61f2sTRub;oL0FaG#m8EBdg2C&7 zk!SC!YaOgBo{8P&%d7RW7n4~Y?*aUXm!P31+HVh2NL^DUBcdXF;@p)MPTF97{R={4 zN{Q90Z!=d(%hWH_ZHcLKk8fq~$6u+vQPeqWY!j@?2YKH=FF3*n)f^seX0GT1n_9Jp zf9+749(J~%fGmVeq%p$;^Sv1@x$Tv_SAu8R9XHh0RYrV21ddO@c)G!Rx;V|DmPqr* z&Ka7cn)H(vXl;LTv_^crN}}A)#-A~(S}Pd&^=$K3 zzz|-=aL}4^7G4qhPl7xKKu%EtQXl5NnDo>)RzhobORfBN6-oJQN#KCbY7z~SfT{WY ztS`TkCHd&)h(S7{!qhrMGds!)B?7eZIw0BBR=g4sZI&|R&yic=B(Z;M z&Yy|}fcgviCvetM!JG5L^_NY#OF9=0{#SA<7P^U4pu24v66F@utS}!syyy^%x z`kh({660Hyar`ERa-e{=8a1RgB`FLG6=Iph@Nua?9Tio174(nN^5$MDhPlYR+A!50qe?;nfLi=DoMQ{Qkp~k{$ z01D7k;Qq(Jpl4c7>dUEf8tB4yoaa5RpsnMEcOSF)zU7qFQ50sT-4K8f8#tzIFd~8I zfwOv8s~^0WOBY9^fP<3KuLRN_9e+e>)Q~X|KkyZw!o?a7m!Xf?tv9 zqL+3%C8XS-dlO$|>g|1tDZ=1rMOsELG%*Mi^AT4g4gv;k`G`kNV6Y`YIm;4_hnH1p zZzH;E+VS<_%eC6@tVBJQpmM|MMbhVviSH5lCboWs8B!sb(V<0jrBW05oQEr4bVg$M=~Y7D)m?4k}OyRz9zG(6&>lF&t%qLfzJGm=IrksApl zVaZ|s?7~>!U?C#Pd2x`I+X>N=w0%r95F&xILp~Sif{x+4$2jQ=uX#yOJn&TkS)~}< z3ck|r)6`e>8H?ptt`%R=EiWqJmY)hgnL_qPA2g@n(SVKfb|8SX7 zPj7!72va4VPe+tZ^I;K8Gy$=r+}8{u0szGXJ6e>Im1N)NaAx2VR;ELxRP*!sMs9JyH%pq9#va4Pr$hsR}w{(Y<(>i2s zT$A)&assl-Rq*BRW%!iaHd=~FsRuH&R=T)YKt2~tP=8TV+(&k<7rb*_Lk$2xgao>$ zv$0*6JQa}T3l52KA`qZx>X;1VfIi9d;yDZq=c@RLjWmXjaqxD5K4G$VRiiIKjQ9NBRLx2$RU0;zP0|Z(e zw?;i03+pLEZsPcozs+lwHgBGKs)`!NPa~O;mK#m`39P>?1ScCiO1=D zjDr@2@YH)EsxZImF7Z3QnI`fVh0^i-Z$T3*(q6SDl!7?USv*rF7!XEP{ zNfK6Ep1s3Nrbb;zs7)lnJukPn%-|T==^OjXN?stNF@N{kAJr8-)wr=3KZzR+0ljRK!kv^=i$M?RPF4G-lUIppx4};LGhtYXiYrj(ZbjHml4fGZDup#}dC^#~UQ)a-DjPQR~D`>mYflgoSg=Y{w`R#6n&j z+PWzu>^j@FTRLdZ_PK*}JOO`rEK;n!v0;AH1Cjb1(fiZ-Yq9pQhl#iyCorHwF8;Yl zE)=u)qeduS&r!a+5q~~{o{avF4VMZNq^LH;EnUAv@ErQ&))wlb;oLdNVU(z8?S}=x zHo%QFU8Q=7u?`D>hU?=L3W5mW1A?oGUqS=|R?i>Ec%i2VchIWEksig|#7e8+Y+nra zrjdYw^@@e`=?}gkz}!GtN>ko`YHS!>XikUe+-Wa#7&+Rp6G)Gub8jVGeDe4t$tyK7 zdW#*N@DyVs9R>;+TsIT)4H1!PUH1d_D+a)7qqT|>gadD$kw8~`t<}PRkE+< z)jp>dIj5MVVMQfph9PXi#<&M}kZ}aVZ#I}d#;+Aa`)ea2q)47B4KKx2?zo(A&+40a z4OFZvO6b+9w=;`2fl1Q_J;NFhhv7tGsd~lLf@eIFQB|%f3u3(Dr8ABa9Q21R+IN8e zX1u?W!-tfL*7C4;x4K^@{2PI^V}kH-^`CYemft**y{q0v0AT%@(REJ&0AM=-Aanr0C;-6tcLw;^or8iIO((P{ zvy4M5*ac{qP}@bD51N#_(%9%;u_V*E6#g_|`miorbGegOS^pcr%Dv zTz&eG)Lz>lhLQD`vHamHYiP3CFy_Sx@*{$JjQoJGQmN3epFs@`DW7J2Wp|9zsOZ7< z=^3M$ePQ$|XCLgBB*{yR?rj+J>QJ>3B{F0G=nd!UZ<7~6EYy3X&h-Df(mxogs6HnD z(|_LpyuyVYk4xcV5S}-qxq~JxmgbSF+15R6!1;2rr(PT8RMWZqN8og1OAj8%GV2V7 z_qfNh$?c*S?S4eW92!ksOWBA%+&K?XhBsFs$mkJVF^;+)q>2!#$_e4^6IIap3HTel z2#`GGork?-ai@zd>S!XQI=>tX^-C_8K#L{sH#Aak0L&q}8XF@ocn1(EA4j!cDU@c8 zo8Jiq%uDA9P6C|q5@rG$wGHQt_qXrQ!=Jhw+*sZ+jUJFm3QtHHr#V-?ED!;J!*%DH z31BHYf%3hMcYeSA!c+Eb>VIASg0Q{|9SFw+j&_6@<@YDpU{GPzO!F1dmsF#{g-}Y? z%E|u6PUy%D$~@`ag_Li|{66wfq<`uX&xqrugJwzhU$y;qQ`r39D$~5$JM&-nnr8EN zwNpwE?)~FlBt}vS5mxtUx!>Arap4;8GZ+rY5)qJge&CHjPM(6l|3t>ZbD}ts#ujrV z>O)nxXZNCBgBkA8X5hH0wKUezmpFg(^be>R)bZD zV6S@o;pKwPJ*6pkfFckXp3NV20*yXD-Dn0-rW(4gU5_SrPIp4^Fe?D|BkdAjv;Fri zqpd~2+Xmje3jCXQ7?R6psH7a4KmvJLF-B~}N`_W<7ziji>j1eh(5Tu7u6g>ZeiYd# zhx{a%5Yv8t*rtOP_XkIp=8N~9{>v~8IBp$xA2g|a{c~V3K7W`GtANSg)&BFEIcRY? zYtyvSgvGmP{jRdVrFkM_dp#r9uoQY0LWFiEcO26=S=EcR+Q~*pq8{03iXakdNHQOD z0dJb%A7XcfX=mHmk=P1J`~h1=f47A(W7oPC-wDiE+2eBO9GbOv{bm0SU2A1t0->AF z$kv^YsDp@;*h7xQ{4ihzhV)<)w}r}Bv_84<(f0BScxA*y@8-+IH*W8Ytu@Y7{qnO& z65NH%JGvc`jaF}59PB>048Cs_kFNl0K4GYPYT7eb-)D^q5Nu6-0GdSEc1sHu9giw2+; zyGW4ve~UEE`+pA=xAc7b`$)M-{_z;oOp^iR_zLz%k2TNh%A>_W|BNo79XhtF3TK?0 zsPptSDlQddU56_o{@(*!)_;kyY*~BpI}!4~r+t5; zx5o1KBH#R9npxKPm(0@NG?w*qodBS^3mrRd1mf2wBXGM)yL5zVhZyfhXC zCW}d@D}@QQPKSv=<}ida>yQ+q141(geZ+qM3-#s~Lj@?D3MpmMD~gGULm@+l#-Ldh zt|x}?t^2nFTs;H%8u=O=R!Lx53t~N3%muN=zLdz~oWK@(TF*4vc-<`&_`ix0KXWBE zM%`pcBJ#>OS7Yi8X4YTswua`cPef6jqZth1RQm|DK6(uKfh8QSp|V)EtSt9yTCI?& znDXVVs*%X^!(#FgP9c7Ue1AkWG(Hzzb^m3-J%3MU?sfAm?@H*w@!RZp_)Fh1=ts0~ zxMeM!SW&sX8Za@(i#XJpoZ8N&#=Q-C&v;4u&{Dv`+Ow?u+DD{Rp3 zZ1Box3l;3$f{a~i+rGnVI5n#x((IijegCm{`8?;*K526VSpeS!bo?+ju&Xll5?=Xp zIZAl-E!>WLA=QvKxn-r2(BQJNWs}jB0#bs1%kUE$x7crt3Yz0AD0jmYLr)n;UnwL|7e8 zzBop?xVQ-IOYv_&-g}vB@s&?D<}g|`#{Hdo3 zaKRcnSp!bya>M;CbrGx+2~M1gIt3CxyFe!)CW4@BnA#GWL}%M46bow-6J;QG=p55Z!i8e9RJ4Aa$gSpq`kfe)3gONPE2h zIrzBL7nCUfW5B2G`yq^B*AxPdMQlGPLmxI@$;9qLEj&KDyAo!um=hu)kh-=)`}KuB zjwikk6Ak+*IhYhvN>@z+OLfm0gwCPdI%<_Kl<0yOtNPj*6e*??l5sfak9g2FJ#oZ) zFMz3aPE@_0=-WG1uf0`oKZC~vb?W_8B)MCAbOaK(OiXmY*~W`j@DX3%*P?SCm_qvWvUHY&$Hb8|vsfc0JPD#n!C{|6qzW|C-$8FwFsA%O}9( zi2jZpfHfwa!VsmuIF>##@9B%>Ce{ROddUzOx63<<)iq(hHulr2*<~_(F|i$?=^&&R zeAOoZ!?pz8|vz1`>lg>^?A%^qN#vAUE#pA!9FMEl;?WQgB$E$A{XG|k9-$7O*OB~$lt7oz+S+bZzyA% z7fI#h(yB6L#LU5}NA%hN>Nlsq?%aO!ca;qQH6WzF#Ca=nzgaLFuO&a-P|hpN>zQLZ znp>VrVDzuK!n7{l#P_V)Ou|)8tEl=qQ1&6bl5O@P+2D0a5}H|TkngyO=;+{}#PjZ| zlUR%F=ygF?pPII)fBbszS^QEB0~yK7$-aORL!Y3LH%AG9NP~`OR{N4gprG~BXPbT%u$2pIio^~ZKg+V&I9aCtPk08-iEW6XeP{96pxxZzlJ#u<;P^yK*N$mwcPv`{$Gb915N-sWL#SI- zw|<`}-gS&*`w!eh@B;NeVjnO9gC) z@rb-?5mo~H;N#@Mk@h6lxNw2iLx@8h>tu3P7bXINvaoW1VRNjygxo`PI||EAJ$9*<8zox5dB8oTC? zHBTZ##v7{>P5)rfRQG~9f`T2*SE==JSE#pseWrP$wClV0ey2u;;}r&R3Uzy&U0q^e zStG)ST4+?UIs7&A`$tOJ%`Y^ao-jrQzHgwp=Oodd1YQR@mtbw$y^G-U ziW{pD^~JL0os}IBEdJ5v7EayN#1abyaoP#?DzLlX{Pt{=uwb&(GF6U?zs-(L>TEQq zg*f2Hj7n_bkh-@L!rQt}%EqE}=tsV*#0A`luX?!$e90Y`4sJg(MChTL2bnSW-8~x} z3_m>sP9a|(z;qQaXHu_WDndR(VStO+;uo_nZVoPNAP-x3(LapGZQ$FflPkMFx|92J z$EAeQI?}ViBHX|lTMm1_X!b%R98!|%S+f7bc+!-IQmawVK2^mt?ny^_u7K_?JBo-? zHT(QFL;$^fDMhQ}xBDPs22oU+$k1%sqY_N!;q{v}tflSVdUCfp|0)jPQO286I^Gb^ zgc!%ufYbn&63~PpCg~0QMJcFt%bil@{uD)p!xV13JZ@#?G@Fn;3Wep>tZtnHNWkde zQn1B~5u!Kk<@?u0@X0td+<`(XN2{EVu~P8vC?7@0EnCnvgP+rNc{FkZ+}wzc8H4yZ z#UIO)lj^XH`={kuY+OYO=sM!NWJy4XvblGPy9>d#ro`H7u-$)pcp?OQsmJoJZ zGCJCqxSOeqh)H0}a(=njPSnVKF@i`62=Sy8T(mwk`S5lW1LOwQnRM)2>I8~ea8IJ( zs{Mq1kN7n-6xO>U{wFJWcC>#z>(NN|s&oZj#iT~-XcTrA_tdd<5eXfzbDDd^)R+5! zMY2V=#s%&J?oMhg2h*Ouh_P8&GrMz}9I(I;O zRJeynv-*{wGWOrLT(4;2wZwfH>)qAT1No8`c9guRihEJ2A=lmX38Y;@0sCd}GME^H ztYEe|QI|)Tz7=>QPPHR2YO8n}&4m8z%2j-x?3~B@YA{cCpkP5%5#A~7>&fS-tq53U z+&ZtR!5p1G;4oKxd?kZSmZ~h*8%y?oB-@i-epehJl5kJ5T2kGN>B)1|_h{rMn)ib;pXTVdxhxYQ zXIuN`YAk1=w@A%Bz8s}$+H;rTVBN=sLzEfdd2RfhzyapJAK00y)w}5OCyqzgIckg{ zDm*k&uxsaN!DxgjVxKH<5z#!LDM_pW_|WwYM=_@E~6=uA3sP(se&- z4B&2z12{#2KGWaF(!Q|jpQ8$`YtB&_G4{@?eROtqsm#V2&nNofbs+&E?$&1-qU0+v z+zu(NONV`1HC6-!W1?;uoIO=CBfjHpFXmy0d25x^%fuBc96Ybr6B20p^=v%ub6F|4 zVq!zVy3-*LthItB({R|fa0)(H-V)u|6#LJS%e9BXB%#5O_8sn^8|yuToFbQlfd*i> zRuElS+fCDZ?yxVD#9Q!b%OLMZj@T~RK)7Xx6^4mRFgRzj3E+tKo+zoZ1vQu|dD)0r zIWSVTD-h3q-eGn&>PQpQTaoP;LEy=aDeuDn(DS^jtI`}%)xNcxZ1icPw?5=ac3e16 zsNS4__4_QIqJ9`vuWxnT0{kL!u%JUzQ@8+w0{niPE*2h&9H1%T# zD+B&6(u>TXskt__-WE5Qz2-3*KdNb92B@ZclMsiNPxoy_^i=KyE3jrdGLW{Xkpa|G z^5qhI@1x=9fGM2*tBW;$+$rFItC}OLm0%}5Y%3B48wv*csjJcFBPPCSSs!AdgC*h} zMu(BlHc2yVy6g>W7+2|#d<#JrWbo2J-;E+zztn*Cjj7BEG$(?;%NKUm*0C{A*$wn; zn@x?2s@SDCWY7zW)Uh5165dN@ zmOVu{L5O^J1K!ODfG!{A~yYI)hV+~HnD#mFSgK(TBDv{`4{Q&uV+OF{tmN4+uy}PYH`Z+Xn?5=ej zL~@S{ogitflU>i#k~ky|U)V3T6>BJI&A&|CG3^4F_hMYIkDk462AGd|d|JJuywsS` z591(w6M-s?O`A@on${Cq>P|Dn`~5RBGNB}4oPd=kN(67jr$dfquAk zw!iFE9L?%pgLx_B5`CXD1%vi{*n-qvv#eymxxu}P<1G_0@V)) zBhC^5k9MJ$1Aj8(#x6L)UVN0Qf1{`I!|v6t9U1LFE|t0DUK5{hE$d4$t>X0qrmru% zAWYlkX=N>bai6-3keCk>tpR)N)q#!kiXcZ1!;LQfBu(B*N=vs#Ja4caybW@r@rb<2 zV*5sr)vQ5MhitvzfA1ciCX=eDu054+Oc-wB)F2Q=rV)f~(DfCD#!%;C;K{#P{{ZC1 zN{x4;|7mMDQiE3-A8|0twvBJ~AzV zgt82;%10b|c4II|jRU^t>a^CpjW=wjw#-7iyA_E;7Y~s(1)^iCq0ejk?%c*R8 zP<%}o$GNLX`A$D1D3m4nw#vm}U|U!-aD~I9(n>c<;WxgqpSv~JL+hL{%#b6l9mxmA zA$W&=fP2LlrdcC>OrOl4ZCanL%~Wc$ty{fFmQb{crg6;!7~A*xRL~d&4z-4Hu5y7v zjLMIDNE?=!wM%8H<6A_9$gFPV8Q07Qap;Zn#W!Hvde%}|L&4>H10(AlD?$HJZcazr(G&MzrI zaFUs5r3!Nv&7^J*V;%Pjk@lw)`|!GVh@ph7`}lRt#HlN=TJPIbhnCTxhD=i>e7CUd z3+-S-VC)u>-5r|Pu7{}SonI&sG-4R*R+8)NPTN~fJW1(~xtQCf%AUos25n+eo<$VP zO|{U|AXm9Av!v(XiDa(MEEcze5VS0S$uz}k+S>>FC5>lEyeDh z8ExMs#aJw>pixVmwj@+%IOvi3QRzXch*~`SDpdn-P?3eo4^OuEfd+o3ZSf>ZP8Dg) z6+u@i^yifh%2qA9#i8#zOF2ZoxJ;yX7aSU1_Z^1he7RWOrK?r&9F8%Q%l;|IL5XCB zn=+3?XBl+v_Esf8RU!N8IV-p(fip??+SpDT(*mY1h+OS~MsV7UU0O$ntk~}GOy7(7 zh%lasd}$U)leK;c-7ycQYq%|LuH;1D)Xn_A%=V1SZo^WtOH7G$+z16oa8O zm(dpKC(Hfs%mY+-Y{BNd166*I-^@GDOy;T%adoXIlhJlQ9xI#aFvE{&8`s-6F}$!Q z-X4b7!QOp^cseSPjZw9NC)`onqs>8!9CPA}gT*?SU^G-Ngg&o4&(+CZ#Lgj`>0)@M zYA=^JwWn7)%sn$MTRr!}0P7?f%Z$Y4dtUqTA#y&cFK!EG@z^KJPW1bS6naVz*I{#y z<(o!c7o5DyG_5+VGbmS1L__w5Nf{4)DsV#!OOZLu?d6*N37W=|6)+QrQ!`UdMsgKw z%9%W*l)Q2iw$KS_R6^tOXi9w+Q784J`AIEzIQDa=RU)>v@80a|G}KW;*W);>_y;4r z0}?*xTLXdasCh&No{V<^I2hPd;BYuZh~E5l&^16I2OJDq!%4g-<@bV`HB6c1jd%Mw!TECHwvB)bQ*l7r6f^LtzstBS(rlh zW-}PqS8oO*0PSc0&@pqaN-y@#GJ2Ne^3O%z&hpQ~OhWy_+yXcyDy#{$D3A`SOzY#> z&rmsOa#~li2h6krXp0>K3nA`2 zS_!Wa#2lG{q-^LPQuKZh%|(Mqjy`Uhv&Vn_E`SH)wQD*e)vdq{#+nnjFRArL0`#4e zQBKmJ;sxP(C3)}~)ksa>o2#S`CE-R@(E4k1++JXkb7xVfP5E1qg^K~}%m(6!J|aBo zd`z_4w~Eekymri|sHH=*U^w%}iKtSMa>f^xYu04f;`8yvn}?PSvHGeKZ|_W04V;3K zdHXrs?1R^BLCssTQS8Uo&Y$B0=P@`eQ){%s zF<~%JaLRXLH`T)+Dxag`3Lw>lB8!AMnYus|Rig0SrJIKn@Hd3lnMooCq17WI`$Y9O zti5+zs|Xu(f+`b^KsiE9^dl_TTeL$$H`_pfTA&Sq?VZu?MZdicZUM=bDBPHjdGe^5 zY2`Pl$y%^VZxuM{jwrBVUk9>jdpFCDSYEsFIG@SgbJ$S9xuTSJYr->-b9E7bd4oJeJQj&|M5!?MjwT%M#7*9pB$bI~! zcAzBe;#1HR*_Ur-s<=jWFN0A2LBewTXTsk6PY4<(6EH}3z%sI`xn&+|<|Qr2FglLa ztximbYcOY&^)PD8q~HgQ<;7imrsueA3aP=`hWEK(89_O#4TvW@J^>l-Kf6DB?27=I zT5&NDs=0f?Ak(WQO|@q<(OtqH7z4FiwwWaqATd zz0lrb4^hQ_$F}BmkD5Y0Z&YoCLEXS<=}*2cgcB>blOAKqXCpY_G$RRPiC*Ty*6Rym z3hoI-qK!PF`cC!Y7^9lrPu6@sme(MUQl+?87%%g$tgbJ`rgETegm9m!TwjhjL%^!O zg=6n(=dYjAwRTa9qvDN}(d)7X$j}5NJ(NXCHW$xqE5NkLP@EB5%NU1E<)&sMJkv0@wO;L{#Js0j!lhTYWm>&|&>$2&su^WUO^KPw|yvoUa5%G)tmO4;x5 zeVz-c$0~DQC%W>|<)%*DB$l8DuRJKfQ{fmvvEC{><$rpupL^IVSzKQ&ZHiW1Y@Ry< zCp%XIL;{dv4oLy@x{ISvpF>1`KW7iSf>z6})uZ<;lRXhwRX=FCEx9C--bB1$i)RRfL$(Vsay{*l~2dT{%^)Y2d^!+39dx95Yy;XU%yACR{PWs;( zh?=r6){tCngWzANI#dq80OeMBCF9rUR$U?8O?p$p^}ICSlXJ22$ay&}XF&s|A3tnJ zmC1sb1-k-;OqVKWg)YY=c+!F+yAMyX(xg}>4|ophpli7z`L)Cbm=N*2NfRSbCBT)z zS`SAA-{rCsD^X5`ndFI-vF4mcCt{L}z@;eo8UCdv)4E z!D}*42RACFT*HXoOAFSubL2EvS>THLoXN}ES+!Od;InvQqP6q5DsHqXQD2U=V2>x9 zqVvFL`OR*4o{oh?N>#fOq~Oqz{eF6$xd{A8ZOw<2f^?H?8RZTNF>PEv6IMCK^#W+S zJTI~Pi}BD_h=iae48w$F{55w;IUd^d?U>SaTTz^6Y|7IYhac}RGtIs9Dw6uJdo^@P zP-um5tHL24iI~hziwv>`u(3Xo){F3PtGL6R4c%VVO(vIWdmShPTYj0tlRkSbOR7AW z$6z7S(i!|lnJ+1H5ivvU+jQG=FJA0~BwvJP7#|b7Cr(s3eD5~tg%v*-k-Lam9}3g= zLm?AE(;M8vw$FaH@Z0^Q&nl^=7t=->vhExc0jh<@cjQ1r7*t+-J zsJCKCTDeWGh$owKIi-l)U#cm9#te43VA}EedQiMNjRO@31--0s`#9+LnGw+3%NPTp zdV{Z{K4i}K%n9{g*ISH?P_MSkBKwIBfVol40|d;ST0QqebLx@Am=<*O9vvpYtwWFG z?eMtQ$3;?oGL4OMrqMKU3;JbyFX1+#2o+2nohwf0pHsuY(VtXcK6QHFXoC^f*>}%^ zT%4zTE2iGvd3_W?J(=ARWy1C%dI{FU;A@sWaL{gu@Id(S88fx52hH$>M~IhR;3nAS z3i>Td{t+QsAjE?sYFzB6MT*A!{%M2{PKO?K-3N;%2gMf(!Z?(2=m1$T-Cug{LQE`!2Rdej_4=!hAq z7g&kes|PM^nzKs7Z&_*|SxfFM`Iv_#XX`C}mhd7&s+frK^nDUTrp7jq;bzr@1lKuV z5XH!OSg!c#IxT9L>JPe+YCnCAXzL&U#yMpx`mj8sEEE+uACdS?s&g_k#8xT3?5nHT zn*0fr^E|`y#I(^a> z;IXIa;X(@Y3!r81KP)76ocZ*96*y4(-0*fqI~}ZGqLT?P;!8gOW68!Q4aAL=2C)dc zi#nBZ$aOBzBbT&X;U=_HGS&4UyRl=1gc-C00vyB|wqqluXKFg>e)@fY0L7W`Dx@Zd zi=d5{Zf$nl5?C^{zVdiw{rR~`%};}cE7%7bR){Yv900Hz;N{%&NzXUV3tC5F#PYW@ zx2*2@?n4iu!MyQEFQ#ad*<|KRSaihavgGxYY}wimEY&3u znIdPX&(u2Ed^BLn1+fTR_6GrVQ68NWK~ikoUcwPn&+K9P;Y414Ch!)O_5#JhT2gBjU`19_W>be(n zFO<-d=)1}uNxiZ!_U#lGxmT!Yp%T6x#7MXImMNC&wMi-ioTcm5j{}*${RYS_lbNl& zi!C8u$i6I2Rj5f!zp4edm^G$h3o=klCvSES0|n|W7M5biJbS!(EdC9FSA0lya|U=b z&@c_z>b;MY#%>JWmFTc4=XM1p_;INEU2TlvoS1Yt$E!S0D?~@Wtzr{zuvQqj(9!$vZ6qhrdiZaBWNJ{9KzY!)_mP<1k+F@M@nrIk1Q4K|o&Hrlsw znf@USX?vdRLCmOQyS-}$q$c!%DZmmT!RtU9t_gq|?U}1k?6$q3D{BWjLTvnI)QQ}F zS^5wXYxKQeC%{LwSd*w!5@pFtqSZG?pRLvWpUJ#c>{k8xt3yX8X})9wPSYO-RN*x z^2A_Bo-7>qNOJS31>9TF*LH^s^<-H!s&3NYsVW=23#Fj;?a+hFLwj~1h*tqBO~Ldq z7nsy}$q$Za@@`DrOc`Y#>XhqGwjp#rwi(gap|Z9#I3w5M38w1W9EC^1sXI?8OqaWA zn!LO$eGBeGE$y2Hxq+;*`#7o_x%mhcf3; zTkHkFL+jLJ`efB?ia&P^QZYoqeb1ahwP3{wt;8YLeA2s53iE8 zUi-XzdaY5L3y$Y$o1No~n~Q|Sc&5G^VA9(3=@)f419`0rb2=R(*~-=$6f*%ZV~wiHuJQIf%pg zl{!dL#XfGW**q5-U>58As18TZ#%k6$Qe3P@V7`k{`?xaqCa?I?5h!Fu9$1FrGueC* zk*)r`t>=w&Flos%gGjPl=Cko4DyisD0phqeCl11NEzRoUb5*GPAj`fJYLQ%rsMyTT z6%+KSW*Fdgx33k~f@Z^oZ{r!Ko&|SN%(^y8b%vD^L?L|oLqDgzt*~@<2n?+>p9T@K z@UkYqAyWahc@gs>-?@;a-+ma%UMIs(_MvOs!elww7%Uw_r}wN?Q(-ZW+o&rMh;N4w zyk3vi3^6gKk?J%#FD){Wq!V}8J;aLEFecDfr$kx>cBi}h6R28u`;Rnhe`pU~7 z=Q}2=!z}@!`;y&p*I7avfq;z zTA1RLM}iDFh0pvEjh2?avgb}`nFXIvz&1k0jP0}V8g^B1sQ~>Fvr!-8IDJjM_~zF) zB+c|(0#)17tRHz4PB{VoJ9K?WCId9H-;}{}&}%PkNygwpM-~EZAC=KRux&Jh@vecw zZf05Oh4mZ_R`>xaV`>OM_7mhV!C;tg7lx*%8<=XTGy}lw6Hrz*i_t+%c2*;c>FCa| zlfHuifzjXNb}mpr4t~Zc4V$3W!b>;kmh4j2-X9?`dtk*%NDd6T`ywn`;_Kx*585>R|Sv9&Y|{)la+Ougq6;~5i7=#PcTuK44ENAJ88Me@aKyWUzfwz;6sK$ z-G>P4hRl-w=&=ndpa#^tK;~u7IQR0EI<7KBS_E%IM_jGO)(F;u+AgMZbkp`H+Diw? zfiThwDYe^T)9FP7yK^w~FU|SyLxY zZcbt?28Hd2SAhg|4zpl$n_@>pmQfu!f%Dm_qeF69Y>N>Y{&tUMTPd-=Ai#%W7d;Vw z*&JE)NTVX&`$9K@TsmWXaz{Rd+>nlCuLzMPk0o1!c_Y32Lb$NQMHXcP>BlsWRVnKJ zL2wzc2n0r{*4vL$P?McUZ&BxM6|e_4nyllM9!yz9x*y;-1>+BrHThj=j4))OYMiRy zzq03RvY5^t)oPRH$MNxt%^LRN%|Q=8l15W%zvG1@q0rgoPgS$5A=6~7t;0qs=amOy zS@Y%T!#6Fb_Q0yG_?zg*NrpDWFuH}Wxvc&6*@C&95V4n~z0ez6KnQ1a$Bf-aLZ+S! z(N`b>UNSU?1NPNB@b^i~O_LbDy_bS$;)4e@jaD5SSd>nZm{FIC)L3M!WG)IqWW;^X zNFeBRvr`oVc&gEQPpikDzu<&kzfF81;4&T6;`|VE75!+iBUK2CFNMb>!pV#=&c&4c zaj($3VcfprDF<+ovtsMf$?Cvyw2-;dWFB|qHZrw3gR=euo|YScub|_`<^cc^;oGS*tmyZ3?eX z>s-7e9wOG{ZH@Ot0e(cE`vN1sPu_K>G)*LdcG$S+Hb0yEY5WilOlA{; z5aOrEA=IWQFZ#8djDKHN$ArJ%`2PvF1xWhT_TdA5I64K_sr+i)^gLBkdlB#e$M-b> z^$y2?Doq4U_{97N?5z(LdgsJb3OIj*(l{FV2w9&;tfFTk9k*Oi4E%b3;YITN`(_pf zH!s!mc0Xy|}d2@4BJx&*u-r%+bM*2OdL!pnpjGk@Vt!jP*U8 zsHRqYa5`txrY{E$udfXZL;sRz^E6IWpC8E3;bVeB50QRm`SMsYP!BUjg+{J#?9dr@ zMmprgD2>#PrRk}mcaYdNFYgys2Vn~0&FK?nt^=rj%GiW;c9mgy+*um|9X6Bvpp z8XHn@0q83K577W@jsN?vU07LKnssSs;Dp3YLiCg)Kt(+SZ~>Kk^|&yFAWi2?!bF`E zN~h>bfeSsVM_eq#A>a>w$@UEa7NCvQFq+GR>NP`X5dbByaW~AEa7D!;8nKz?gb=0x zVFxRzxRtEmG`RyS53;AF2sn!j@N)hzUpNFu?`Drrr1Nxu!dj7H=8_EE!mC$q{>^E@ z$deVmkvA*!Z~saCllA${aen z<0E^pF{*;G6YI&+sAkgNkjTXKnl62)`id-@A*YzMVivtm4 z>(2+`Hi-3<4aYc%X@o2{;Y;xj*0=|23~-53cHJ_;h>p$R27A#sI!an(wS-s!(>>$^ zImFcEzFA3;keqXzQS%}N6X&urnH%Iqu1eS*I8?Sk@*a8R?ie}=LtM@9>MpFgob zdw%X`@7EI7I*%tbaGe(O2%%>a7gv+cP9yv9YkeMY4ctDd2YnSHre3mZ06;Is(XN)n z)lHx60K5UPO#<=}^GI&wCb&On?ps(h` z*2A#5Q;OkwaSL1TJ&5L9-np8_IJ8jdY8|nVr1`*5Kbk+$w- zI__=Z_WK~y0cJ$GTF2$FatVhChiHbKj$di+!-B*~8#=%I?I8rf;DL?V8 z0b(-bLl1h*TGd|kpxUf(jqlvRU}BbJrIUR~stz-TT>n}EQH7C{3;clwnxMsjW86Xt zB)*}M>~(zFvJ)8&>*(1>$&XnROSKPAyOJrwgogqN9N^SSargiL literal 38039 zcmb@t1ymjDvMszIxDzx;a0u@18r%s4cXxMpcXxM!yAv$9ySux~zq0o^`<#959rwR) zyw{^gudnI)s+&2hW>xp#opiDRar)kkU>Fn zG1D}W6cbsYpa_4o{wmk4+$aIL<$yk%mG-BsjEqd!X-;8bZSI)+$=9ysdG?CDkXDxgk*R`jtsP~jAV)o@)12eJ^6zOsD2-GJ&V*=e>%mdcfWVU{N-wd%&0vF%37YXwjat?I`d9E+fu+3j2mU> zcQa-jL~xTn)8CC;{nPAm5$P!MONJHI=7`{Y~)aW=`?CBXnASU0tDO z_9B(o^c0RlB~xwwn4PH-6j@;@k%%jAPFz-pmX1bQlJ7WqKhs&xz0(7${*$&KI&2Jqp8An!ndzD;~E zUxmwqj2_G{lh{@tbbVfuS(Or)HP;5@)TmD_RCBqlvkVo#u4#tZb+<06?G%Jw*6&;y zb*2?k^YgbRe<{V+XEpZ}m=TCA15hmamiiHfN_J=&S>b0_kD$rHqUH46E<;v#S=_HjYr`@zpnh}&TG_K3k#?YD0MW()mEYpfOwkGp%E{c( zTXjNxT&YVNZt(hRf@ZN%!o}=rH%)+??n}Tg-`D0}*Wy#3qD>bDMG@t=HsNZ(Oj+bTuiByU(p9U%Y41>uv zCk?Yp^$aMQEw8#l&7ypP~kRko#Q)WgJS^`0nC4})0_L~z@QeyC03id@X{6eOT${kGI zZYBiwV&i_6bmpo#r*g5Z<^&x%h_PN3f5f|umu)#H{{^)nw`EkRlWo&(!McOK6 z??hm$pVU%b+5q8aWBnj9_aV_9pOf`_yMERIXu)*rlSm{fzJb#)+8Y*#qhE8M5MLVR z35e5XlNkh92P*kMSsz}Rm8x>efoG~MK8_?uz(pr1Y!B-J3>geu)EDSt1*z1lw%Bbt&)n^n0JudcO7!GB=UXtb9Z>^@Sov(7 z_RBhi@&N0%nYH?Lsab4|s`=aETxSfICm#&ZYfQyRULvE*IRafM(OiiA$Z=ywtNP_Yd8mVUMA; zgNV^#uaB0&onqVzqUg=x<2wYCYFsAIY}ilsD_3M3i8ly>j=Tac$-V?&W;cK#BXg7^AZG3;VsVVywGZ2y8M8#j_gY-d zMuH3K_OK4wqZ>UckHHImacRFcb20yjouHoNI9jl>^zCOuI;9ZOConqal5#Q1h-WM>DtM%P%2iI*-@B3Ahy!J+Ft1ch+cfNHOxR1|^ z0(tY4sn1aWCteh}T6j3&r%)nk}w-WSNi zysr#6CsxhCAfov2?+s)*nD&(_m61%w8HN3 z92x^YA3P@%*r)G)&`Kov{uYKL;jIu&2Tm;>RqcC(ki2`!8Ylb7C_rcQ6HK1}N1uYEgmyVOWhiQwqXYV7>4qv6 z%{VT(eNX6ogD3D<#A&%1>@6$rZy&Y9&h_S-PkTleWqHNi(~v}iu~hm%kXEr~x_ppi z8Z(!@Y?q|DZ%f^+(M=x~ie3Xl2F~XTTS4pAHm)K!8rOv zrW-53piehX?a-<{A)THK_1^_OUml%&#`OqT+xcX)2@Z}n@_ApA{e2ac; z3XT=Z{aSYTv^Ar%4q`f({^L_W>&V=W=R{q1y;hf}w_zDQOfTRoruTJJx8;85+F{{w z!w|BIRrN0TL>5}{Th{p%@ksOh=YbVwy`WGjhP#^GWTae_KuBZ&pZ8EWZ)m{R^#R1$ z{KUKTk*%2)GJd2gQ;?QvBFcWLW4zsWjt;Xe54@bMcC5i0PiEnUbNTi;O+-e)2nKqS zp__5{YHD<$?*v!2t|vQXsNejcN1@0E+if4DrBo-!E6O&^yksa#L7+hi!LWUN0DNJ` zc3o1R*O5_WR>}bZll`QCl6=QDhB$Y3 zfON2?(In6qiYLje*ci^%NJL!@-w78Co(-5ti~N~x)Ui!@*VPydaMl)hByCk zbhnpy9?6pje?hDCt4Xu`U==B1*+nlV=`AH_0@C|kZSs{Fh24jU?N)23MR#a3b|nQ( z)CVaSLiPo8mY@n(d_{{gsCy^s4%Kk9n^^e8^Cr{Oc5y0Oez-9*i{{Uwy>di!D9? zED^%U$Ju}3KI%2d5g}V^K0)CJCZbkszD*cZ0O)#az1d9kkEO@2J*Z4und) zdp#KEDJ1MpqXEE2<1{JFnlrwKRdI< zV8X75XcDs4PReNe0)r*I_0mzLymZxK*R%UPULA~3u4wtjK%sCZ<*0deJtC_F4c>gE zW6)jIdKU-_xiGR&uL-Vwx3V?1i~*u#m!RBn!((CAO~*J$XV$RgXP@N!9rw!d5=j^2 zqAMUcs#|fz>l;V@7M$7AUTZ6EWPqo2>GhL2Luj?w%tDn5qlaOe;;=PnbQom&*2NGT z`!KF%^f~86`>BiggH_rY9+An>iymWuk;^T&8fAT9{WQ!8#m77ae$;$!+Tw1?36@Bv zbV&h)(%yh113Cqr+|U95`w{2UqYS#srp^&sU+%|Ct#(@>99wbj@Q?E`X#Hf%$DhE= zJW(<`j&iSuoov%pNKLWp2Tm`To3}yTwK+3Bx%)m7-uZzdozT>T@`Zyz`OhPAIfL;r zXbFBVih4rnsfa~NBg@y~u@-(FxO=huwrNguz>PcnRG$5dGeC?1hac8QuJya^c&5~# zBNHVH#r=lP!A71V9n=RkS61;NOmVezP*2IPc&Y&d8xo=nMhN&q5UPD`o3vkreR;gs z1>MR;PXMf3J+|>DjT26ip6#0XctH##-Cn$CDh@nE=;#wxQdKMR_a)@B1lR|5oSvp7|j`SICalE!HoJ%@Gq z2u|b98-pPehH*N3Jj_q4k9=^xhkh3ar4)4l(V{5K26UJ83i!2@+J^*AtmFrK=oMOB z;nN-kfk?xvnjX^G$HZ+v^S#LVBhhQ_9O5&zb(N=`4xC{HM{Db$B#m_MDS)ah)^*v) zV5ey#KxD-fNv)us-JPt;2O!vUn-7dVH(=OAqQ17F(QXg(FY8Pgs)C%;9Z*fP_Q|my zTxV<+Uz#xo83|qtfCgpAYDv@J_`}1o@TkVa?8|WE;%(FNA<7)kWTMgJ@3Lk-AAavl zp`DYd-d{BfYx2}oEx6f!8Ljvtnnty*eM&6VPo{u8&i6|&Eo40dbp|Yb=SzLiLP%!g z*GVROS9bNSEfd4ZZ7&XQ^S*;@Y{d`D__*aSHnvDwi_5l#jFvwj)iCUQU2qWla^&$` zt*xV!KBYff{T1GTz#4}WhKLx61k1jPpx6$ADzwtcRSR(gL@aK;EXvJX>%6Ryb? zy;9NUP zh|r#XzSo1OD5?l$&s7nDlx7?3#!xgJFQmtEJ#*h_*KV0CiOP^Xt-$hKk2d(TV$^-e z@(FpCw>lGY_BQi7Sjlh~tqaVjSjZ#Iy-<&ytKbax!uafraum-aV?9`#Z5@U;fnZ6_#6!7iAGd_3t8Gw|EGlV{l-hiGpTF60A!^cQ#$HJ-5GwxH%v zH?5T&`Tbu5ZbC&7nGrWkYPhde-JzN>Q$L*T*EbI*!ScW3&EuvF&6D>g{hD(qKvCkI zs|hx~IJXE<*~?`;q1$l(^67iTbzA4I>bu+9ueS0nl0nF3@U8{Okn5h5B2gqsw$}IU zc0&NwyK>YAS7QZ|gBQ&SrBnB>Wm6QG51YzeT;lVh%y(~y;vQ-w9vk#&sPn1|<8i+i(?fYTU!sDcUKfeqTVG?OB=R8J}nz7R-Ib@ z2uZ3Qd3M+U8R@#5yU6!aHHKVKGm#{e)!xSL#RJKz@6A|p#JOQ!rT%30REnj9!#j!F zJ3uhUwg?C$!0Ph{rygLmL)>FYex$AM4@-g${9g&lelBEzH1YbMs~lD zx2o?cP%#~1FEWZX*^CBtt293~4_%mQQYLk=euQ9O6=zF?us`cnoA?6k-Oke*uCks+C_zJiO24Eh*SJ5AyfA$j@iDW%^( z#)F1pcg8H>9pH5OwfFy&-y5m!EVnQ%v~Qqcn^fT=lkCTRq;f)I8J}l0S+7<2FqP}i zDonz+JQY76&MiOS1h(`V+MP4s1e2az?_H;_N>ITu?udRTBw5KRAWqll0D@Op_N1K_ z@>=(kr)yNh=}Jk-fT~h_2Nvp}2cO3&?ZKS~>#cEuhjR1$2G8*k zqe|oEUyptN*CWugQ@;N+)>tk6&p-V?+lL%;YCqThf9CE_M;K1OJ@OD;Xh~OHdpdTO zT~>uWWX)5fVDY>7Rdn_n*RRau8Lkh;XO1uqeaE6;BUXy`bJVV3pS6%#ru!04S+iRJ ztLMHtZ8rO(XHe^b=@X_XD+Uj}G&z~o=R>AUx9eF#{BC=^!9I2MkIs!%R+p73RBc~t z>b||v>LqnqaATv!cBOa-sm4#HJIs;YEo$^|fTS0)$H9PwkDGhN^}}fO>F5j!T2M() z-$`JP7iAF15_qM~c3zxTc%XJ1!V%hX(42j>(YTV&OjSM#tfGQ>dXb{5b{t+L1C$Ts zfUq*kt3&H0vHQK%q=Crv<$iK8BL&0zu`Q~_gCU|%L$XTH2{PHa_VGYlLlLG7gkpQIwXJ`eB0n z=bX6q^FKTSo$l4I-M63X$BJ>1Wx5c@Q8F?zI07#NpafjRfwPsZZrt8+951F16u_YU({EvBSpo^9Lg zGuWq!#HKSS{ucwv5vS;{k;%snjdu1^mJNqwWMyujtH}P_*&H15a;UAXgGBZNY89<% zg>epzV(c7e=k|`s+l3sf7AvbvX%#JELrVPE|GvAr+WoJ6%UD|{Cu@fs z-}??=mj8YMh5G-vAO*=~pgXbzf9F5UiGj}PfD0=or1bUJpfLIKQc^G5soN6PT=$?8 z)eu+uML#lw$iWW+8|&)j!RySg(N|nid#=qcqpPc{m1k#XyFk7)25%x)tTJ7G%ZS^; z-&s#P{Ry;OT^rE`{242D={i8>PyQBju2o(z^Hs`DPEJ4mo2U|V1QnwXArAT|Mx40q z(X@6yW(Pda{n_85mQ&;04e0mA=pP|T2P#G!Lvnwsk3`K1k;0#A#Y?WPm z?(Vv|Di^#r{&Hn3bLHgfoV&BVQK#b@UXJ|ihX;+|l_NG>B2DXOdnN6oqg@x2`^!80 zrRcJwVtz?EV5{Pp2es((hKmPszPhlbB$FScvv=_LD&|&)e)A#r zCmXh6Ez9|_uG3JL)3}xmXJV{s_OYUWG9N27w@MsCC~{a}nKA`&7$3scC^k*F%1OMn zN+ua*e-bzGx@y*QWuL)7JzXPBJ!L=GC_UIU{diiN9*I`5+Gjq``7jQbteG)x^IAzN z5c1~|s-41M7b%^=VShONFS0IMZ8}``*?;GsHrU^IaC=a$(rkCVJ)W=9d|vq%WB*~M zg?-vj1LXc(o1*L=aNDJCqbVs$a{>`Q0gKi9D27`?94n&%OEzj5Pl4YQFNB}P>5p=3RJb^;7L_St1wNfAf`xY?GAJ=l zcet?HyWz7YqCv_f!UU630qA6M2iTG8&afQMyj$%Js{+LLH{^#K= zO4rIZT42Wi#h^7kj<&YBBlgPBptESvMh`ec7JECs9fGgv8rmAX#n*e<~&rt$(a>>pj2Onq6Hz=?B35Lyh|Z|2+JM z9m!?KitcZBcc7)UeQml$b1aa{ZVC0jeOVq~Vk%<6n|++M4$!h67R z@nX%|ae2pn$38xMd1HHiUsxr;6|}k{(ZOa7ca;i1UfR#N_{#3t@jtgCVZjq{#o4hX2A+(?4m| zdot@tB)P9<4=?ijuK(8VmF3g&0-B6~XoWX$i-$LG`LbW;TK%6Qr}=*%a@s&S8u}Mg zKzvH?FDhJbkN)ShK>$vn?tivvKTqEW>e=6OMr`R1jXSUWCy&1?tZ3}>{TaOU0uX(5 zAmKkSfF3x1ht9*ATko|d>(9H>jlE}AJCuHZ~xybe&7wjC^z@6!IFEy9xJ zcvuq(2K;@g3Pz@)`Jou}QG8YoQ>ev(nJ5LOiS(X zRj@;UDAIp9_7A3HcBz0B^xvfGFT<-h)>o&ps?X=E?O6|u&GOjVpT=$GEKcL=P|PaNEdg*ke@6d*h?x>FKOEBb&dw_DAnL>Qu>P!4^c7|THcMi}N!n)WW~y_M z*9t?#ar0Kde0#p{i^+I8mdSWB zPb7njut2bFq;8B})Z3I6C%)%H(bzd61z-iH7x{(YeVo3E``c~FSGHaR9kptZBu($* ziN@#XYTTYAD|U?$-+(ruLG|v1hEL|NY++GG*-S_^Kx&|2h)tlRpC$#0mH*Dgt?>Ug zJ^m$P@*hz}r;rk!-z&dAds<~Wz56AP7PMv1j|YWTIriT(>$i+3>kKPAaKEB7CTw?a zTsU*#{k(AD?bDX4pyLct#v{F4X<^}-B|mH&5ha@KH}PI}^Apy_qP-dm>xPMa@ja zo2Fu|dRGt_od^Q=pSAiw^yxnmCWdX5OwE4Pa_mhNm=qlLt&4Av%8_wJ(n&5#Ex-uZ z;E>K>!$cu7@d_Hf6}GW3G;{lWSK!sztJP{R8g{2WCmwfK)lEb|TRcUk`f)kXlsZ_oz-AOD8B+ds>?naUr44*&tn zVLK&`mH5G2$y{M37y=xwTe2Rn0khyY;y^Ho|61efC;lhE=c<4qQP#=+jzHPi;0gJe z4DXoXfN9ILCdw<)32wGoC{33Laac8-qZ$EBcMdoJK1dAZF@X#|87H10Dr;q zdmweU^*h*qi_mY&(m!PUZx#|`&o*g5Z<<|m)j($Y=_7%73pj3x5vObTRM-FmR(z|p zv;@e|x%2PF&FycqrRRU2^xVTq^*3+c(8RG6*D1sa{q+@Q^1s_;6(Ernrnf*Ztrrj1 zye4NE?-e_D<1>0cFP+C198Zt6wqAI9j;C`@uoLIwsv@(#8KFbsNP99~Atns+yKq0Qk3K`g^0=QTo^CyG zeMW@z>)yCQByk2})cS+=cPKS;jpJB(Jodl-v$_03-ZTFdlaXw{ja!#4fpX+z{u|VY z-!vQnD`n+haVxqV0pxFWt*f+rpY1n#7$L+-ZU8H7C8aGfvdZ5r>bT}n`}6IeU2*## zJ*(@#&^HHZ_?=2We|rX=nr6=~h4?pjs=teID=6?>rMDG8_2+P)6(NN;!d#7rHg*N` zw$NpBtPW@QfsBJIiE(pk)bsZxg@6m-a4a8^%p}?Mxor~r@J^P_2_>CO-f(<-Ap@fw zla${xm>v1Xex@pBuUoBBf~o>#&ZDy(Q0p<5?xn?QeEAa%-IY@`@n*L`wpu2!W}w_c?P=Er>c$W|x? zH#E5N3rv&1ZMMr`;H!iighSfnolYyQjGP3E=LY>oR_+S8Wb);dEu zIyg4sSe#d`vq&&oiSe@s^;~k|caEdaS|S3G2$b>c7G-iq#jiK_uO`wDnMzq7i(;Yg zbRNR>c(6FR!Yt8gyI?eYfjpxoemX-|g#e5(Nv?j23a+^@a5h zlu-(IM0mPoiSEA%ud$%KOw_*Yhkpx#7yP;4A{2EP zezXsH+wl<6N?@rLEqzk*?QQG%3UMpkVc>>I?}}5vhVC1fmh~>^0-C_YaY*zUM$j9w zAQWC7TL9)J2g9f!0(~CS7iQfVQ?M_mp#)tpYy;+2X{FbaAb&u+jHCo5)38{sS7WBGQnS<86!Z+Dr=Xcx=T0w=i8Bg=;wnKh+ zF~{D1#B{gxZ{3}D2e%YIWh(ZDm?3y~XzSgV=V{ly*h^b?@>{Lam+s5R3l%-07b2e0 zJUwWzHuW&GKn8YK8b2z)7@AX@Q0`x3&9t6+f@cvon7-c(%=}c;7x_j)W@q8oZklzc z;@(hfR%@p&d3JZk`0nz^k~MbcX!E?=rGL-gYIgZHvY(6C)a(RtS@1-`wdof1?)1xb zb+=H7SAu+}yQW6<%Jwq!n^$I4R$=eYSx@>AEL!ZnE0kKZ$1r1EW_|TeJaPX zBBb@4hOBim4lq_F4X5*`jx2{upmOUA!ee(B zc;-EMyf{mYg#I?~#;rKIL#Du*tGH`V=5qV`eD&(MY9wZ~x?p`^^O;M)-zm+YwtrIo z<%W*A(vkvA`pJbk%uN!H)8#Vnjpibwy{!3DdtWRZXdWy2-BzGy1GKc@^ZvM?HL0E{ zBj;1vnZ$DVtobE(6zSKUPx?!}!N)Rti$}TRMw;(}8N zOHPeBkPHYPudpB5!_SqZ<4>=*$A-Ih%9y?r)%GiF&Tiy!(7uktJpRfnSjw0RJNkup z?b3gGu$)g)RPn;8zUnx7Z-=`+A~m^eieu!y26gB8Rh)%^L{4f=7vfhf`OJecy*cLz z+7yBpB6WE6+J#@1-Qmj7d+pm`(s-h#<@%dq!5#3$RX!uE@K4z*E4Ys}H0@UKWpWRA z+{Aah&~0-smN9P5%_kPxulA^xjjEA}v{h!1Z>~EPm?GoNJla(Zp04ngA&)8=MIaB+VeFY^gqq>4iFt%Ut=!L{EM@pnH4{pCX?iMiHGqepme(iC+2GM>Bch}-cH$V zFLE|(s1hSY1+ValOVPhrKbj;_SuP@foY|K9rJ3_+P<*~SdU&7No@bZul{I_Jfv~*u%-oCgw;PdF=J`%W|3dx;m?bGZ%U`bwRv%jL7@A z)|cD|ED0_cg>|mjq*U;%QxwflEJA@TrimRAjq$@j3&2M%Q9eu@-Eu(U;PhR9OZv%8z^Q#03GeJTUAy$xm7XUL})VT)M_XAG^e zwv18Y+|x^TD9A5dD&YFfHOb4C&8P`Xs!<$Em|H)3wcA7J25w>N&zJc^Yl{7EMdf+#8VfE~|VF3@n<049+cF6W!d*)C<`q zkAJcnAvnTE=Bh0EzH9>HgEmZQ5f0}nsr1P9tF<)u#_Y{;eyq8mB_UgB;y>*=7Iyp14^m*6aKbre$ zrO=@-1boxf6PkXWjv=$g1ldmiv5M&vE;h13d!}1lJ}s4G<}Qt=Ga>0$ z0NHwDB4av|mwhAJMpJmko<$Z8N=GYnt}OUgp1cfr&Sd}KBBx26EWP5Yng0r$5@83T zc>me!_A<9ZS&QuPl3^=F=LK0O=h}CxV=?32%YiE*8uwajjuXr;4J=V|8@c8fd2{c{ zQgGX2HfU7Il%pfhw&_p1TBS=#^|j%vR!r>UJSH~%tiREnte7FxSEb$&QF{f1 zPrGzeGwiEUcXC9&sbQ#56D=OG_^Pb(lBM?8ay^m1nSEOJK%9~~dIwoFiP`Gn(c_Nx zt}Xsz6jWT=1UhS0NTjT|`fOR^3O!;Mg~!6)oP{wSB{N&wd^E&w@z9l2`K0PCXYz_r zXY05xMwg9Fn*r6htZgxvK?Rb*r1t|M4-#_)`I@fm6WK4H_IH9~26p~frmo}5lov02 zE9X~8ni|3)^7zQrJ zafD{4i)``~TN4WAk92REX#1!Qs~GPj1H5cE6(kP{J?GnzuJk13YAsMq!7`b5i3rmQ+-$?qfOy zn+6Ofwc4}_&+9~5VD}}iJC|%UFdo;n+=xgGJxVe-*&9R7Yn&clS2ORu4uii%zqR(P zFr9wq*>C;DBXWOrfjjWNRvRY4JUg-|cAB=DOjU64uKcT3^v%>%kJNK6)oxYYGn7-) zkGWze&rhVG<<-Gwp^vq=t%XDM<*t;F)Vis{sFXH7%f3waHE(3)q)y|pxiqtnq_k3` zXjB75hy5Y)l+f{ea?7wCfhXk(EkCTBE*5K+8h8*4X}pyVzNQS5RWu%w ze*FHF)s_D=z84px)2VAu8^LwS(X$y@{!D69#Ysbv-2Sbs`q?9QWs5-Xp(>3{qVk-+ zSIf2cen9V*U1ccZY2=ivfa1kI3gYhzy?Fz3d^hst)+FC};>+3phB`JFnWj^$%kMJ7&wecl&-<=qXOqukytpc43 zq9>`i#Cq>{{lmiss84hIS_vDNPn;SFsKO8gJOtN4QQ-3!;vt&5T62b4O>x6An&@r)?TzXD|1rDNeC(3qp#MQ4RQABr17M(A&@ej zw`~r+5;H8QE1XK~!Ct1Qdn~`2ubH?k7+I7r#Xe+oYWRdFKh|lBS?l z8@;y%)^PHNJ}cfm1I?GhMg- zdG`6X(4@JB)y-=RcR7j0NiNmpT=ZI{zgnSAG1PtX=7HT4$3ZXA3%7N_%RcK` zh_ifWs*m^=x++P-pdQrm_C@P{=1ktMZ`7XhIp6fJ#On*pwvu&4 zP?~mE5b2iY@%iD`5xXWm*7WZhzR5#c>?cdY7i;YGL#_(XGnNhMY;K=vb=x)321sc$ zWX5FnYg$(VDIW(fYLk$awrn?>IZv(WChXr>#ww;Rybe@nv!{P4TQ1P0{Uo=J0u3o8 z2`#ipvbr6q?=?OpXu=isQd{>$*)VdYd|~r{p=PmJ;2bg9iboo4Hu3iJ^-Co zcxUh49hYiu>3%h3a?Wd5Ho1O4NHN~n$#W%H()%GopezZNS*A~C_Qs-cp51EbK{Yu- zfsCd4t(K%xgz$KbLQymv5DUdJg$J>WUMdoJ~VEPi?IErn@((8DIr43LFv zc;-$JwgZKLU^kWrB>W^7w_FN6r`#trzi|0naYym=idqncEd>k3FVfo2Pc1TNtM?Sh zNT@jKMRkPx(`+O|_3f!XY{ZqOr~C-cyr`OtbEbrTAbZQzePXdtb1M9{EG34CzPdyt zzPjIpYwva+>?`x<=#g?UL<2@X`tXz#ig@^300lEPwt_&SY_t3x(ZVUtC;aJLkr6vH ztQ|OSz6-yHPYNB&>uvYXNm=R{Ai`*xMXr-Vo2aFnMHFHS4!?h zar5nIEANsu(1v3)I9wI-6-uhL6Fzz{Erc7MVGcI~^|9GX8G*_k*Ay;xx2Pkx&RmWP zN3t0mGNisqRA4n`C81Zv>Z|lozRKxYxpjM1KaM}EgdFR);^^vU5>YU8*q}R|LNP095H zT(g^AwG=K`9j7Q#@Y<)*_}Qo;s6fbQ6WDcQy5}NXHYfb9fC_6+gjSUk^;w{+IEBT zf94u1d43_H&6bt9B>d&c)HrHh<93O#-1&hE^w5Mr^N2Q2Ir5(K8~s5nf=pj)>;^;K z7P&O?&q{hrCMFz-)i#=G9}}&WFBTr zW|hXYFz7M14Ak3>VkVw_<_QZgeZd4)woaidDA#OM({-%iGe55zEP>EUIyvAvJw{GN zRk|`HBom;X&OIkrndppoGPS@t~K~D66H#N^D z`U}*MIgQdo#}XFdahG^opWm4Jn&F>-d|lwj#04*Yy|iaHa|V9rWY5ng1Vaay@69V) z1_^IFKu15O$sAQ@viS*mi^`=;#Ky514(8RjIt&|!65>07Ef}c2Ugf3#5+PiP3r0%=> z^@Es=?IB&7`x}HaJ(M6Knb6kBZ~>2Jp_T{|Ez}IA%ZMkbNG)@z(4EM{|hP=oMn0=;e#!OFkn;3{(7ntfLnyxu@Tiyr^%-Qv$VDSmD7JV*)tTkvp@-FCX zc%>F=c=-7Vx#eaxE4ZQx^;t%?d1t^*vczC_wKg@xhI*an7; z_g<+<`wQ$%Y`gkk3TZ*xKo$Mzw==*_=eopbe0 zU6Y7FFBPuZgBEqXUlPs@rq2Tn z<7b6dE}@V#z026NUsI_sbDBefLXB3))xyz9(g)@s={t~?C0r+@0~uuQRwp4WzjdZv zef1#}ims7HaJrjufBfJEnupewvXqbaK2ZX}!V7=?$i^}ce*d20y2cFrO3+`uto`Nd z8^OiR-Vz=*i@B5+SLpHnnfUlL;vidkz zN(vv5eSxV4^1IciL1U3PIY;1uhsKUlcjX}#gf9XA38FLc*TV1;DCr28sL|H<4FN`X zL$4~sM0#YKT1DZoLC)IJFW9G5Ifb`NnBKzCXk3yz_#nJzeK7(01=I*25`j^2{a?8{ ztzJLm3t2(39Qu8&16ZKg+H1x5INtIWlDN7Zh#EKBU}GY&H8f531pAZ>iAR+4c56+g z@3i&J{*Ve4V9{epVYy9`4GmOuOnyqIha|l3@q8V9hBCmARaleTWt8fZ{47yJhF+D8 zcUL;1ipi%KDTf}R*q+fTP*sP8Wzyii;a*5Wdm6c5hapjqvx7lsW}6wX8NP6K@o|$f zry9o=nwJJbr=g{P76((<9ibM+&X%{>$Us9Nsn3&+2J4E(KLOc4qUk>MjZpggL#Yap zq2Lh%3RJe~&pV<+tSC<10H>GHP0^+|hr@VYL1;$mivWkrBi>TmemYD*u4-#jOEeKL`lXg11xLmB?Wh%iLjesL}??H z=~MEC218oibsbCfdTBGLE%b_tADQPkD*Cw!0TnAB{j5$D7FmV!2qPYG3gaqH#p^n>m2T~iE;NTOjAIToBhPh0f*%S@S@Ht_$ ztC!t}neC3U9g0<4&drUfT)hWO^dPZuUv z2i*}GxU90A_JN>D$c7=RUE>CCA4#a2Uq+b|-0HG})6!=d3ghG_SrkjUJ5@ zubHubZFPxr8#O#)FJ~%uDOokV*;P7YO(|Jx8EW0Fc1W2|QfZm9taiPky8FGTr>a%- zb84a2^-evPTA7pD(C&X%;(v6pJ*PoW8O65C<+RdyuF@U5zc2V7iaYHkwX7!(Egc@7 z{$Y>OlIX{5^X}qTPOQSG%1+DvldWgw^0bSiZ>ifebGM9ha&Y)hwlQh>Dz(t#*PU+J z7dIFGCtKKh`#e(Uv8Oit-&{HWZuyGoox^pv|59P8O1jeM!}67j!qc!-Yw0|FYs-%0 zaov-|AorRIo$Ye$@ulPQnBsjw>DV|Ydpj52u8Taria`3GyRp|7 zLkVkYwsFxeEoJIE^^{-9Q-*fN{#`_Bx)pT-r^S%6o%Ea*)A9~AXZ{g=lEr0Q>a;_` zNZo_Pm`T&{u9|y++xE#rYT?0=UGXbBb+TpEL;U(*6`Z-JwKK=@@K`#! z47NUAsoq<$s{YC5?=1iSV0Ike^~&AljrRXBzq4jarSkvmbn)M1A?a`F_@|`&Z)le` zyZ-c+b$qYkt-)QF`smAtlmC0|+*huCQ+DRrytF3aT2AdSuKF%-|2MkuPZ^MT;PN!0 z(sEH=Ik9Y9eHYdLjfnn7dHA!k|0?4#Z8Gag?~0=I$EdgS4|)GTuIyc5+~;BIsgB&| zEUWHzcGS<3=m&pkpZ`V?Y|f6H<3DuCS{@~HHljw?BVm!wDW~1# z0Y>f9J*-s!J(XnD5EI+^vq+Y~nv;9eI(vnN%0q@ZPsIzfPah$?pl~|%O*!fJ&#`U= zauW4L?Td6YScwBj1b+M_(8^q%Y^y5A3i^g6Gak}(jJGlcj13*7e9s}B-@SHZi76@o zG=!T%&)(kH+Ih2mDx;pAj|e$lXYI?ck~`|ZFxm;~dmMY5SLt`Hr@ug3zc#@T{=R4G z5BD8fXZ?=|j$a_6zrqmQSL4JDzs?u?)8PFEC(CqdZL>@L4W49|`uFyV81MH}+1@wZ zeE&1|yYEy~v|IEZ|EGD!i;4Y7{||hSBogu8VE=z(|Ds5ON&dAYp2NI`{l7&0Vw?~F zI4Wy8%KWe1J3P&d|F7J?u%Leh{s+XaIA^qtlKRFUdlCM^c8L?cC;VOQKWchs&S3%o z_`|as=e`60;G5oA`>!6{J6^Bm9|h6gfz^N4Pxw~~2(mcI-y8I}-qDfow^`;50Quef zBOlf~gtc)lPD%Y*NeS_+NoPtgUAjSHEG{(*A~*sqg~;xL4!c-hbr={C{bk z-+Dar?>c@_@0+l;0f0aH>0iBHa6#jL&Ha1moiT5~A07Ee`p5TH+y8}X%u`Z&Z^$bp z{y!4_lZW??*L!dN`M>gUzH{vlJV&CuyrCSXv)OIkEnFA;n2~Q(=NhCy5sZygrrKx-Zu^cpQ0ww^9Myj1 z74f-@drD*BrGRxAnXwBj{b;^Xep+WW&}~pvci~ZuTBhf^)3BWwP&GY;q0B~~;T9V6 znub$4vQIeUNG>)RtjmZlEPFG>=yETd7cd52fpxTppYf4=sWdo#>gFc>rujir?n`N7 z5u54T@pp73^;e)z1cKyn@Y(4H1FFNHr-*tnKNp{AH>~cemo^7}yo_{tSjxTt;3T)L zWzZwUpO`*1y>+L}spyWH7VCq38V~QwE-fdUl`F&lz<14W3?%0yG4GVz8aJfiq|T0` z58P=QfcoAO#pVD2jyBM=<&njzMRRGrL*41JMcw~1TLA#7buDmmm}@$%b@GH53HqlA z%{~onqT6rIKK=E({(oqoei;~Vc|{3GU0BE>(ifj-3C-DrYK@mBqSBKZ{|VGqenmoP zg#)X;yczG}p#*|$yKE+x^a z{9q2hR7;$P)&&S^eWiiaq9TQ1qed*17&B3#RlX)dAf*H3@^!pk=xMt&0eXgMn&!oUK4f6#ct}p$*d1&ZI&@vq`YwC&1Zy zuAP0vOVsB)6wjJpSXei0mw!#n|_TKG|;dEjL!ZP9ZBsX4#_oh=6a0Wqi;#dMYXeL*Y>kxL6S@G};A z1_=ONm0seRgZH3fr1IF3z7LUZ3u3+0Wg_ZlFGo{tfRArhQ(q7|x5n!$UZB8_1X>4^ zY(PO>8SlIJf>q}Tko1T?Q4Z|*0BjRHOl*zVLFzP(1P~T7+HidXK%m3L2Yxl%q(C5m zFq5c#`=%Aiq_5*gGC$^Ur%+3qZIihD%6P?DZF!7KxLaj#K4y10J-Pr044l6^F12PJ zJTXdi35s-QFAKphxYx&zzK!JnU9OP-MZEqF0FkNG-;$5t$MY-Nk)z3`v1C|@vEJ0L zm1ZfG?|r^=0^9c{>FCfl@(OH(SJLu1uW=`fw1dQork20M;YC;?47pvi(S{2al>|^c zkz-fSH1W7srowYnEZ&3)0^bFC#Z4&f-~NE$29yXgPE+BSswk*lRn4?3Ty*o`-2 zG3$~!@p{*KQU#WXY9=L4(JxO7I$*iJiMXA@um`-u>}Nt#l--I^{tajL-)O zWj@MPE$tDHoy$dn_m;Q#$f%sth@ky5<+IJI&O!efis3p5Q^fi}mxgd=E0?w$Nl^Ou zCvBH+40_NGx~&_VaCIe9$+kPI^1C6W(f!srC%STKPX$-KnqD6; zNKvE2Q6u(G-z_lL`y>o`x(@&lH)jF>5vT8yXviOp2plDzK%t*aR3;t*of}k~bf2VC zQ8GoKDCZ_UmxuHT3@WmOdJ57~5TqIHL-f)0`sEs={e3I|@z|cAs3b$-6}ocW3iDge zQrM54K~7XIVIm|*Kf!mw6Q-`${IAfB|G1&*z{V2DiGYrH!%t$jyNFu&!=-anMg-fvVnQ28y5pHL4NoPp55 zlKze8b!`Rmiv!+Dc~@4vM@|r_@+Y>pyo(Y;lIXIu;gcs0`F5QF*j+sv!o-Iot(OO} zrX}X6N;icrAhrhblqoY*m2QI+9kdw_3l16@1~5)oPfYI_Y{G18d7vP3{G8Mi?h&P% z4#0qh%{&R0Q0^|`!h!du>80Y@)1va{Csxot3(e>JOd}mLNsbHMSF;0NK{%@E zD_k&s+^&V6d`9xb1&7zHt-LAuVlB%b17rX|3k$l68n|cR#Rzi`G%4R#W&B z5s0p^Kq3;-&3dz^{H4h!+eAYrcVNOQT`pNOtG9Y|XQ9NGK(;7-@av!e`x%5V>go7`HGfvyAPb2`;6Soqfg_X z0U0{cnpRl*x#oJN?%A@x_t~3*qof3hgG3mTm{~JB_=EbS1+K*oKQ<2?xhnbjH!+gm ztuNQ|pL%Vt!3%%%9vW&7`$OwPvk%Iu_8XOdY5i}iZ$JOlUcLB_0pfiGFe_=IQ%d+V zQG<0(1A}V#kCCB?E+hTQ8-Q@b004{t0L%aYYzF}3&j2if#6Lp+k_3RgEhq4OW-oc# zS>tZoKP^A-jOh{?9;~S!ip}3C35AnU)r)G4ByxBI+`&eU`xgs92h== zN=@OAue2;Y#$GIVQRX8MpWjeFty_%Rv3*WW8W#b1Rb1R ziSmdP2h%t-dAVYKTZiwC4+Uhv-rDMDyO1M477mUM&NFda19}c z(=IWKrjbUNMw%a?ef zRzEu`d++&QH~wzp&~Vv~NeO#6%={|^#E5{9lqv8DFm9MvlqRcD72Q{$aTTr2y?>ms za)e&+(jW_XD?kxOLw)$IuIY0X&3Acf`CDM#sh#(zKd$s&1t$53E;P>I&qNGqhXj$K zsz0Zo(EO(1?47T_1y;v)V1P}KVh}P zQ1M2a1TwdW3^()vqWS{XZW!;`660eo>XG*>2=Z5r4vMFU;xT0M6bGiQWuMQ^BFYA2 zaDBLi5Vl!0;vPNl3l92a^=*S>uMs3Q!_gd6&`&^3Fr^(js+C)t7qQ4ZQP+b9S8^@% z#+RI8oGuhXM3}n?wMT`|lMyYMPYXsWi+W~!FKy>v(xK2S>KosWaOU+^05e5Z<70{o z)`cv9CR2qX?BMwFu8Y5`mj?G*Q;UZ4yB3}Qt%6%k7Y;w))voKWmMDlg>YewWv@QR0 z7H*TrY?wqFj}Yl{XQ?0^kD2q2=^-DoXQtC#r10C zp3h3{-ky@Av#6cQ&u4zaog|nLSby~WZxSG%p#8NINc@Q|52vWVvGr5RO?kHtot}hj zGmlLFxUKJszb!O|a`grrv`%T3xf_RB83%RmHnP!h#MJrEA`NMfOkIiHm91Frt!_BY z$W4vlMJwKWOV6P!)8DrKg=v4JWb9895icLl$bSehvVQO)$n>*=0L*18rlAE1-faO5Mmud=sv{F@B$p(pXY|QCf2|E zWfu~q8$VwKEKc=zgOb5e-~V~DE(*P?>u$OX4(M2 z(w&x|CsD*PRj|Ggahq}}YZI@`IbA>QW|pxM@?nL@2aT5v=npd(Qae>EBp-+fnFx{p z_%Hy;<{&A1_sW0xKtdu$MJ24%EDG8&zv&EkKYCl0zuI<_zvcLT80|x7Hnhf#)nn^h z_4Arz7r{;1@`cAqx~|svhVQz3j*ceEg$>z*O2jQPILcORV^h)?;nwk0AxR_3WYve^ zGwjXn}1Pvm|WZ^lE05%lr94IIPT+^n)qjEzP3(|`WK=m%3V4H^vLwk z&+y=lL8>wok=+gYXc&1`iM`*?_-3FLNE;}0X2vv*A74>@lsc_L6Ah0w!XwJ9=K%Sp zgjCplfc#=)O9%VM4?mrx&zjeq`5voNI*4Fi9ZT=4aX$<8k#e-JrL-7?r%|xwP>2LS z@7&keXG4NgGnm%Md?FedY3FNw>c4qY(^`qud3+UNV$KlCW@!NJhiG$^&kgM$T?eDhW(x=ZB^8UP53a5XsT%)a$z z!`{==9-z$QoA^%fVUmL0k@LcdhTH{l_GA7vJ9ccFJ2TN~fdKV#_G~nvLHNQiX zY80kyle!5}KXPqnStA0fq;!TfhGJGEzk$c3YiH#cXXIneph8XMVpqKtrQUrJ0pgRt z1wjE53YpKQp575XFJa$Y)rLW zI%X_v9Xd)L^DYlxT#j$o;WY>nFb$0oln6hSpFl;!D^F6= zOvDTq4VFhE_bk$vLA5IQ55x37ohhEt6==M&l*sRyWv)|96qYscike4@zH8vPA$6<- z#n;Vh1>TMsJ-MwPWhf?o)XPvNX&|FZvnZ2^A~MAE%nu&vR18WLF%uBpy_p$iOy%_~ zYN<}WFuzOG7PhS%D(+{Z$8{yToDcn?axw;v*|bETh0gm-icXmY>Jsna5=Ow_ADpcq zCmH4Bse&_HC`w;87jR0<-F{H4VF~UnN=;M$ z*=hVlj1}!_G(|C2eDHKZS{sKjio;B}1_9oR=kO_!O_bjqltpdds;*j{I&DloVZOG@ zcc{N^W|UDf{tmXVjvKtQY$m`DUOCEQu2(E*BTK9#kl^zv*!B-wiZsJU!CnLQwDFl> z_JMDf4HsL%r_jXT6opj_lXG`D7B5GAO(HNeZPSQFqHrySN8ZG&NBnWD$CJG!MUo)X zdmtQNT|wf4Hhx-j&C55J!ZkD%x8*la!_Tf`NfqYxjh;c` ze%CyE@Ih2T?|MHLoOFMmL@&_jm|H6y{HG#S3#1dAmAG4g8p$nA z=8iTsoz)=93Z7j>fxPR~xFIKwg8u1TQDX>Z7*7h;)9h;0mr;W#v<*Zy^A(9=6)LMz zU20|C6+Ffml~FUv>N>x;L$){VY5fPO}<4EdIKKo#s#7*Em z3$R0MiaVvg^^LR`#r?DelRAY{t$xoxTPREN`j`hpXLY5(u)`p%rYHQqp*PM&T~R52 zs14NLu}RC#>w{I{s8OSf_%Z9)-n0V;%SvsMf;iix1}8@F^T7x zn_$U;>$p>@=lZ_-VCvg6Qa+88LLKq$iQe1QD`Ab>KxV(KNA$2l`FknQm)f3Cmv~)z zZdJcJc+}bu-VSGX5O|OXZHR815q1a%LCQjDI?4D7x)GtiPv=$WJ#&U5*@^d0U~6wGFlmaHm5VN?U+3qV1i4aKe>6VxHF~jFC9tT%@O(h>#--z(9(pA?ONSJ%SP@$7 zYgy78to@PmwgQg8rM`hY?kR!`r1rm$(~DXBmAZ?pL;n^TRh5%=Q5K@=x{}`a(Ve0 z6CL+PJ$D`?NJUVItP!N1PM6;j+ILjNq0M{73C!SIBX<*F2NLd3$R%3bqyejL23@0L zn!+d;P7|O=&Y~HvaIFLmg(wWwiLGTAbh1V2r!A%j3}s)qZR6d=L+0T>kkh@pN-I9! z%(bU1!cvg4?VV>^M=idxAePuiGsDnb(*4pg)5p@pU_U4A@1Y{3GtRgDO)#AN$#CX} zPcX+dFIc9wEu8eHv$nogM_6fFXyCeMihW=2>`J>6;2$rZvq`RY9xGEYsc9gTWB>a`z);L zXqsQK3=Q!POnl0Wi3(keNgHj#XT;=m=0P!b{j%iX*6S z`%r-}A&B+sV}VWxsbO?=DsSJr9A3Av{bQ(7Z)6CY#!m9-Is0fD9dsG;`@{gbUdLnI z()Q~q{){eZsi3+9SW$mG+DHCd#;?4)c@}aG=>0_Ql^T%9)L4v{WiLOpAn1{uVB{4* z$W7Pw%~DzMs9QS4idr~+zS-pmFRE=}sCxN*LOOF(o?#x2ZJQ;iwY1^H`8*Eg#&OC) zbv-}j|5lP)gl_1ncinlLv%D1>Kr~n35+nQd^*bx7Z>fdrbCFeXcz|Sf6(#&P17Rx= zDJ=iekG+s+clCpKJcrP!THdRN_bp(BidX(!-QmyL1hKA&NxdqH%{`u=Tx^khslAsK zINP>8m%_$II8O(GoLP*YkEv7^74PPYv3yv<>F`c$CR*>{CU@NAwM%RR8X)JVDBh1u zC#NM}ZGew2#}D5Zn1w)7QQk6Z&WJnYVl|EuM?fLq-4_A@MQ5l|n%vfEWHZEfK_{OP z^05L5-SX$8WfEuV7ZyIQ`^MIMWk~F_l0*@;Jtv|48n02&^%}w=j-)m5a5*+o_SKK8 z*>xl7yTkJ=*~Vk8I5}$_zc%)>?nU=Bm~QdmxZ7*NT3L zXtG{A`7r&XR9=%>eW&0)+7p}F21qaC}4MI?m%pI zDXTxxJ}0!@4zpib?@VAN`t*MGZ{NrWglyvlodh23VzyZo$g)vzuPm&Y)-X*+-T~U# z8T0@TN)cHz?9w~pq`+GbQnKO@0i%wi6>_hBY8db8iE9td0#}Z^SPO1oeSH zt2tab$oK~HDmmh_K-d9PM}<*d_p~HNpS^ev$in1}xDgtM@E3wFc2D1PPI}uBj|PXu zpF62H1uewN>!0I&NwKI65=(h5mwg6<@foTNCYejyhlHei5*7K);YL zg2x2h2gRKbq6LM;C|azNrZV*j9Z%`Fk&+S9(Jb6dS=3NBxuVpngbY6SFKx$&o3I!I z4;xSJG2UvYd&HNpFi&)!vVzvLezY1xW*c_IXU%dK|2W-#3dFo1z9=&BxRu7A96vfkfMK;e%KHt z&dr;~uivhu5<%}+I(i6qPqz1KV&PV_`4aM-rdrhQZej{-Es-!B;q+dlzE5@W74GHS zj0n4WLzJzV`eMk`aLQ2C%5kbWK0%}9R~KfW0CRkkqd9mEv3MPSr4cet&AX*WxypHsp3*&4d; zT8m-5;1EO?GdCU-`3cmecMsW(z}sJIU@(HT&OH>hp2wThPEjf2;B4hnXM)0EWUY$Y zJNKI@1}Qa=Cm&3fjcQA8}{Pg->I)*S%0%cOaydX*IwRE^U84R|9I(2l0IUFbv zX`EKqzJ}%5VbcFxoodC1fodDZ-v^5DFa$(X6%L!3XjMs6yYoYH)h}b0?!#-z-T2AC z)mpeh4DeAEmP4MfG3X*P1FuccF8D#}9*(^Jv}t36!sd7UT=b1$k#7%!3DfkAYj-jo ztvx@Y(K8T%TYtpU^rIttk?DlbQnp~Pk8Ngv#&~Mb6?S`wxY$U83OxC)FV$w1X*-@X zfQ$q@lSV4GB@VPJlZW!&6vZ}otyhX!1E0QGZ+H!}5$Q+L@$5ZI^7Hd)wXhu}p;7uk zyIqh5Y+k2gIWAhpd{W`v=Z^VN4gQ91wTdmTB^=uU(u9Z?h6bJPRkg-`a)RSpKKZm8 zLylmSnoy#ripkiiK!(7iWua|0?@TfzIg;@}jltDvld(W-KEMi9iv9&6t1Pu6p0zSX zdtsF)U{GqmklW7r2zw5a@u^pg&!xUR0Y}4Qv3}@Er$E_g7c!ca$Vm^gj_`JRR(VA@ z5vWCtDfY;Ds37lBF4BYUF;MZCRlF>Q&L04W9*_bx7v&&?)uFUV_{anFJ@#<3bt$Cr z3LmtnU6CDHG6&Ph0*#c&wnxfC3>=wMDNm?^H&YMv?8V2H5mpHp?k>o!(|^8b=Uaa5 z`+7#?K!6uHf9efP?>T;8G8x*FnjI*#HhSNN44nx>11hm$2} zsfJ-KwVABjH52hulJf(zESB0-EP?-YnmbIk(@$v$C-x~sg=13y1php2LHxdc<4<#W8P4b2a!J$#CRcaMs~ zLBUV!=1Y$?+ehEUoFJ1UH;V~@WG>)A1~bW(-nX-mDu;YA_;%zP!knC-ksX+^c?gb3 z^D_nOLe>cKYXtLH!6|rafYY`B(dhBlvXW~gY*Y{Q%3-y}1)DS!P;S5KCJ?5Hg7jpU zJ?}azVBp7F9AJD?dER~PjJdpFOcSJ*Leu3(w~S61A!1#X;#fUse2}lDdyVYMLXY8x zVv=V&PtA$Yz{LW}3CjWnT@*587hzF(HX6lZ%}=la%Wy`P$LusLB(iy-93bnaej=Cb zLaJEKl0VKLd*3X+)#%=oYmrQNe0bN9osKaE#uya-6 zdo6M4(kWQ6*ib~IZ6wXWn?iWJPX@LgTI9D zn>Q~2BA40+A=Z2Lb05arzXBJ!Uw72+yWIrQ7!BR=6E^s2GJ51s32DEk#S6UxQWPTg7P^j3&Co`21i)#}U3Ib= z-{0AySF|~lip8a4WCUkOJ@i>wK9RXPOoIKohOhp)t4J! zf6Ov__;y-6`p8G3m>>NlD-#(krIGRigS^JpBgp0VpAuCs>Xo-rh|-EycsWGR5A+1Ujzhyy)r)V`vj3SL@qUg=GME;7(g>+vlxaIU6+ zX6z-sD)sGf|1|Pxa+c{IN;BVDM?gi6pJXz@yFh~e8Tym2dnS|y8$Y_)Xt6cRB)I<| zvxuAZKK4?p?1M7)=TJa7?ljj&GNHF!(2KwXoO7M4sP-`L!6hYQ;qxc0w1-n)RVWMP z8tUN^STX{sDKrwb+76*!`(_L?v%{mcTko9p+vVp|W-hv|&_N1QC77{GYmD#*C~ftC z35Ks>Q`;4`igRl)TvJnW{0IXP4ByJjcYWBH>*>_!_oja?kM~PmT~x>s+h7D7UAs$2 zxqyUwY59+aCs_K^K{&tlmwfHl1?HkvSTxf<>Gzu5G52_tFLZxvFUd5?>29&MCMN&+ z0Y_he?9ec@i9TvUa&m|Np1y|bZU@!?5%?rOh_AcUENXGllBwI?1|DLp6Eh<|y%N=c zu3$Q{MGmNO`#$xYFU!dj(UnZ+W;IRbIMwqTFTt1{JF^jJ(bJv+!K=v)`$T_die{wk zK8N6O7^=G+zV^DgaI?LF2=SNnL8G5JdbjwRs&XJO9fcq;XJU-Y<_t?}@XYFGj>uPq zW^q^LW7~J$v1}7INqONt*j!<}ukE{|N9vUz37&;3n0+t^H{4wnn*edwX;(DAlaZC%>!oV23&xNU zV~i$G)w7p}!jrFq4+#e3>aJ~76AyX=A>O^D^M`JIt=tt8Pr-`@?<;yuaGdni<;6FJ zrps45n3j&VP+H4aj)+T{Z13!#rQ3&w69FMF93;oOHP+EUc~TFvOCiRONWv9r8TYN6 zNfZoG{6*`>Vl6-@*ip~~Q;TDtYNG@K0zPQ?aCWwb?6ImxLc{5%kY)I%&F!?pBjYj zi^OP{x#BfGy+7Hn*?R)5vv7EkO7q%4yJBv2T1FD1;(90)Y2uJaNVIRO6gBQy+YohR zXh>p2*Ln&W^$3~Uvb9Y&?k&$hi!A>by0FG64t=NbrPM~wewG@6Zi?K@S_?+zyrcMe zlbVE;HuNZgoSN-a4y7{$4wT~%0s$M+Xdr_AJeQHylI=;hFMz#I5PnowCM|~F1r7tq zu=&waKRun*R4AveXxMH-L$mTI)Wk)8J;No3g3>dQ`< z-Nf~44PE3{$Tvy0sqB)+W^=I@ss|Fo1%IL5vuw9qwwyXu{0@n%r|v$H z`u86eVVToh!teX4NBU3lgq^T0yn-Tn?y8Wg-Un88(dXhC7d*nXb#Ri@k0NA+$m+{z zt545J=(v(8o|7UZ+*>70R38#*&)yHfUUNP6#ODqa=i@WPqTJAMbKD@-78lnXrZ9&? z-2yTsZbrzs+>4V2M`$!)PJ4PHF-L7{*XFf(%#vDam9qm_IzX8D z_?XY|q=X;c{N!u2MNCk!=6S^5z)30fs3y-0F0>BXwSVxX>uy}tQ|KnC9qD(7x`MtD ziN#YLXrxN~6jnOwRytd86PRkJwvTksPcp<0M;RJEl!vtx(;_vIE{S7rJEybJO?{){ z9DNwDxH#xd;tt6ND!R+n8^76~)0(~;l$ARV-nkhE>%tPNb)`I;Wnq$s3FXGQ@-iug zx3jJOIZEB~yktA!xIdQbqjjg;`0*KUgvpBommC8X-ItTM33x<9L1$>Ol!)z7R?nHQ zxP0tQQ#cD|kt)1BhI+7Jsm|$Ngb=FfRSZh}*+faKRTtrvgFjEV!y#9dTd!XCgsu83 zi>)JWotn8g@qSo0ee0>92l%Ivkntd2bse+=uUns%6}4C(;qque;>?lNECJ8!YZ znk*sXgVSEJmLVjM;@v;&{CWB@HTioC!@5d>Q2d=JE8uWYry~mIqOia}Dr{C;*RKlpJd>8Y8_d4Tsu{S*7jMfalet8o05gCdy0kx>8& z)P6U&QOuFxDIWZV@h42LWO(QR*j?1;kQjscoR;}lY8s`;YUrPi3h%phG5ez`f#Se% zHb%A#f~Dk;nZm^2kU;bC%jVz^2i_cUKvKdIS=~TGy27PI` z0syo7m&R(jcTgRE&KgonwkLm`_OE*3nUKEZGLLHpa?&p>+4#X2=WAr;C{m&nzLoJ= z)K@^8JmZ}BrIop|q1^#3Et7G>tTNmqK0H~uk#j)DhRuuqT#N_;fVSZx5kRk}56&Wo zTZ#?@AMK@9|G4?62%do%qrPdKH(_D7#YTJnY#A@BLXh8GxI85@USQE* zP#Yx2C210S#oTit!|{YLT2Wo!v{Ib8Cr*YFuou&Pe-9KD z;D2;n6UI@M+rw4YYt4Ajcm<~5SNq7#smWsbR+HV{JTv$;$}l;N75#ck%5qRF3j48d zb&_bueu5#*L-d9yo@*^vf&0xKI@1%TY3rUVivUS*4X`dT`02I~o`VP!rOA%d<{Dfe z6V6kbUV1L7x+YrgIpKS&gQcFu@pzXp>$)(RWJvK_e!>&1bjmJNG&xLpoE zvOlsb3OmL?I@~}DEf~N&>Rmft@3p6NfjrI8YEo*H7I&q@5W|R!DsMgQ%Glb?gAAxO zV)?=N#p=E}?1x~E2(ueOL+(v3$Jjd+d*@VglXjy{PT6stT7hpcAgNjkRmmq{>+h2x zQ_QeITQ@%f5a0{e!Kr_0rB*E|)__lQK4P^%CQ`h3@AQ5e0?-Rlr|U?>f^F_QWL^e4 z^P&x@ELzzHy-I8%sZcIa9y;-@=V2rHpRCPZ*p1gR%9Uve?^aZEZ&H!#L^Z>EQ#Ze+ z3ertG9#)m8`BU#MU7ZJT&rm(`KUXLiqB#&=7jd6xTb78Wh3!u>iexW71^rCT__%Zp z^kA=cJ?Y5+52VY;QFH$Y(kq42-UvvwCh}{N3%N$*^t0e9EC8|7vOD9&XTfV{G@F=1 znKN}a6+~frM^g9xV2#pOEg58SqC!Q03)mNRJ@8H)w~R)cSXfXxW+zr*hUQTt-VOBiojn>4wHIm5ZadfLf{ zU}_JNdX)Wn<9qbCoqMH1n^AyXVw*DQ!zm5wDyq^dRbl-u5&Y}GNj@s^V zGtr@iU3>-^xyX{a;|BRQEnrNhRN|v;$9(UqbD{wpkp<-X5JfUPEn7swIwPj_tzK|q z3$TQNUHXqAOoQ;XP%?b1ICVZ{ZF)mDmg0z^Ig?|a<&U|&pw|?bjjW=C>KVD87)pi< zX&(wO=z=d7I0LkoW~0bB_)kj$Sh&vlm$}b*Mzwt57BP2@u(*QlScd4rx#T;w+GrKrZ2?q6X+Zb>^ea%8 z0P4{!A$@A3DkX5tnyAgPP2d(J1~SaspkxyLgV=!Rp%9aH13SI#+-n2K@s%d|s;%yc zB*>R%>UZ?}1mwvg^Fr|JIjm1SkUTc`Pdit0kjn>S4Ryt}mBb!i{a6k04QBj7GsjUc zZ?mbeTCZ@&yXCPw%|63tZ`|^Thtr8NCE93-5awR(ujS_4x z!QTeBU2A^~2d%C}?afJ!KQ7+bOKZ%35Bj|Kv@14RC4I#Bz%Y0kWqFrSFY;-QC)-IQ z%%sAdp#xI0wzWIlq1_Qus??p&1e+#8hbO&VB7MM-J*nmfiO(D@b-bc*_R(5f#+B%i-TZiHbfK9kch$YN1$33ni9FdB+GOyt_>QvN7Ni{- z>OjOlnOR35!95H!5OAJ~rrO^&R-9~oeM-#wr4Ii)<0!MQG&lq&N}u#BGqEYrnMY+T zH&V7!-%#n|Yd~~U`6@jeS>ZIS`5u*}2>dz6o3Jm{=FxKr(d~S@V@LiYk|0+JA`7la zMoaJcp{ueGBxb`2y&FOTrN^hqUeZARaLYz}K;QP08lnS%`jcO>bSzd3U?` zVnz^6rSg|q>WH~Rx?=Vuwe`E_yQvruxZ6PUF7{_AXHuky+-Imf}Ne&<;-k#~_I5uwDUwKD!;|bnK(H z%{`$MfEt@_OI28RNTahyM-MjNqRXlr+}}2I16r9vzRPbwR6?2npkSu1FGjfQsA_Y!=R1>(chn*UA97IBI}E= z?D1`W5DPW9PAJS6r z?HH|B>}vMzf7E*B_RYl1-ORNi&j^mv{0)r#&D zUa75fSiQJe91cEZF-&eznvokkkQ{3>V$18oT87##B248o$ZQ=(th-39AvYyOxyn|* z>AN=KS<^lR@rBpmX*rOsmu(&YUItn;tkqz6WVcsg*U6$J)rA4Y=HMbkMU*OpP=;a| zZd*K2-=7OcI=V+biiS?}b`ck&FX$-N;75u%;0lKW9Cqu&nqYbZ{W9%6%(zq!r zR`OxoD(*V90!76u$C@NqcW{B47h8FfHFxe%!49^KIC}OeXG_Wz=K^X78+BBtQqLa< z&M!{8_*dHfB*CAadRDXxP}QqoR(ws4Q&FO@Hg3ChIq2V4@jpz+RJ#36FPz3WKkCV_ z!67S*8E0D@eA@mBdvWBF6@>_zi5M$o)Ur`IWiIRyo;?{v2$coT*#^1+;Uo|yHH=yF zP{m2HKkWPd|BivXXq0p!EL3@DZ5o#&sjWRT%ysBV*vT#?%AFX3G56N-QUcuI`%4Uk zAyu-vM}{2vfxeM**>=c?!LF&zc#bHgGVlJ>-Lfy@g%2P1$g`@D`O2dF1Fyc%84wML zBaN=D0U}%eqV^rao8UT?mI)_$>2s{Fn*E9Dw1%r5Pghr9IEmb6G5AuzIX@xV74C;soxd=JDgyQtdL=_d*S;}pJ6qRtZaSs#DySy(DaEaF!cAtJ} zv1b}j3hv#xX0sp$il7ix#u@|(P9hW-E%TxVqaXrpL^;}d-Zxb9w&k`PCX%Hiy5-Nn zMWS1ie@2-}^iUTR047Y*?hX&sn0qWYtA!7u+yX#Bz0)X*Gd)*hgEOfTuYodepW$EH z%XYfn-EehMwL52K93Qd2Isb8#74;!&;}hm(6AdTM(Cc>+;QR--DPRJB307Bo^=^n5 z11YX^2=HmmpEY)5{M{d|k@Qc5-B|B8GuT0f7pVgM)L=`Ogbov~Ryd<`Md+EoK{kDt zSRE)Ag>YkII5vNc;8N4G&gidEwTdZmHI|ze>er~C?CihpW<9vd|9QSl?7{AqIhF={ z;InGneQww+h*!6ghCwLGzD70u;o<>ls9KbSp%@r8XanU9$5eY^9=mQFUt6{`h;E6m z?^C`km|ns!Ebavj^Zh)}XFsJ$fxy?XE|`D`68=gY|VuOC(~ zMA~hsd03&=wMcmwb1t3_*rv(zw~ooXTF*_$qHMoFCk#71(k-|tZfv}Hr3i1lLS5Xq zg)UcJ%Q0kgH0G_`^InwNt0qJ8&LHp2XWB=xV>Lz5h%EHDfi(JqjD|Q)f=EW6bMjKV z-kfM{N>x@*I}gMw_2NQgD5TTx<^|=d>bzj-j1g&Pmxk(qIV z*nB3hpmTn>z;+#l1Qp{96ja+g^6|?gc${`li#M=7h}&^>Z4gU}&4Fktf9NiScvtNp z>i&`_SJoM^6P0=-5z@AiVgbzabNL(DY@IzfO)-;>=EXYL6X@EHp^P-%<6-eVM1pFQ z>lxvRZl=&?78}$Li6@e&?t|6&L=uPAU1IIKn#e}s%3NX)r0yQ$b^*sqYP))r0@fd9MrRDYullUWOU8-an!k#RcZv*H09l3=ctVHlSWH z;1ultShYapK%TjQjC9b(J)8|}F>2@bvHRi|6z}ZT;r-K>xLyD^s-3jUh4^Rd+4oi39P7wT9@2 zA5eiA2Bbo4a1NgjgPsqX9U=VuI1y2?2F46JeL0A?LP~h?E#O=a0|(rvsX+;8?phG$ z4Vou|^nW*@{SFjjILo9pM!s+&9|j?g{J?k!ydSqE>toWWy&cl|jz~%EM`qmot6UPz zc@AJQ$U#UGddwZ;**o&vg}GyW>Au_$9PvNlzR<6%==b7VZL#U!QJ6hF!!%5eRW;}e zMlxH+CbWwA^FT2q^&9y!QD9)to&Z0XZ@@4MP-VA{5ZXVYjEc(5x?hBhL778_??0-9X-!;>_Eis0XD86tT0Gk5&X7ZF!+xn{^{`5~XG06Qa|krI+MI#&be z*tJ6eNJUqkPTleGI+^W%peGG}05R}$CQu3Ev@``8+(xidP)z@dC5EogP=;%~S=RwFXOx z%>Iv7i)ggVe~dtZTF|iB2{hQrG{^lqo->gz| z2AfNJkB@fHdv3>qt92dC0wFDr6aHo4!H&Ga6Fs>R9vKWC{>B>-8AR?s?9P5{iy1!I z+fd2FT0v!lX^2QbPB@2+d+tPH1YYkPJokE=hU(}_oP1vw!!o}%qq0-$I`i#24<;7 zlH-Bs{&S`!QC-cC_a%6Sx02hn9`#=)+Lu$V$No-H^f<8wbv6pCt;6)?M>ji9$X7Lo zgS!{^$A0Em5Bdyg@RYHx`0sfS^C(sKi8pVeXT-Zr9AGgye!ipx$vh|4cF2&4ZJvo5 zMfqEwX4QK=Da|Hjcu_PFiP@u{>|wrwA-GU|CI^b^dhG^M0rNAR-f*!Jm^Pajtz=ng zqFP&w_5Hm`?MSQN=QH4KeE+ix$)hB4j4jS&LU;EMf!>;Ny)64-p)>+T%NQr~*<4o( zZ-Jp;Y`2;1lpKll$Dz-pzyPZP!gB|uxhx5`O}uUXUt^ap+_pdM7{P$|xnpGl-@zW~ zq-X7TJV|s*V7SVTC{3H zk?wX#*c?srOyh1%;vyQ}(sJ;C{5dXwdcH52VE92n$yH0s(KKc*G~YNfJ#637FRVI* XQ|HGb=&my(|BJaIoG3_Yj5Cvfih0k! diff --git a/R/validate.R b/R/validate.R index 482e8c62..5c927966 100644 --- a/R/validate.R +++ b/R/validate.R @@ -31,6 +31,20 @@ validate_ww_conc_data <- function(ww_data, ) checkmate::assert_vector(ww_conc) + # Check for repeated wastewater observations within a site and lab + assert_cols_det_unique_row( + df = ww_data, + unique_key_columns = c("date", "site", "lab"), + arg = "lab-site-day", + add_err_msg = + c( + "Package expects either at most one ", + "wastewater observation per a given a site, lab, ", + "and sample collection date. Got date(s) with ", + "more than one observation for a given site and lab." + ) + ) + ww_lod <- ww_data |> dplyr::pull({ lod_col_name }) @@ -157,7 +171,12 @@ validate_both_datasets <- function(input_count_data, # check that you have sufficient count data for the calibration time assert_sufficient_days_of_data( input_count_data$date, - calibration_time + data_name = "input count data", + calibration_time, + add_err_msg = c( + "Check that the count data supplied has sufficient values", + " before the forecast date" + ) ) assert_elements_non_neg(calibration_time, diff --git a/data-raw/vignette_data.R b/data-raw/vignette_data.R index 04542a73..38c61081 100644 --- a/data-raw/vignette_data.R +++ b/data-raw/vignette_data.R @@ -1,7 +1,18 @@ set.seed(1) simulated_data <- wwinference::generate_simulated_data() -hosp_data <- simulated_data$hosp_data -ww_data <- simulated_data$ww_data +hosp_data_from_sim <- simulated_data$hosp_data +ww_data_from_sim <- simulated_data$ww_data +# Add some columns and reorder sites to ensure package works as expected +# even if sites are not in order +ww_data <- ww_data_from_sim |> + dplyr::mutate( + "location" = "example state", + "site" = .data$site + 1 + ) |> + dplyr::ungroup() |> + dplyr::arrange(desc(.data$site)) +hosp_data <- hosp_data_from_sim |> + dplyr::mutate("location" = "example state") hosp_data_eval <- simulated_data$hosp_data_eval true_global_rt <- simulated_data$true_global_rt diff --git a/data/hosp_data.rda b/data/hosp_data.rda index 872e4eca0666e58de08d19243a58c7beb8b447df..9bd8eff27d780cca319473463ad9f312993a249e 100644 GIT binary patch literal 586 zcmZ>Y%CIzaj8qGbyin)5oPqVw|LgyYb6CRv|NmFdA`tLD{mugi21W)41`Z%(U_8JS zc;LD-Ti0Y~UuIvEjEnoP23+j8!0aDT`D>N^RkvAe94zjy7D;8LBnQ4SG+>hEGBI#g zY+&#e_`st#mVd0OQoJpNEu1eWVj0`8ud7L=JvSIUqJ3T!;9Rdmt zjZ7>YP^xEIq>IRcJ@>5iIlBD)dVjS&+`c~RqR6$Zf7utJlxFBjyi%Gn|3&oT-`&Zp zeMPrvEHf0DV#yLLceP^uwY_Yy6GfhHTc@Ek^W*c=RezVAt?+5m+<0{U*0PdUslPdv zz7n4j+#lPta@r0yoY%CIzaj8qGbEK*N4V_;GHfBnC4hD-SW|KI;M2n763zq7!Bfsw(1fddE`7!NRh zcu=~-Wmy9QL;h6f^(5fB_0z zmMnG<=Im@r5M0Lck?|D+1JCUHk#Je4B4bTKFE>rKdELLNX6?H5TiQChdWONfN5?1Y z8lCmCEIM^M(<^T2hrRhlx@)UvT-%h>lOh-+FFaFF#mI6)L}S^bzIV-&E*|E6G5gq# z3dtmiRehbeo$s8>(=1q|>E*J&Qy|FtLZJDZdvl~W?CpM8B%Za0)#>)Fh<|Ym>r@J? zR#g2B5R{Y9nkTZ6lPBKBnvX}$RY_wKgP=lJkU~%^L$$fagW{qqq5)zLSeO{a7&%zf z%&&^9;1K%P=+da*A=t>o(x~7jX#9HJZqv8d^Y%%--a0-1|H1V7uB&_Xel$r7PMo0V zYc>%CSU3a}9DwQ}6qk$0`MAGXWgJWHY`t6aZvN}p&%}ZLP z*{+K}I9_^Ty!>fy@O_!7OYgrqnZD}E+t}kO1-jBNeq0Th`G@1O%7p*` diff --git a/data/hosp_data_eval.rda b/data/hosp_data_eval.rda index a663068f861fad7099622c4f541b9038ecd26edf..4380d9110f7ea36bf1884750b5a71704e8602bb4 100644 GIT binary patch literal 615 zcmZ>Y%CIzaj8qGbTyk&W7Y5e#|BwGS_6Z694+Ja%4*%2dE_lG;z`y~742%buCe4u& zYcg56h{1%}ZI;>cf2(Gim|T3hDDy?b-&ZRbm@f&MuL}7e!0WhjL6SiOvjYPI1FsaH zk;%!<1t%wSE^|1M!OOVJmxo~%Ge^j>uFM4t%nrP~KqZU|G8n3Q}Gq>9XBgZg=Js+$dP_x}2GTzbjN;?p*Q7hdm$umON(vEvdA4%kQ(&mRxojjOCwK z@9f|Dw}qwL)=FuM*k|jNd~ZD+oID*1`BV+O=DnLH>mO%%c{XE*u!n$wzyU`_0pXhZ z88L@hS_HBZ3^sTI`7E+CZ_b^07YGkGTsm|{_mD??%Y|vz_Pb1&C7kg5XfxZrd)pVE z-+JN1bY%CIzaj8qGbG!$X8XJB1lfBe6(Pe}Ox|Ns9s2sr#tzq{Z8g98Hx5Hc_xU@Dr! zD|1N1a{&WeZ&%LWAooQEhc#xU*oV}=TEW0zRQ)%U)7HeqmqF6jfdLE@RxV#0ka6LH zNd|~3#lR~!!D-3l;7d{rj0+dAIb2-qz__e|t#^L^0=?FT@v!T4>Oi*QiM z_k!B>Z?qbpO<}lutYXd6{g+CdUj&JYP4H9_;>B0T4d!gHXytvN#^lB% z#FU`0-F`;Qf(cC~2?i5fM1)x;1O)i7va&eZY>)L`QTp8QY+3Z|H;bwY9gjm#W%}w#Cl@p{Dp+-e>>Lnrr0b@wwQALWAif=$>i+-eor!)T KDm<=?{RaRSr2DV{ diff --git a/data/true_global_rt.rda b/data/true_global_rt.rda index d5486e87e9bbfa7fcf894c33cab8830ddb55cf97..749f9dc000ca8476a94fdcb686f3c7555d86144f 100644 GIT binary patch literal 2187 zcmaKmc{J3G8pnS###kpLUNiPBgt81-!VI#G7Za5&k!7YVQ<99SJ7Vl(#y+7MhRIG% zwi1OaBxX>SDD}#crn1(H^7fv4&OPUzd(Zux=bz{MJ)iSDw!S!XL$uGq6F$nytBU~S z`rd!>Wp8J%>+f{uUlmtyck!4~htE*>4V_BXxvrN|)%o02WELZ<7>8$uY$8ES-bZK( z6=p=FB5@mudFpOR5p*Ff1+7_xT^!ee0$GJty3 zd<+C*Sq9SQ*m9CS!QjiFg?(3HfF0w^UW z0sxE-ys6ei0z4K9frBQY1k}}0yc{NA2ml~98Q_)C5g`B<{`Uf+b9-?B4uNL^@-7-O z@=jJNcxJCrqyx>(u}Z=NA>qtiJ8$JcwXz#mqK~0JDwVN|!$wuCP;0m8I4jhc17s74 z|M<(sA#g<63Dl-(I!k>V%2+R60RA^#HBkjFHA{k@^tlEe1bP#9RZ1_oe9FOrlTD=2 zTWb=2JsGazo#sFW^qU(@5=Bpax5FS^p_;4!po42~D&1t6Tw!a7F6<{%mz90u{oAI| z&jtlU4gTY*zhttiH~3nV!#pbI-@j zY*o2qT;kKw8q*k%;FTRnZh%)hnqwaKk93pD_!x$8b)7x?&;^)R#H{+G3xV|%;qW@! z2{D~;ylSziKLi~--EEywC~eY$&d#H>b_mzTWj%XkUl$6~o6*bQXD*8D&Rlq#;Fr;N z=7az19_R1ziJn?VudP~7ne8^&fpdAE+v8;{w=T-IJ%%m5HP#k{_Pu_QW2C4J?E(F? zz2>a~9aP)`J3~$Pb@Bv~v#*Nl;%D7Q;ach!kGP^m+JUx=>FJz?tBBN~;ohH#{a?`~ zDfg-oe}Ymgu(a_HnS=ot2b^zS2qUzVi$Zq@^c9a4du4j&D*%W+y21 zl{$CdMUhq;JwuOkn*BrEn}*pw^6kO-j{0Fbx?Lc*IxEfkjIv|2{dTeR`bz4tr779H zA8^6}7ArNR`(h5ZL8UQ^ny(9&ZB;54MS57kR(z5tbbrbl*Kp(8^@)>Jypy2 zz)rYSpJ4uu`CK_#$>M2C=Z(8NTJ5E2nSpKdIwg7d!INPUVtvT3eRhOUMi*)JlGO?v zG88u5SQn-D;>}eLc^b6mX~WiSN|B>wRsb1W<1G3h_gRvJz*yN zgA_Hy4+rqqw}Zf%hzaO^na{2>nmNl-6n@Eo@%->auCbh#n$#F1q2$7{C-+rSid3z4 z9h!(+qZEoc=iv%GRJ=CgZsOU+gan-^i?Mp=s1Y9f`(?N|H9}kgQ!D>}@%N|StDx;) zV~*d&!Td+Ne-9J%imI==%TW||?fIlqcSpQ;PA;L-j?{E)&q8F(GVJhsn?!&he-&wX zg!738?R9BoF+dvC@K4s1RZKpNJ|%-->fY zD{PULO%_=90av``FlpqBb~i?HHkx(iZLlfUXZq-2TiL;3%fj@Y5O?QTEfGUyAz#XY zy4M;v%8P*B+cqA?iZe^UsT-A2svR^>4;Np1Z`Td~M%0+{&6N!pX;gD`{gJ+>tkC-4 zOXbg8_oh$TkJ`-=$e=HVgxpIGtr+|9UZ~J1U9WqwVR{1stC9Kj-Abq9xo?6Cw48ED zn-Z_;3IK>v^R46xNyC&5>OfLT&2YT*siGvOx29+B;I!yiWp(&hLBSeQp(!?14|Iba zs}GhsJ*Eh985+mG{%44$Qy{==K5w7o@~+0lQbv|vSKbdKujeF2eBD2H&va* zf4ETtyI`V8)vb1ws6UA$CW?e39F44P`MpM+cM|HgPrhG- z*zq|sX3wxPY(j9XdF!~}>8mG!>Cwjd#yBjvCe_SkGP1P_x~soURLjW5M%x*cf=5_A zSU@APFCuXl96J}?zdJJ6M%f)Q?mY7c!`Q3ndH9Eibi#ls~w7Es7EGVW$M+s}BT z!p9f_rV#F2?@Ka{8)^W{nm6sdoItYHAgAU+-3O3 z2Iv$~E)+n|gx?8_HXrCyh$-gt8+j6Phrp-3mZH(<@&aG!tpXo}{#Pm6nN(`Fm+o%Q3@q8hs-{cb%$6rSaf1 zF+k0?ns}d}ydSk4D!E&8S!Gui0fQf|faWF7mxfHp^M>wwla+F8ghfRAJQk$6b07FJ zvrxU*)o-0)aOdZhn=e7PM)Au#ofqiOKbH!9Ar?`Y-(vhGJy&{2=tq0+Kw{VVbGa_t z+`3P)8i&5hnlTy5$bO+B@ge&hXs#c}L0s+uUo7k?8q%r8FsqiNL>l?q>!P+-Wr7;2 zYoCK|?LtO`KGPzkm<8)5L*C;cPH$p(6pb@r>`bdw$pTJlB0cU+(LEbR50T;YkkiRt}cfmRbN3b^q7D zuyuIOSvc`CZr1q#}moJ@;OLv#w;s+vWUW9>Y6I) zit3A`#&S5ru()5W9MeJ%rn2xCQ4o<}HR7Eb7vZ@^?*hEo%&dnzSCKj7tJ=h287>-( zDbgO6KSC)Y@j<@8nE54Z`Z7L##}kp)zR)Mw69HsL(7KT~lRmMiHrA z=)Wzwf+i0hMvB6i-bg^TG=ohf!$EWatbLdO910{r1VAg)!$1!4a1jA06*zHd#CzfP zhyMQn{oyhD`~XB2Lyq>$VeEBvYhuZLPfV<1kk$luryvCOp-Z_mjR>_)*3!=WYEn-y?N;|06I$ zT3Y(>7tkm@Gc{kQ{s#4pyu1P58A+F9`kj!_Nx$GO*Zf(j;H`meVI_-Oxv?(&>v!Ns z6GDxTf<^fxk28Z35FdnKYt8N|dWSjS{BBZGgO9@0v?1;6;n18=M6US4 zc%NATfsNOqytmu21y+mKwuNyjr~#FJmAP_HGtfvL9h-O>-ZuRr&Mv(6y<2Yy6_-0M3SI5o~W1qj689ZGcl@WL}Ol0~-l)ELp*l=U0+o^cJ_4M#) zs>q9%(SdQR3H*yeSRY%zu)>M2*5&yfWep50^i8WmsXxJ917>4;8BY-%z1OTEC(*NF z$-*9}S|$cT%;u*v_v37HRg16f?X%016Yse(4}4w`K6y$sr_4={`vv>=(cL8H z*h5}JyeewhN>nV~X{*$RP$x?zH=zGO2jn?=%=e*gpt&pJdSX68zY6`x7aS^;bDA3Z z_Y$m7y|>NJE}{$46+Ln71P5Ne^*K;$Lk+D_1BPBHC`l$T}QUWaDaA4uM_tVvzEXrY}|UZvC_Pm*~sXDD|M z!T8-q8{TOraoTgzPc_$+IqY5cufqR)O=OLDfm9KAM`WqSy%t1P!M%cG&i7OZYmqdc;nYhW% zc2H{70y6pzutUq`AEql~k`RVU@4(Ng1I}))1gUTVCgLn)tL9?rD=-=?j#4g)1g1Yn zkD+LwOd~tY!DBTc<1{ATvzVd`mATkraG}t5UhU*}PrObrYhfCOHMU!9R>*(M(>d#@ z6!{p{pB=q1)-@+-ge$vUv(R}*6!+fDPHo4m>!1oy#5F<|>0rwC(`D8Ck{9mCFK(9C zct^kt$)O*aLnCDCa^fe~5h%!;dwJHj`oiiraAR6YXoe#-waO78oPIj#Mu*i@-Wc@v zpH$;|YB0Y2`=#wF*<7U;M+cv*ql3&{L}xgDoT}l+53GQ!4R<*e(wIq78_&F>ll_1N z{mI+uy(Cs3#H=lddj8BG<2Qrqhd78R{{e z@a1u691`Sx3GnZUrLM?`mx~?F+ZP=1Z zyJVzzi=~q4*D)WpHjFt_cL0x330$@*!n)0dW!g!*4@wc`=3SN>{2sh$ zNmaFlXo(Szc~{GOXs%-19u*{gMFQ)lnC_>bvOfjqV?JQ1j|yFMOF>{emv-(RZ(w1o zR7^OCDnLe?*XGSQ|14l^R@a93ibO!^Sji=p_T@~RbI)aK2u3V9<>BBb*=W6q6~n)- z$KKT=xd#A7v)R4M`c(88W0?B8m5rE#`ixvX zJ}POqF8N;Z9Iac#s6>GVfqm2|jc;jse0UzCH?sNJ(DCDcqkW791i@SdjH{=#wA)YP z5SP|Qp$=1Ute56#Zu)8+Df}H;4e!_Sp2enp*SwWlJ+WF7R?uORp%06@QaQflZw%EI`zl`Q3DlSk?c z1zsZr&Lc<{+Us<_)ic^4V6?hd_aF~z-?dEoZ9ktBI$I>IVVl1q*!n1UZK1J# nVWLY|aO=aj9xPwTD|4BOQz!SKVC=>DPlhG@2!6eKY8x4K!%c zgbgvGXxf@RO&dfWrXa}LCV{3#(llt$&>04sNv6>;F%MG-ng}w8lSz@LL9|0g2pJkQ z(@hyM05ml8nWXgwKxvT1rkZ&`H1t4Z0MGycVFN=T20#XyGzNn}115kCJxZtm&;g(t z000^^(?_Ui0000000Te`4FCWD000000009(00000fB@4*fHY_T003kF01W^Q0002c z13&-(0000000000000002&9u!RM|(9Ddb0#(=uv$5PD328Z-bj9-~0@8f0K-hBTg_ zdQAWar~t{J0BN8era%K~G|8Z7XaK}yXaLbsQDB5O9Sk5HIPRSS1czr6xH@zW;&)-t zoJa?915hX`heo56h*)Z5LZ^@~Ns>)4_##9?t%L}WgJgkIR07gLSgI4>LP(3Xz$g{; zB!b_{=}91qDiRxrP#uq-b3^`#_C-*mgC1nPSWcq0Fp3543>H>GEf~1(q$+?-n8Hz- zMP0v>H$fZN;Bg*+=zAh1w`0DrX~8c1m25pS9LDKMxQm@iNY;~=n}LJL(3&B4Ik z;rOZs!W^_3_$ib_Y{r00U|czzEW~PK)x={kJ}b-Lv26fE;yvlpUu? zXjL|D*>Rx@Ob1U2>?PrO43#GyfcSz2w;Yz8gpRrc6gs04+>$2q(u-9AWj{(v-U%?c zK0mTRytowYI(^>gvAR1_td6he-lB{OTrWazWitCY%D2 zky+^g1<|=Sw&WRg<~<&?Y{Jm=nN&0y zD<%+GI0z9CF#%dlTIAV4OXs^+>`z9bg~*_l4$#NIJBsM=C^$30r9ORE<%iP%5OMpI z8IWNN41t&#FfaokNdiE?lLG=kgfqHilSWm4+FIUwn-i~s>))AhI&bFC|yyYq%va!}43sJpa8N!5fH# zKsyK;hN@tcw_%g#k0cuY1q2Wa{6#!&{^zu+TM@AjMbfDfZpqBaTyd1U-@fJ?tt2YKnF<&j9EPCba}<` zT$#TC3vpcO4B=x#u^=VWya>g#q;iB`syP@o1yzd0)(n zVMG8yI-DT@1VtJ3e>WPI`C^$=3K~isaq0yX;8gJVRXJH6n3#nf`xyver|#PUZ~bIJGW%Q`v!Wf@!NLXWyg`VO(mG>Fh3D%0eNkPKmv;EY!0pY zXgLVI6!bh_mBom>NkD*L)2!ZjrKO6N+7wklwP|@y6T%o=o!F=m1|O*Fujpy<8^8jM zDfU>eqYXdWy%iM;b5tc8T-(!K>O2h|9I1_pk`Mq#Y$E&U^3t2!9Qp^&@c*$ z3bS@zJxjC`9s@2Uoz5%+C$kl3ARO=jWXKzDAOO+p=o%m5N}9=+zRR JNMXnX`~Wh{l35KSPG|_+r!Zg7%QvlS+#M5aQ001VKLrS6nqb7!iOpKU-$iiY^fskpC z(?&x;Vriy^2w)J?O+7)QMk5K6BTS7kGGx_>!tnf-$S1Xc`qc_okw#)a`Lc4b@bLe^0m-tE1SOXetewUNt zC+V%F+v>Hsxz!Nx@Fw#Q+YYh;w}8QhCW)WXf+aEy ziAW>ia|%RmK+8G|wIUy@KBQ^^8jFM@zErcA&Z=Xi7BzBzD7k^cY~}LhBoe>iz`^q z-*Xqu(~+-$ykon;GIkCS>Bd+MHA}JGPiKbGMJgII*4cEd7QH2L%3)c_$@D9oFBD_; zQ|B8dB5z+ZnAl7@@0r`PfUA##pe&vdi9xD@0Dv$IhyyYJh!7zPL?IBd1Q7&81OTL{ z_x=|Ut=_7~aL(;Ip7QDkvEpEX()lR}M4z|2dYnYvwqhd5#fIZuvq%6MW)BCXA8K>g z=xgenl=#Y$h#U|OI-=X+(_C2J`wfl~qo&_zR{-?%EIf~3y4O#^(cZl^c3$~47rYFj z4q%GR7o9uVe<%oJhy>w(8-~c3>M0OENy)_!E=CzW0DwOumpWHJ^=Nq@zg<%AXV+P- zyxS`Z9@3_)R&2lz$x}~;$be7jf6zdh-VGy}FDWRKYl(sf8<#>`n#hh866iyjG=<{V zz1~G4Bf$tvOQL#dMp+OCS4#?WAj{$rXHtQ=NyFz zRJ4LOnpJi$b1bLXL4X0pQNKF{&VRrFQSdRM&9qiPLJW!hL8{QG!&Qb(pJ)LFpN~(i vvxzH}N`3qS1&@{K$U++~uC1$`q;PS5T3QwrWBzEg&r5Y7Hq8*#7n641&ruHr6#o2V9b^#v4>K~SzpK}@p+ut z-GJ2|Jc-yD*!^bbXE*af_6Gn&FB`T2>Hy$iBNU{p5HhcHZP;K!q34*w2$EoyOoC{| zM1Rpl-(G=x2w@BveENPBpyw@^L}8M)TJK_`RNmaGI2EVn+SbYSvR(JWO=1XB1dZW&b62uH0dDp$~cc*xp=$?y*k>Z4hP{H!&&(?3{(OE08-C-l4xSSLe)R!&+IG}x`p`FGr bNyj+XVs4OTA-hgT Date: Tue, 17 Sep 2024 14:54:09 -0400 Subject: [PATCH 19/46] fix rendering to katex, add mathcal Rt to vignette (#169) --- _pkgdown.yml | 1 + vignettes/wwinference.Rmd | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index 13aa9bb2..347325a6 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,3 +1,4 @@ url: https://cdcgov.github.io/ww-inference-model/ template: bootstrap: 5 + math-rendering: katex diff --git a/vignettes/wwinference.Rmd b/vignettes/wwinference.Rmd index 0ce43cc1..e3f6e21d 100644 --- a/vignettes/wwinference.Rmd +++ b/vignettes/wwinference.Rmd @@ -374,8 +374,8 @@ nowcasted/forecast quantities look reasonable. We will generate a dataframe that we'll call `draws_df`, that contains the posterior draws of the estimated, nowcasted, and forecasted expected observed hospital admissions and wastewater concentrations, as well as the -latent variables of interest including the site-level R(t) estimates and the -state-level R(t) estimate. +latent variables of interest including the site-level $\mathcal{R}(t)$ estimates and the +state-level $\mathcal{R}(t)$ estimate. We can generate this directly on the output of `wwinference()` using: ```{r extracting-draws} From 65c358830b551c01cabe30c9a1a66a122128ea04 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Tue, 17 Sep 2024 17:38:55 -0400 Subject: [PATCH 20/46] Tweaks to main vignette (#170) --- R/figures.R | 17 +++++---- _pkgdown.yml | 2 +- vignettes/wwinference.Rmd | 72 ++++++++++++++++++++++++++++++--------- 3 files changed, 67 insertions(+), 24 deletions(-) diff --git a/R/figures.R b/R/figures.R index d9177b8c..9a63adb5 100644 --- a/R/figures.R +++ b/R/figures.R @@ -123,11 +123,11 @@ get_plot_ww_conc <- function(draws, color = .data$subpop, group = .data$draw ), - alpha = 0.1, linewidth = 0.2, + alpha = 0.1, size = 0.2, show.legend = FALSE ) + geom_point(aes(x = .data$date, y = .data$observed_value), - color = "black", show.legend = FALSE + color = "black", show.legend = FALSE, size = 0.5 ) + facet_wrap(~site_lab_name, scales = "free") + geom_vline( @@ -136,7 +136,7 @@ get_plot_ww_conc <- function(draws, ) + xlab("") + ylab("Log genome copies/mL") + - ggtitle("Lab-site level wastewater concentration") + + ggtitle("Lab-site level wastewater concentrations") + scale_x_date( date_breaks = "2 weeks", labels = scales::date_format("%Y-%m-%d") @@ -144,11 +144,13 @@ get_plot_ww_conc <- function(draws, theme_bw() + theme( axis.text.x = element_text( - size = 8, vjust = 1, + size = 5, vjust = 1, hjust = 1, angle = 45 ), axis.title.x = element_text(size = 12), + axis.text.y = element_text(size = 5), axis.title.y = element_text(size = 12), + strip.text = element_text(size = 6), plot.title = element_text( size = 10, vjust = 0.5, hjust = 0.5 @@ -202,10 +204,11 @@ get_plot_global_rt <- function(draws, theme_bw() + theme( axis.text.x = element_text( - size = 8, vjust = 1, + size = 5, vjust = 1, hjust = 1, angle = 45 ), axis.title.x = element_text(size = 12), + axis.text.y = element_text(size = 5), axis.title.y = element_text(size = 12), plot.title = element_text( size = 10, @@ -265,11 +268,13 @@ get_plot_subpop_rt <- function(draws, theme_bw() + theme( axis.text.x = element_text( - size = 8, vjust = 1, + size = 5, vjust = 1, hjust = 1, angle = 45 ), + axis.text.y = element_text(size = 5), axis.title.x = element_text(size = 12), axis.title.y = element_text(size = 12), + strip.text = element_text(size = 6), plot.title = element_text( size = 10, vjust = 0.5, hjust = 0.5 diff --git a/_pkgdown.yml b/_pkgdown.yml index 347325a6..cbc2ae70 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,4 +1,4 @@ url: https://cdcgov.github.io/ww-inference-model/ template: bootstrap: 5 - math-rendering: katex + math-rendering: mathjax diff --git a/vignettes/wwinference.Rmd b/vignettes/wwinference.Rmd index e3f6e21d..e19c7c3f 100644 --- a/vignettes/wwinference.Rmd +++ b/vignettes/wwinference.Rmd @@ -31,7 +31,7 @@ subset of that population, e.g. a municipality within that state. This is intended to be used as a reference for those interested in fitting the `wwinference` model to their own data. -# Package +# Packages In this quick start, we also use `dplyr` `tidybayes` and `ggplot2` packages. These are installed as dependencies when `wwinference` is installed. @@ -61,6 +61,7 @@ as of December 6, 2023. These data are provided as part of the package data. These data are already in a format that can be used for `wwinference`. For the hospital admissions data, it contains: + - a date (column `date`): the date of the observation, in this case, the date the hospital admissions occurred - a count (column `daily_hosp_admits`): the number of hospital admissions @@ -186,21 +187,41 @@ ggplot(ww_data_preprocessed) + x = date, y = log_genome_copies_per_ml, color = as.factor(lab_site_name) ), - show.legend = FALSE + show.legend = FALSE, + size = 0.5 ) + geom_point( data = ww_data_preprocessed |> filter( log_genome_copies_per_ml <= log_lod ), aes(x = date, y = log_genome_copies_per_ml, color = "red"), - show.legend = FALSE + show.legend = FALSE, size = 0.5 + ) + + scale_x_date( + date_breaks = "2 weeks", + labels = scales::date_format("%Y-%m-%d") ) + geom_hline(aes(yintercept = log_lod), linetype = "dashed") + facet_wrap(~lab_site_name, scales = "free") + xlab("") + ylab("Genome copies/mL") + ggtitle("Lab-site level wastewater concentration") + - theme_bw() + theme_bw() + + theme( + axis.text.x = element_text( + size = 5, vjust = 1, + hjust = 1, angle = 45 + ), + axis.title.x = element_text(size = 12), + axis.text.y = element_text(size = 5), + strip.text = element_text(size = 5), + axis.title.y = element_text(size = 12), + plot.title = element_text( + size = 10, + vjust = 0.5, hjust = 0.5 + ) + ) + ggplot(hosp_data_preprocessed) + # Plot the hospital admissions data that we will evaluate against in white @@ -213,10 +234,26 @@ ggplot(hosp_data_preprocessed) + ) + # Plot the data we will calibrate to geom_point(aes(x = date, y = count)) + + scale_x_date( + date_breaks = "2 weeks", + labels = scales::date_format("%Y-%m-%d") + ) + xlab("") + ylab("Daily hospital admissions") + ggtitle("State level hospital admissions") + - theme_bw() + theme_bw() + + theme( + axis.text.x = element_text( + size = 8, vjust = 1, + hjust = 1, angle = 45 + ), + axis.title.x = element_text(size = 12), + axis.title.y = element_text(size = 12), + plot.title = element_text( + size = 10, + vjust = 0.5, hjust = 0.5 + ) + ) ``` The closed circles indicate the data the model will be calibrated to, while @@ -240,12 +277,13 @@ ww_data_to_fit <- wwinference::indicate_ww_exclusions( # Model specification: -We will need to set some metadata to facilitate model specification. This includes: -- forecast date (the date we are making a forecast) -- number of days to calibrate the model for -- number of days to forecast beyond the forecast date -- specification of the generation interval, in this case for COVID-19 -- specification of the delay from infection to the count data, in this case +We will need to set some metadata to facilitate model specification. +*This includes: ++ forecast date (the date we are making a forecast) ++ number of days to calibrate the model for ++ number of days to forecast beyond the forecast date ++ specification of the generation interval, in this case for COVID-19 ++ specification of the delay from infection to the count data, in this case from infection to COVID-19 hospital admission ## Calibration time and forecast time @@ -294,7 +332,7 @@ along with the other specified parameters above. # Precompiling the model As `wwinference` uses `cmdstan` to fit its models, it is necessary to first -compile the model. This can be done using the compile_model() function. +compile the model. This can be done using the `compile_model()` function. ```{r compile-model} model <- wwinference::compile_model() @@ -377,14 +415,14 @@ observed hospital admissions and wastewater concentrations, as well as the latent variables of interest including the site-level $\mathcal{R}(t)$ estimates and the state-level $\mathcal{R}(t)$ estimate. -We can generate this directly on the output of `wwinference()` using: +We can generate this directly on the output of [`wwinference::wwinference()`] using: ```{r extracting-draws} draws_df <- get_draws(ww_fit) print(draws_df) ``` -Note that by default the `get_draws()` function will return a list of class `wwinference_fit_draws` all of the posterior draws for predicted hospitalizations, wastewater concentration, global, and site Rt estimates. To examine a particular variable (e.g. `"predicted counts"` for posterior +Note that by default the `get_draws()` function will return a list of class `wwinference_fit_draws` all of the posterior draws for predicted hospitalizations, wastewater concentration, global, and site $\mathcal{R}(t)$ estimates. To examine a particular variable (e.g. `"predicted counts"` for posterior predicted hospital admissions), access the corresponding tibble using the `$` operator. @@ -433,9 +471,9 @@ plot_subpop_rt The previous three are equivalent to calling the `plot` method of `wwinference_fit_draws` using the `what` argument: -```r +```{r, out.width='100%'} plot( - draws = draws_df, + x = draws_df, what = "predicted_counts", count_data_eval = hosp_data_eval, count_data_eval_col_name = "daily_hosp_admits_for_eval", @@ -523,7 +561,7 @@ fit_hosp_only <- wwinference::wwinference( include_ww = FALSE, params = params ), - fit_opts = get_mcmc_options(), + fit_opts = get_mcmc_options(seed = 123), compiled_model = model ) ``` From 9b0937bc215b1dbc4957e06d1f605cfaa88efd4e Mon Sep 17 00:00:00 2001 From: "George G. Vega Yon" Date: Mon, 23 Sep 2024 23:08:13 +0100 Subject: [PATCH 21/46] Adding the post-page-artifact job (#181) --- .github/workflows/pkgdown.yaml | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index d4b23ce5..e148bcb5 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -23,6 +23,8 @@ jobs: contents: write id-token: write pages: write + outputs: + page_artifact_id: ${{ steps.upload-artifact.outputs.artifact_id }} steps: - uses: actions/checkout@v4 @@ -52,6 +54,7 @@ jobs: shell: Rscript {0} - name: Upload artifact for GH pages deployment + id: upload-artifact uses: actions/upload-pages-artifact@v3 with: path: "docs/" @@ -72,3 +75,21 @@ jobs: steps: - name: Deploy to GitHub pages uses: actions/deploy-pages@v4 + + post-page-artifact: + needs: build + runs-on: ubuntu-latest + permissions: + contents: read + pull-requests: write + env: + GH_TOKEN: ${{ github.token }} + steps: + - name: Checkout + uses: actions/checkout@v4 + + - name: Post comment preview + if: ${{ github.event_name == 'pull_request' }} + run: | + gh pr comment ${{ github.event.number }} --body \ + "Thank you for your contribution @${{ github.triggering_actor }}:rocket:! Your page is ready to preview :point_right: [here](https://github.com/${{github.repository}}/actions/runs/${{ github.run_id }}/artifacts/${{ needs.build.outputs.page_artifact_id }}) :point_left:!" From 0137a96da680763d8d95c30f09a5b3934e10a3ea Mon Sep 17 00:00:00 2001 From: "Dylan H. Morris" Date: Mon, 23 Sep 2024 23:11:28 -0400 Subject: [PATCH 22/46] Build link comment in PRs: update comment instead of re-creating on rebuilds (#182) --- .github/workflows/pkgdown.yaml | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index e148bcb5..6426ae96 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -87,9 +87,19 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 + - name: Find Comment + uses: peter-evans/find-comment@v3 + id: fc + with: + issue-number: ${{ github.event.pull_request.number }} + comment-author: 'github-actions[bot]' + body-includes: Your page is ready to preview - - name: Post comment preview - if: ${{ github.event_name == 'pull_request' }} - run: | - gh pr comment ${{ github.event.number }} --body \ - "Thank you for your contribution @${{ github.triggering_actor }}:rocket:! Your page is ready to preview :point_right: [here](https://github.com/${{github.repository}}/actions/runs/${{ github.run_id }}/artifacts/${{ needs.build.outputs.page_artifact_id }}) :point_left:!" + - name: Create or update comment + uses: peter-evans/create-or-update-comment@v4 + with: + comment-id: ${{ steps.fc.outputs.comment-id }} + issue-number: ${{ github.event.pull_request.number }} + body: | + Thank you for your contribution, @${{ github.triggering_actor }} :rocket:! Your page is ready to preview [here](https://github.com/${{github.repository}}/actions/runs/${{ github.run_id }}/artifacts/${{ needs.build.outputs.page_artifact_id }}) + edit-mode: replace From 745dfe06240497bc78b7d6f91bfe62d4716a3f5b Mon Sep 17 00:00:00 2001 From: "Dylan H. Morris" Date: Mon, 23 Sep 2024 23:55:43 -0400 Subject: [PATCH 23/46] Only run post-page-artifact job on PRs (#183) --- .github/workflows/pkgdown.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 6426ae96..80f23082 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -77,6 +77,8 @@ jobs: uses: actions/deploy-pages@v4 post-page-artifact: + # only comment on PRs + if: ${{ github.event_name == 'pull_request' }} needs: build runs-on: ubuntu-latest permissions: From bd3bb65ba7417e4238c198020d4605b890fa6bc5 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Thu, 26 Sep 2024 11:43:30 -0400 Subject: [PATCH 24/46] Fix formatting so functions link (#179) --- vignettes/wwinference.Rmd | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/vignettes/wwinference.Rmd b/vignettes/wwinference.Rmd index e19c7c3f..e7000813 100644 --- a/vignettes/wwinference.Rmd +++ b/vignettes/wwinference.Rmd @@ -59,8 +59,8 @@ from September 1, 2023 to December 1, 2023, with varying sampling frequencies. We will be using this data to produce a forecast of COVID-19 hospital admissions as of December 6, 2023. These data are provided as part of the package data. -These data are already in a format that can be used for `wwinference`. For the -hospital admissions data, it contains: +These data are already in a format that can be used for the `wwinference` package. +For the hospital admissions data, it contains: - a date (column `date`): the date of the observation, in this case, the date the hospital admissions occurred @@ -129,7 +129,7 @@ params <- get_params( ## Wastewater data pre-processing -The `preprocess_ww_data` function adds the following variables to the original +The `preprocess_ww_data()` function adds the following variables to the original dataset. First, it assigns a unique identifier the unique combinations of labs and sites, since this is the unit we will use for estimating the observation error in the reported measurements. @@ -148,7 +148,7 @@ and `lab`, and will return a dataframe with the column names needed to pass to the downstream model fitting functions. ```{r preprocess-ww-data} -ww_data_preprocessed <- wwinference::preprocess_ww_data( +ww_data_preprocessed <- preprocess_ww_data( ww_data, conc_col_name = "log_genome_copies_per_ml", lod_col_name = "log_lod" @@ -162,7 +162,7 @@ below the LOD in upstream pre-processing. ## Hospital admissions data pre-processing -The `preprocess_hosp_data` function standardizes the column names of the +The `preprocess_count_data()` function standardizes the column names of the resulting datafame. The user must specify the name of the column containing the daily hospital admissions counts and the population size that the hospital admissions are coming from (from in this case, a hypothetical US state). The @@ -171,7 +171,7 @@ return a dataframe with the column names needed to pass to the downstream model fitting functions. ```{r preprocess-hosp-data} -hosp_data_preprocessed <- wwinference::preprocess_count_data( +hosp_data_preprocessed <- preprocess_count_data( hosp_data, count_col_name = "daily_hosp_admits", pop_size_col_name = "state_pop" @@ -268,7 +268,7 @@ we will use the `indicate_ww_exclusions()` function, which will add the flagged outliers to the exclude column where indicated. ```{r indicate-ww-exclusions} -ww_data_to_fit <- wwinference::indicate_ww_exclusions( +ww_data_to_fit <- indicate_ww_exclusions( ww_data_preprocessed, outlier_col_name = "flag_as_ww_outlier", remove_outliers = TRUE @@ -278,12 +278,12 @@ ww_data_to_fit <- wwinference::indicate_ww_exclusions( # Model specification: We will need to set some metadata to facilitate model specification. -*This includes: -+ forecast date (the date we are making a forecast) -+ number of days to calibrate the model for -+ number of days to forecast beyond the forecast date -+ specification of the generation interval, in this case for COVID-19 -+ specification of the delay from infection to the count data, in this case +This includes: +- forecast date (the date we are making a forecast) +- number of days to calibrate the model for +- number of days to forecast beyond the forecast date +- specification of the generation interval, in this case for COVID-19 +- specification of the delay from infection to the count data, in this case from infection to COVID-19 hospital admission ## Calibration time and forecast time @@ -326,7 +326,7 @@ inf_to_hosp <- wwinference::default_covid_inf_to_hosp infection_feedback_pmf <- generation_interval ``` -We will pass these to the `model_spec()` function of the `wwinference()` model, +We will pass these to the `get_model_spec()` function of the `wwinference()` model, along with the other specified parameters above. # Precompiling the model @@ -362,7 +362,7 @@ pre-compiled model(`model`) to `wwinference()` where they are combined and used to fit the model. ```{r fitting-model, warning=FALSE, message=FALSE} -ww_fit <- wwinference::wwinference( +ww_fit <- wwinference( ww_data = ww_data_to_fit, count_data = hosp_data_preprocessed, forecast_date = forecast_date, @@ -415,7 +415,7 @@ observed hospital admissions and wastewater concentrations, as well as the latent variables of interest including the site-level $\mathcal{R}(t)$ estimates and the state-level $\mathcal{R}(t)$ estimate. -We can generate this directly on the output of [`wwinference::wwinference()`] using: +We can generate this directly on the output of `wwinference()` using: ```{r extracting-draws} draws_df <- get_draws(ww_fit) @@ -490,7 +490,7 @@ We strongly recommend running diagnostics as a post-processing step on the model outputs. This can be done by passing the output of -`wwinference()` into the `get_model_diagnostic_flags()`, `parameter_diagnostics()`, +`wwinference()` into the `get_model_diagnostic_flags()`, and `parameter_diagnostics()` functions. `get_model_diagnostic_flags()` will print out a table of any flags, if any of @@ -522,7 +522,7 @@ to identify which components of the model might be driving the convergence issues. For further information on troubleshooting the model diagnostics, -we recommend the (bayesplot tutorial)[https://mc-stan.org/bayesplot/articles/visual-mcmc-diagnostics.html]. +we recommend the [bayesplot tutorial](https://mc-stan.org/bayesplot/articles/visual-mcmc-diagnostics.html). ```{r diagnostics-explicit} convergence_flag_df <- get_model_diagnostic_flags( @@ -548,7 +548,7 @@ rely on the admissions only model if there are covergence or known data issues with the wastewater data. ```{r fit-hosp-only, warning=FALSE, message=FALSE} -fit_hosp_only <- wwinference::wwinference( +fit_hosp_only <- wwinference( ww_data = ww_data_to_fit, count_data = hosp_data_preprocessed, forecast_date = forecast_date, From b0287aba67f4c3e55b7305e2cdc882ffe6e85900 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Fri, 27 Sep 2024 13:57:50 -0400 Subject: [PATCH 25/46] 174 cmdstanr sample args (#175) --- R/sysdata.rda | Bin 38164 -> 38166 bytes R/wwinference.R | 111 ++++++++++++++++++------------ data-raw/test_data.R | 9 +-- man/get_mcmc_options.Rd | 34 ++++----- man/wwinference.Rd | 37 +++++----- tests/testthat/helper.R | 7 ++ tests/testthat/test_ww_model.R | 9 ++- tests/testthat/test_wwinference.R | 20 ++++-- vignettes/wwinference.Rmd | 7 +- 9 files changed, 144 insertions(+), 90 deletions(-) diff --git a/R/sysdata.rda b/R/sysdata.rda index beb919b8985998bbb58200e9b96fc75b512d9fa4..60e01c46ff0c8dfd177db08b7b26b789bde9186c 100644 GIT binary patch literal 38166 zcmb@q1yCJZw>7$v;0^(Ty9IZbAi;e@kl?}H-8Hxc-?&3?cX!v|?i$=54i1D2gqSx4f=_0&w=^J8nnKK*m31P+ zBrlOv8fG9bEKxd4-h_nJ05;=wt8}t)w+;odf4@nduvijUtPGS`G6b9pf;WH_5rPN+ z0M`NJhlF?oz_N5EiayAhrf?i9#sd)ntgJY%yRV=N08rkqlmB%<6&0nwoLL%_(BD~J_nQxR3a%#J3z3z6EF^l zdy>p$!vPhsPg2N<8$%J-5F|&+PecJajmMdoSdAII$C(WPU>P5naIj?n6B&BA@;C-> zQ-nal*T(~hiTPwe2n!}L71q3NU0`K429uMf$d8p4lgR+f<(*(O z2Eh7aCxeoeT$ptrL1Gl>q%v}>h4+NbZD~!07Wp5)Wf}gMoWiZv&|6dz6SJsIF>|b) zsInMgsmV5}bu?j14?8$%cCXx^J0GYJb0l;?8|BZH@i2x=iVpqyyYZ5h%COvHsuMT$ zQ?Glv3d6m=e8;J5_e;I{Pm>oq4(h`B3Zg=X#dlJ&1Lp_BmRj#}F?zp!s|p`9t<#z< zWi=xP5^&Zl?_i56?|FEs{lwCISh*2sH(QQw(o>^a&`4);;;s9pMR0GDjq`{*!cNI> zDhxpM>A;2dAD!}N-h~IPhu2!~qDqXxAUT0b*szEWaKWNRgzLR}JfTouAIil3lN}MTg$g%bN zP-AB5FwkXlfJvb%opISuVZg`2d=Zk4k-?zS?JPYwI=cF4wD&O-jn>?3ez?n?m*CqC zW*}5-!8{hFrcIOpmY8q%j){?sqi(i@?GFRAFU?v%vU17ABKgdun7gchtb)9QM8K@o zz8aAm$<5liK~5uTt2MEvYqa}@5;!zCAz{-nh?*Aac1$ZnM(cgn;N%pH8pGp!H;qPS z5X?-IO$7Vt2V6JympTJTv?-n1k48eqv_*BW`gVd*B2|Vz%qrPM%*Lp@I_Nr=;T^rJ zi@yTj6CsX#F9KHR1q+CVvwZ@`2=-f%XLUnra%$h@Z2H>LW(4hD48Ng%@Vt`s05++6 zcB`xiK$mPFr;&N4KP6(;BD|&$rC_nZ$m7e3@9A#5M(`Iz1xTiKbi?_0)$22yPz8{y z0Dv`+C}N@*iOpYo`IOb=9TWqgdW14JL*5OD_4H5z9N%M0C2FWsjIc3E%FKU&a`{?zP`e{sZ<_TuSYQRKI13S2nJMhK(cRPa9q*G@`w*c zkKn*U7L|IiA`JL)yF#w=JF#dXn`l(Vy0}kG7~sS3^S)p<0JLl@+9k!NV9bp#6~OP` zyOoqx6@7gkGcuB4Y*7)c!KwTK5G?O7x<%h9+~{}{J^H@~GxJOPRd|zm+3s9PLSYq= z{bI(yV)dXWhr3-7d)^#I2pXi_ z<$I|YM-t8+ei8W3Of}mMHEa&&tLDDH@d!K^+Rs~+s0;Wk6LPSrbCjaL^UCR%uXf4=TP=Fy6eOo+ z^-hO^2OlKY4<|W&xwXdYIvdjZSaTY9HR6De9p?>#siesx9)z{Jl8_Tek6de54 z0STa?Oy!@biFIjE0E+6hn830$RDsyu>?v(M-Y9T6zp$5?mg zgyc-Dk(FEg^Q&2=f+n1_MNwai3(sc+oBVTRWF-K^C5Lp5OI=+asSiQ{V|*9wxL;DD z7uNtd1P;YbW;Y3L6qGJqEs@bz9*&LhWha2&|M&!UtsvAD+0 zN~MC40BYgV1_e?WA@i0IWicfvQ=-gnLeE~l!qm11o&T!t)|ZaHFq1Y#dwJspe8|;7=Y$EX5?|vvt*x;P)SY+kw z;gg2}^QPZ8=fT9Lycg|f%(xwfi6v4ZqUlXsewutmZ8gIQ1_ywi=cn3<1ih8Q9#*N; zWIif0vL6h7KYV%@aO!vLWX?6c$#pC|JdSg%yXzLo5WW+Bvp1}-2EhdPNm7uQFZeu= z42E0h<%3TYo<)OAm${%trrw3g)$I#L(4qQ#W%GqHaZCaR67kJK$q#TXRJm;orFSSo z(hTT}JCy={c3)+7KJLhox<9!`$Y1km^ca%TYxHNcN3R(}ox=kjM3o%+FK+FU&N&NO`A_I;@FpT3w4kXI#jz$1!?j4`>T!?x zY-2Q;t$D9Whl$2BV0^lhqsC@)x_6iWettsjWa!tNo8yVW!G1_Fp%6aAcLoTjtgd`#W?&q3>iDgdXBBCkw)8o*%rl=w{?FMX#D-6oGQ`6hG}Sd zP3VnNlS2_H%J7aTvVHvX#Tlrt@YwARIfp;l9R1sJLsJK0`(Xv97ZAc$OVOKepWi<@ zqlkh=+{FkLg?O70Knf`!3EiZZw}2UxGt;`t3tO?-h;E70=iAVc+(JBy`)G|Htm}}; zj*?3PiSo`_d`;Le$IkplW1S`yMNx15(FaTc^_SC-c=?K5pS4+k5bk6O+I-4_Q=KB5 zZWbmUrf>Yk$rh$Ycbax+8yCsYHx2Zai3*oM?GVWsE8C_0G?-|gM?u@z>_==fG;POw zU!sKyApm~?NdmcQl2_9-{!9=DD0er1!~9-=dmwSm*gdxqYT|o-65+y*xbcVHufTIHYeTMX35{pl!N_v@L~{&U1oaDyKRSD9`o+wbsXg;=n=68ss9xZ~<=TLdLJDoc?w8c<}2q*1y1?@HoV9 zN#A=v?`iyezz%|-o5(eZB#FEW0(1I4G;7h#@kkx^)C5A$SAUi^Ow%mG(h^|$W`&4# zneD=w!>i&{`Esc+=-IH^%@|WxoQ1(Urq*RPquL_;8JT~E-#S`Hl}pAmuxhb0q-~>a zvJ4KlRxD-iotHdb-^9#2`O7_x2rWyI3Ax|^uWwLM&*Qc^yGR6nPJ9q*mmbfw&ni|9 z)HZvYSH+HX;$|0);aU3G%lC0?wg!`5M-F|#7)90KNtA@SCFH*gjpx*%cgRR-6cUQr z%QvQv|=4J9L`n&6g0pS)R2@KjjyWn|t+L zZZO!_7bh$FPiu7^8Fk6nk~TQ69v3o$Qxj1M+xR>i#R<8l?cOLiQSb*A`b}FFyWJAr zU9ukN;5*rxqvc#?=}OEz--~mLJD#uRRSSQ_LYLGJV}r=ku|9i@IY10)*>G+zWZkpk z+Z0(rdTH8f9$FrJKxIQtKH9fJ%kt_zd(;bANZZHZ{yJ4KhrV4QD8FDFmq@1-{wTXn zTybbWub&&FN(kCy6Di<`EDHS0Cj+%uK8@{iYm|braz4Gld^y?vaJFRhN%TImT-a-Y zdTmZ<3R1W8yHOb)dnZa?gP;V5Huw1X zA7sMF7qhvT6;lB&MZe-Dj;+dk_CRA%(6W5f@P-?5T&x8j6x=0Fzk{-c`V1rkh?%% zN-LY6B1A8pq2k7dsz9DVX!e{>ofc4L4~}4lze9G#5N1G{B^Jly6~M-pB<}8*ZJ@KK zky3CJ-(BD6lR(UZ5pNsHn7&JQYv=S(0t@QAyD=PrzU$6mXTUIS2~!#1;LYokmk-p! zhS=Kr?z59+Tk&z*ajj4SYv5%8Iu~m>O++^P27{EbL6T<+ncJfTod-J1AlNDgDGO?! zzdp^;*ROgD=|Ex>1VJ4P4e`m3Em0o3ahcQ`+cdpB@<9V8^_i=WF36~HvqDo=$^Lz6oO(%c%J`RGe-kkG&}SAoS3`)R_YdFY3hI*p5$v}q&m!BKJvikgr&Q1T ze|%HxPcFk1;ergbqHm}K)makf*Gl=9$$q!c zCh(dzMB*+Q-REck%py{B=cSn&09O`Q-A(^IqF2wO8pto%MU5zouX4JyQ!-ud6y2rd zndbQ=`v+y|?$r1&o@;nNjA%nD0tY{OWiQUkNx8uZO6YWzk4BMogaBE)LqjGWL^;zL zsMKaXb;cz-k`p3tjGII8z36uFA;u6c^6FZlmmg+ur!UoJ5Ls73w;1x5woYKtP+v#@ zUW8}hWfy4082fl3eBk%^2uKDw4*s4mjIo=rg)njkbgon^J4)c9N~sWdqocs^Vu36b zNyQ(+6gB&D5+q;I9*%7Ngzr@ zj5QnL$0~Ukc4dY>cB6oWf;o&;XdJ4m(BkzDT`|K2q<@%%A5v7K-YPdzwFmmul_?Pb zf@V0jiTbCAo)TAe1hk$pOi?8@A*`ai=B@7!zAhp89ID z$3H-?&#j04xPG*PYTVpk-mnwPUu1R3p0wAUeU%&&Z&Mr0;^(?vsSCk(v3nsdOu~w* zo}SQ8ug9Pg+X-Xa?re(^&oj2B7zSk)s$T#w({oD657#3BQznnglRYzsB+qP9TPO;; z$f$>qsUZ}AnpC=&(o?1X)b*uV17>wRjQp7aPmoBQJSq{y%Ww>i?a`d zb4UHldMaaZa_#x-SB3gvy9KcoJTXQ*c-V-{9%;GLdUGsTvug-7(?@5%fix0sEyR;> zhTq_)5r}j?+I@&K><&<|;@Yw6Q{NW9a?L@$gAGE45(Gz5K7io*EvbUS=&MhESlao! zGoy0d9D#Z-y_V)3sp~ro%F!b8??w~xtqhh9swC;c)0hd7G2$>8H)`FN!#bE(^~Bx_ z@^;StNm!VoT~`x%nMZr-)&!VlwSW&O88E1buJ2cpJca=skpNR&N!rYe`9z|wvYCSn z12f1&(odPW97C;_L({kbp8I%O!yPO{U0IvbRi+qLLVX{vSn~8nE1xH(m*y*ioNk>Z zmLY?m5U#6&vhxtGsG~%#tpwsr1mLH*POG)|auWOh>&NT=_bWgk(f?fZ9w`1lFa77d zsp-$h{{LL~Kh6l+oSbz2k9Yt7y#WNi#k^1kS`uqednj2Cb%&1dE(wlvb-g3l&k=qWybHh0Ka(k!LYh88}f;bLcgNCx?-@_?c80h{j}oJi;;HN zd?bUf}?Nr(D5D|h&Sp}+JYZY&9*Y&c@e@cU+;O0}0JI60B3 zc*UN+bFi%<3K`h5ZaXx=)Mh^hK_}@E|NM~-0Sz(H>3Yb`j3?oJIMN-0pS*|VD)%S+ zXoME67VC!J&%krT8OaW`w;By3n zIKo^}q{#zOIAp~$`g0|@Wa&CrJTmZ91XsY9moN}G^2@* zauB+bj_={pYw8L0bR~>iIoWcQFpK;f_ry4JVNE+ znGXlD<7hC@det-87TtVUWXNyPqEahVGJP!dHvppb;k5OEy40>8uIS$b?>E3qeYU35 zOnr{m`(HP_Ia&_?x;|U;(`DtRC4pcDNK>?OGsd%W(*Oh_xqt!xGZ6odu^aUsC_h_` zbo=^SrH%AjgzoSpW9UUO;)pZ0bIR2^Ac2hJ~k>M~!~ zd5Wyyw)OZFafP9hVpHf9}j2A%jk20FCH(B0B7fA5mod2x^wLZ|2UDE3S zy%PT_sXw}!ZP;~Nxz=<80u#ZDL8f^|0B8a?n_ZCWZ1ZdAi@|?F=K~Pf{@w!;1OkQm zo}MmPSeh2o-kyi1s01t?s9O6br?C+Csm<1f&4Z<9%JhXNyU2};-wfKQyW53BoS&NWKDU8JzCo%+&VICIT8v8@ z{E?T77t0Wb1pV!dxmyR%0v=R=k5|rS{xJ4HRA!QHCTJ~DcTquM!QX)aO7hyC7%4eK@f(eXMnSyZIDZjPGe-1Z1Xe}z)$hJB$P3nT z`cHzF+Kt|{9MxYJ6*In5<(-ip1t9TWZ;tU^mA-~{*^U1vwk!bq-)0f$_VBP{XyjD) zY6&enK;Rb$avJ4A#azi4`OHrNa2Vu^Q*`~9433V8Jc}@~d}cF}Ics9orZ2q8%Ld0` z?gt(FoTLOM;Z|(aWk>J1Xbj>hdgjUmmt%bAm^15Gkr^ohNB{=GKIoDMpchk3b9G76 zhcuqWD1=HFq=xwYBDQ%0G*oh8@7@Khbmf}{u1Ki3Z&wnwBZNVSUeIW zg0_wmP#VNV;za+o5c9wD;HEy*Cox5`%tQ8cGsm{>@^`quSA~B`fxQlidH9OQuYR=) zdKqo)hz#PPXm4!7E8@EFJ9$O&sS75 z3E@LMwSg{hRqr(DUFE%Q?(AEn=1bcSLP0WAokszs^mF_-pnLM`iyr3I197&w@A9 zmBlAfKo*hNUdxWfOKf9%GZ!lGS9!#%bg`&kIk;QO)P7fSrq)#7srGraVl8g2LaezX z`&`IHJwELAnyDovCB9+zR(Dpu@e3XIfm;4{n|APj?523k@+}Qmc)7L!e*^sUUo|b& z<+zXQm7b(E#8cP*A^_yna{8^W2B_vu)38%yXbrI0ts`*R{o5x030-6j==wXg8n)g6 zm04C-S6NtiS{mL2!CX|-{s9Pdvw9_<`BrZ9!A%Rl;tPXj;|X#(8#R6gFYPYG1C%!l zzprgUHLmM>fMrOVx*m0aMPM716GTa16~>;HCJ{m z`xc^$2(*^g{-k|>o$LT--Cvsi$A%6uwYdMvlm8+A{~ZJWaw&md5iUh}EEZsnZN0V* z$oU3el9Nj_w+6EOV1l6Zp?lawMXA2mEl!9JkpG4J$oZW6&8o-Fx0ChX$dm9T{k53}J#jfDs;`C}jO(v$@MZHZM!}7ySGo-(I_lH=FlD|GjY5{NIbg zKdb&HNq^Uhzi+qeSb`za78qJ$NBY$Xu{V^&rh6)dBUv5`apwho11yS>=%Yma8R-z) z=5NN%^s3pExAv=fIGy+v881)ww=z2hfcr=+Mgb_82U$ zrTeeubM&nP9lo{S_9h*@kD1TLzC@!4rf39TXbp#I9Xf&Yq2|oNjwpm%hux3rg`Q5y z{QG!7pYN2Kt<4la&nF!c9atF^LJbQ?W&(LR`;VG`{^Ka=j{nR+Lt9t>*f@zz zqipSd<8sJM){hkX@ciNs24xpPza)_|SaG zr2I+Apv>oG7sY^dAmYpC_;y6p`(Dwb^*eqBnWEf&_Y+)xKvsj}aDmwXOf-qmAIO{w zFvPj-_Z?OCUyn{Dzh_=GK9xK5ufqYEIGMOe2pTLJDv5|+${Ewm>!%z&XIlg~r4X~N z#TPakVL_fQ;nyJ|LK6K4O0u}D=z&*Ysf3XJ2$$ghvvBQp>u}yg{kL8G7p87DK;WB= zue!hL_$INwsQ6XA!x!m)v^w|?uCKkP-5;dSz<|nC>QH~)U#e(|{%sR~Ln>UAG`NM% zm|)z^0Nu`5hm?@2fBN@-p88i0viYag_&a}7cV7FK*ClQ%f4PG4X5?F) zWNCkUBmARsmr>J_F#v%x)J^kF(Qr{w^JXOPn5W(Anm@5={zCN(Z1b(-aoK$f{@QUc zl^TC|leWier>N#l^;e5X_Q!k4exg_*-Qhxw)B4Tr6VM6D<#q|sh-dl-IC{S1Db*co zTXA^3jI0}*Y^hB;NYovyQTRiCr&X{9S&2LSHX7-EHh9=n9mYC;KyfBJg)VWKi4O4dkHeNw-6pD zVnV8Y48b~ZbOJ(sE9ssUTo{TmN}^IAV?sT>(c!TWWPDgGM`#ptm+fjRro`Cgsks5) zWH?+w4pMSr(b?+K#uka*|0Qz=&Wo2cKjV;2tb096d5O|U{)3IHUOoU7d0h)^%=Qss zlCVFU*`T5T23y`jyndB@`(rJ1d0bnBv?5B5%{=B)-K3?8wGC!MT#Xnluztuv8bb_b z*m4W0n_tBzG&M0o7Oy{kh0q?fj3!I8U9j0nUy6DQYmfB(lYv`$?>_=u`_cPNt6uYHb||og$|5 z9;v#uUhjg`iaw#9Rf?g(N)}|)Lboh!&`n*%u}FWIM|?R+Q+XwK znghhb8gd_{B(%|$?D|yB~g{M_v2W_j#W~(%I1lafG;&pI3~Kp<*>RkU(EXo zbeh2NQxAcoW1nM5IAHZzZFdrxqLJ4x1w#wk?E5Z|L$SQ(Kf?#UhtHSDTdnE>{+jYA zx4lol)H3iIb7lFdc)46rSjW9m7kq^WjhO0LD^J=tjn^pNJ~$8q_o>G#hW&&2w;L4N zM-f?w4?>1XOF$U^y+Czn=}7i)PR~oy4dPD)@-^?lOTKl9-;M+*ydb{cn~(6bR>Wl8 z@VCh6<25<&5I&5;nC`sjoU#7!`9_0Jo?EyFnXy_Y@XP~Z&#@mmx(0uu`NO#i193G4 zLYAOd7Msa>{SE3arV4Em;($@`6 zlKV@os3Cq!iS$SO?#IN+B?Kb^AP%C~M_)z0ZdlRwPHOvARk4@W?!fobr|k=Y2(Q`+FOM287txu4B?Dr+<^ed@9);AlQPQ)y&AaD)9vW>= z^{-}{hES_vnKdRvmJXVS&EX@*8%(Q}57@s0e~gA!-;OYN+1*L#@_7`)t!P5E9*-q& zcCVkMg+Bd^Pr;fuG5TOIg9`HSak6}@$s3?xdfY6td(J-W>qR-{2GRe(a45v$%q5T7dW!WUQ^>M|JLRruzKU#P z(GsYBJ9(LVermDwGBRcF^hH5C0v<+_126Bz3wrIw>S0Gr^z4kwjBWH8c<$uMm6p@$ zuWmJIhcehgiT~TvuKJmW=%__fMoQ#MQDg5mZ_6(pSi-6x#^>%xmPPB+!u|H?Wn(qI zq|xQ0&+mTt#cD?`?q0SW8=%dl3~rw9axCb)>b{X9*`iUHW9WIxDfy_OCJIY~+s0O7E2x3wmDi!A51 z3He%J_CtiQQ7Ob!et!C%QFXqB#IYA^f(Km*PgSTv%C1YmGf5v8oulSl(YQOG<@HaV zHoi-{JdRT}?Yb1_U*FB=3{!zh)yoWuT#Xoa5g-#!$2){EZRO*r>HX^n22B|&Jn5>@ zWWT$jj=`x)d!?yb>3iogfwPy2+v%jXgcXj;(*U52lj~BI@Pt}dzb=-V*gWS>iR&Xh zG78*C=|+_KsMVxf=@YDO19ZQ~H8(TeCP#vR#3~#q^2qxUR0cc|B>l@Jh^pk?W=t1* zG$I8@0!DFOGO4xNHXU_Sc}=TeMms0{;^$`THK=8MtArgfB((X1FA6&aoF6Be+XEJo zxOVAl6W|I7?v7CBl64JHg;!3x=ac3KcI6a?htHD8K^eg z&EXde>jx?+RYj#gaQ-%4hG|@7e~k$>44V|32jqYBGU=9$E7h^)PzQh8w=8y{$-W zPfu#C;=!@OcI_Z_t(KwD(&SPf19uR9m)62!(}FIF*@FwucO&+6l>-X(2=syI=v}3c zH@A-j+xcIEbh$S={L1z3zom12X*sI9mqQmSd)F7Jv%|aI9Ib&%6Y&F#M3iuQF*b0> zvT|Gk(=8~BVg*E@`jHLPHQT0cK2KJRsj`XhoT{Z)67Z99ez*oS{X}|txVroFfEe~! zk1hy4c|E6xs;-b*Y*xEync>Wy-Z5Q-TZAhPbmdtTXyy=KCAH1|WQ`?2Px5a2h<&w2 zGin>Zx;()m-YS0Io#TO43tEkMtjuUlczulP9u)e$18mAN=5n6osEm9h`zq}#iv(HPf{97y;u)7-_7!$R@ogd70W=- zD!WhFGj%JbvSsvV**{u;v-G6@7&O7PY^u~LIbTh`xH#Gka8Y6Suo9RI+*M;*zmamq zmDFgwE5tQ>&=U2u5$I&IrL#iidAs zboE929ORZJZFZz#2BHg1f}4r66FM~Mqc<}tyy3^G6UU6KG7j$Cn_NaQZA$sEpSoJh zl^@;h=ylvhb|%1eC%GDAReF*i@uR!fI4ytiCaH~+ZgthUxbD~RdL>V26^HJ`0i_%H zmfn-E+uSEJw(oUVpQ~rZEqAi==u)L>3L`!kj6qW(LX5Aey%2W0$p(@H@_Oi$p9dqv2>9w))&y zvx>O3Fg|XM&=Fyx9c)eJuM;!XK}`jI_dNN_w1#k3HTWVfS*=4UC9711BpCgq<=_x^ z`ZB6}6O2b(fS?mzap2xl`yGKuDAW)5{_1+TCb$EC%wmhftq7_1s|1LIRT$&+C!;S$ zy2JQ6=TB-)dNQ=>Ez|Z%n&gySt1>~Uhka(RIv_G>-O1uS8jFpb@o4cnomp6c2?`lg zHMD+0gpbgV`IQp=1KTi~;4=NEidd^6j9 zho1um74(^8xFl4Ymw|@5F@t%+X?25NI1KedCprFsacqe{0C6UYH~vfjm?@boFQ$E7G9Q z)G5HC;K0dPyplh?MP&s_P;&=C_}z{Poi#gK@wM<>!!JMBUTo7;SY7iUrY8J4@dCtF zbQV8clpk;u$#X)_I3ah51PO`htE%=TI_>Tu+L6{v^BrchT%EHD&y|*zdc`*uR*nuN zA*%Dr~y5gW9G{@8%p=C7H1 znUavU-@C)ZP+5Tm%WyLIJiKE#*{bdGouw~xVxa4}WNWSTF5RGpruwIT>tILUyR0Go zN|i4>G@9sfIP6+R@SKy!i4B?ND_#qW)x~072xj!DzlQzbnQI7V*)z^3K?;`@R=VX* zBQ@(c~Y;rMb9%^qund|6Zeg4$sl0#eZfUnnQ{E?%f5MM*i*Tu-=9D)BkcV>#;fZ@?j zAOK2m4~XP3Sp0fFh{5H zZB*Gbjg34*G79jAbK;xE28|ln6uLKCp$K0Pb^%Fgp&R!+q@>@A1uU%f?GGXTK+u80~ z;VreQb2*1~v!7nju|-d{o@XHYCfQ%^s_)ntyOyAQCcnaAic9_|Bbib)ops52`0+;4 z5%eBJ`t5thWKPM2C+?`DPz6A{zS4sQ7p{pQmeEiX*EPol_&Usg#*8mbZYbe4H)(%-$4vX0Nl zK306@)TmhqM*s&U8wu~+{Q6k1$N6}be-udmqA{3WQPn)fp(Zf7b2(w-af2`h3tPbgdv!KN6CTAEeua z6Oi)|zPlN^BMHlenaJxn)bW@jHl^^bpg{G<3%#5Z^ziZvdf{}78r87sPG5qQ1I` z;vrM&(XV@)vm;05gq)|^WmdxamyI2JF`E2%BTM|rS~q?|h`j@rd>&ZW3+UUcUodPm zPeV@?%#=gBlnyd;FZheEz3`ghQ`NuL^2t>sHQyhD@w`5}Y1JvHzV%0Pjebvr?t#&d z=E|LKcZzbqrOlocjwKt|TRlBHhQ20EyUvX*8O1--v0RjcW(9EV*hQzlWtezRxba+H z+AprKS1ioApFTHUIo>zWf9?1@nfZ+R>nDECF43kcI+~l9c3u+)gLF@BZ()QDaG{2I zDYZI5g$McDPI&8T^mB>n%_?l&=vQV1B|b`;Uj>!mpZP2NIue(HWx9jufYh{PD*~8qFHygvD%IlJ{3Fnu*kQmC$VF#m02P!% zYctA2@;L&CXn}elgo2k+&-kY%EkF&v;O@OAdSdyD^KFzq!Yo>JW|wxPhkm^|J4(2V zTFCqCY7-?XdQLljXt9(q9qQq1=Ot$oCaMqeUBTu9zUb(4f)AA4yt%8 zVE3Z%hdD-b4&u6emCPkJHw;BTd&Uz38n~}0>3Da(vUY6w=JW;Z2)PVXz)3d*xEhT2 zg4ynFPQ3#!6bIf@CCn4fxk#R2^S%R$bjsGgQ=M+@n1Y2L@HyP8r*dS?j%ldVhj%l) z*WI3JlxB0rEgr(+a9n~U>+bOYO)>QU?DRw&?Cr5De(@mSyoYa9h4u0Oy)Pc+9~J{f z=0}RU^c7mD+llh52J+I*uyFVh|!jU6e<4vZ5?YVC5Q*N`6cDf{h^ZET2Od^V)#MpC$=>Q7D$ zw*5^Ewmz$ze`?pG?e*Xs{}FaD9KFbbn3?URD%eD;x=G}j;GDa9Vl9W0VJs}SwSIuO zB#Y+nP}^P?+<=@^w`iofgo|eADx4G)Q0IJ9q4I*Lx`l9-=_6S_YS>6N%#;syAsz_x z(txdn7*T_#lI`|+xX*lbo(tC3jHH$MEDE?IeHSY6Y01Gzlx82*M&y9eE$3EXj|%A< zqb@pEKq-s&L>{eW%C2S7aAyq{)v6cs5yOEmt{0BWy7fHB2dQFSAC43T!cF)*L?lm` z$#fwm>Y^@rj2y;$30I3PhVniiK`!_Qoj`_pXi*w_FCIOkK>B34J+20zy?m55;M~NF zDH4WY&D9>VoX;N9ZPH%LrIB6!BSaz^24k51R*DWpHmpUI>58sgrtXLFLqz5f-220n z<=bNj(m9!_mvlaLM7@Mj#B88=YBQen3~>VNBauE*I=ekw?OfMVlL>is+wQcA#W&0+ z4DCJaTh1SV99&K;R7-Wi(WrI31Vy*d>ps9UrAXT*LqtD2`8{dSr9Yt(?w8?0h{BQp zne}TOCIC@ZsopdNxWvUawW7M0aM2H+OHI~PKD>YcHL-wz=?bA z(IU9=r4P0#DtYRI0s&nYF^O`+MAuHtw^YBKJe<%GY^AWYp#qigMfN3F3~XGnfY$Hn z-eVOu3P$b_!qjIuu)q@gp~TB|E2@)K=965Y#C77q)E)@4#u3Y5njhHWzc?+_5P8gA zSNUTTM6(%(TvA7S_->4j-mq#0p`&fgSb{S@jOU`Qnyp)H zvyIDQ{RxdhION8SR(rXA2~u*W5im87U%*HlrJ$r{X=L@;0lj^NJ`*Ao?ze0BF>bhQ zp)$=#PT~4)9jceF$io+;HBx2#YxlybV2FF^DZPs+IyFU;$gxU%LD`33?%NR&uZ$m| z9tT)!C~YBTw|v?n$4FK9*CD8Ctfs}ORmTpyFnSnGH;be3L99WP;PHvDZDqTo^WYB* zn%P;(&(Y+CL*#H<&_qJ?`q)&E%6*t3i;q#-L{4QU-1Y5n}Z=?n5PD`RFXHJ3h!k(C6; z_YMZgDM9q&Fwa&He-4M`%D64`g0@FlV*S}VF zvlXXR z7~M*Occ#}(XV&)3Y3Wyt1g&^0)NHVGK*xYUvkED@ieYS%E7hy$FUtfx7{sQxxK8{Q zYg+Q$dqFY{pXYO??7>0J?5>U>{FH~|(*|3dIVb)6f}<}BnmZQo`m{$!$DO}d3Objo z-9s2TpD_bH)62TDRc&y&4Lro89sb%*vX($r4t;dH50~G&8m6cElt^`zk{0F+G6u0 z*dAv2N=i8cIr&6<%imGgl%FE^IqH5Q75Bgv=N>fY1Iz*bkS81{#F)Tyo5WEM4KzH5 zpv}r<07JI%K{yCMYkPPZ(2$ZMF8K+7uGlD}P!lJqCV4V?>_-jb-RN+tl|R*F`m;80tdx*AQ?WCZfs_uPn5(tEyzW$oyjngjaG z6srv>{JvGI6pu?%o$h*hKht8&!DjY2$+|;GBSJ7hwQCG>mqbxv5bs&D|k>9OncLC~!(dtxl}) zjxtl@HXT79H0{qTVNlulK7!-eB& z2>ot2R-b$+`s|~{w_1Vx@Kfg<8Hk7VU&r3RjdiG7l|e0C6$QVRfQdV`7zi7==R(`U zVAG|^P`m~Vd0eyr)ZD0`xAJhesMVX;A z9@S&f5;DlI=!q1a<>KFcqwQMO<{UVD*_={}DVa)9G?f>N*bTzE`51YQmL#%p`#usw zz;ab85zoYF@^URu?lAN{7%b&y_5FuHj^}NP(k-nSi-Xy^8>a&YX9;OxlBx|sh(~>G zIy{r+_o7Jpi&wSMomd;a_8ayhqkwX%IjD9g&*9ZxVsjLyF=09?oeEcySuwv zf#UA&?(XjH?%GTLe%^KNea~6z`$EW`OtO>7cp^AT4x^O>RU5#K?fE0d_291 zfGx=$YE)?Fc-pk!l;8NIKD1fsjrkC&1I*s!3I2o;m@beV-uFnC1R_+m3wRpoJs!$8 zuQe6(OgZ?7EI!lK;>lgN=dMO;`bzyV!q`fuf{0JDJXL>F>nckLi!9&~$UHh>OP>qh z2A8fu$k}0`o1hIPqRdrypM~h60Pu9ymjy!cV~v0D*Q+qIOzB}vb1C}J&nmxvR%Gv@a1IS zD7;LAlq>D%8_0aCW0#wq;Cm3cTtxg8l7IdF9x$VSG5(8`+vs(re15#9&HkZLIdwSM z?U+={md4<^B;I+XF>$O)ai3xDE63pfT10;K+CP*f=IcFtK=Z)CqW^?apOMye6cx%9{nf%h$>)))ciWQr6!G&xmxh1e(mU7Dao0YX zvz)be*O^us>EE|hlq+@iQdUj=F4)Vz3YJfBD* zV3B5p8x2xXLM^%X_r>l@Y0sb zCb5#ysWHA$d?C3-V`wG!MB+aXcH-u%hvR(y{?*luUP~*~h#0>^(c)_;#GkKa&r*0T7%DsA0%cb3lo zC-DCJwj*AS+o?+4@n4m=9<%p2JXpK-e*yJ>(KhbmuXS79bZz4PNIO+OrX_jKkvGz2 ziOy(SWcChFR*t;B|2^Y6T5?pUWck~Ey#9~P@jkN0CGv>7`=#CU>gUPN^=*jfH%Rb#K}`IMvO%-o1N~l`BAMEpTam4FFr)+hhv4X~cLu;I3_lZz8dea$;9wV&n)w zF`mp84##5bVltl05Dv%h0V!)bF7sD>cir}n@cwSVYsWwG+rJEtPX1!xwYuCMxOy-A z#ds&IkLSy^0^9CepMKdty}yz0yOmP07XSeAUefxHx*+SWYp<5B|KLy-W&9)ezma%F zt%|?8xc|ef@~C)L=3nnQejn7ow#e;rdprREaJ-is{Lc&LFFVSLzgl=VqWz2h4~SdE zqcYakbB}kO9RFsY<+}R2T*^h|ihTdBfj^}C<8u41xc6%R%KRhuOR%<%zuN%$)xqiS z&Hp`QknctHf7Ls!y~h3{LV{$vB*8-1Vd*ZVe? z|3O2vzXwhGdCkAdehuuHL>??v(rW%{?hfHGXH?=7ei+gB%F z^LdBN1NQ)S)~(!mS?(8l@NDWF+q>P~3mn5sby_=LM-#`{+Ho-$*!uQri_UDo$9B;l z$0brPcj$qMNC2RMQ1Irc=58!SftTs*%wukR-vA{Xvu0YR=rN6AQrpv4Mb}yhtup`s zx1<*U#0R=2urUibfB1OQmdMI7ztn$Bt+U0LIPo&J9XO>{fWNk^eo zbn9Oqw*TXR{-bnt)xNA;?$%$H_7iN3+)**A=28~rs+y=q5Zn}SCMb9!X&YLiT`r+5 zOtK9uWDz-{5NrunnZGQJtkQ`PO~MYC9FWFY6ngRG$-HOt6)y;_e9N1Y8$!lkVEG5} z_uBdg^BwHRP1jH5%7<&|uDt0pmrgA$%}Z`AXOo3x@%I$PYJNhRGa#Tzl#BSy7FAch z{Pv_NsGq@3KdI(A>7Gpth%b|R!^{e18usd<7OHC62Px$m*v}EF#mCR9`0FYwe$)gK zhZt310E?EDM{p0YL{xTfLPcfTgh6*w{|w?1lre8EypKUj6!Y=-NKiH5-vZ2Hq15dLvru zn*-wDGoFv}o)e|}huQ7xX}EhZb8FV2nFHY}y#m@Zy@pnf^wS$EOqjbP*>3@T@v<~ z4plG;Uk_32zmO{0wo$T%)Sq> zGKD~zL9Bq#O7Nd)8b`*9KDMhC(=w!DAz|6V zF-!-ZA+^_TXyV^NEkO12_B-g_u~3BuICRo8lp?lXAA4;7JeQujt9^Su;%q-Wdi}b~ z_Z#$pf4}@j|099=&CXtux1q_&{rdoP1k-RTs_MD8!9|_yjF~YV`*~9o5fRA&&fJzk zhZkrR9iA&%rTQ93?Fr&7Kv>{``}<-mLgwg}PGCMzfALorkCqZ5Q9g9KQAsi#w(T%M zYi}t3LY#pNbMc2v?+dOZphC}b*JKTreEnYc!qak--kT>QDe14`p+Xuef{LXqYK2f@ zQK)e43kU_76G3o#?k4ZfMxpQcbU4-BBUj7F!2>G-f+u#%XfLN zNESs~W~LafN5J3%&ZG%E`nelGBj_suATVw4Jn?yYMd#@g5p*OlLpBJ>!o*xukRTBv zq~B-44`s7XKHHe$$*NYA!Tn?x-xbEMSbzlS0!u>jHbViOaHlZuCksvJdxFnwf1)fj zX{U+)p7280@BK#nN@nh#%gcYO^D8-ePj`ImAuKYvy86b5`qne7F6GWU9L>6~S(lbv>%_r|YZ6lO@eGaE7Ed*21DgW) z@|NY`6X><2v9@(-qX50KnIRaN{6#@U@cqe0AO_Rz{=I`fpUop&zwse~5&+Dzk-xf| zQL02CSbn1++GxFie>RWzx|fDUqnX{H# zln;)MK-LS;0w8?C_-N!p&A7SO{Ylc~g_H@>$FbP4&VB0I@qAp03`ob2G%I?5m*BBX zNJ(7yd|K7qP3O837*tROC)47o6a+3PKdZVEw9+YkXJ1}r^zM}(Q`5@j$hyqMq1&vr zw=pJZ+r7TCL?d*o_kgafiJ1(TxV^etBy^X6rj<_>Mo_2taJzbUHbXqwOAZtwp3VW* zC?Q0492z4)Hq&=w8Lq#j6H=h);XaYNEjz@XYU5DsDA zjIM96$pvf|sdv{uhvZDERDY$Axv_6wm!lkB)$LEwAIO{`Gy@-J*et00N+Qa*zQM(Bm$`#AVFH z*nUWSO-7_Dj3*MMT3)y8lLkwq19~PsZsIq9E6GRU-NUT3BHZ2zhR{(!*>c#3cnQ10mJyVhQEL=OTiv`pg{v zeEO<%CUz$<(c*S%I2u!+4MF(~Itn#@Sw=J&ROnJBb=Ep#pvo(wmE(r>>beE4wlM#` z4a=*#a+)d)c(!asRiuxAyPb8AlnM8Yr&@5ONKny2`$c=;R_&wS*_eUo#CGQEc)qgKFd_!2o-|i|~)r<~H$N z)k7_RBj=sk{Y(3Hn#^;W=#;~M9#k~nkKa*g@W;KH=#ut{LPJ%5oMJSgc}>GvyQ=S! z$^9-E6cx~x`O+!gef|{)ajA!-bo*|N>osZHxtz|jH) zk3T~Q?M#S8Zq@O!x>@b-Q}>UC1JBIQ0W(`r`^YV= zo+Wtp$nlHL3Xm6^9y-13g30bdM_5Qwb{XkL>RwN(Ybj zJ|NuRF)7WfsYUayuz07xSKsBTQ`5!!irf5qx%S&{9d{ixD*OMXENR^N&~ljHwM*h7 z`dbu>$7Ub7=bfO-^{@QkKNvST7xkPQO1e2w5JC?v10Gi*#C8q~VpdXcUNQ; z3=w*u?4hfg_L|OMsGcboI}FFyc{&v^rTt8n%Yw6L)A+qlM2p~y?5<{xu$!wywU5Mo z7_8SLdKl2J(hGOLo*1?9pPtE6-u?5GSC_ZCdM=x=IJ*~E#)C6l7Zfmly)D^g=L}Y^hK@Zi82K;1@@26Fz<+bgCzV@ zbJB9h3uU44t{i`%Du3&&4fW4r&J(J4F#fS=l5SBxuGAfecCEdnbe_CkbgB+&UU>z$ zFQ^fJ4ylZ3F>Ww^p~8=do_}joc#uUn=`7T^d9s)|1O`fY-N);6du6S8@vM8&+B|(5 zcDmfUJoaGSZSTDP-&K9*f%IMe<2wNLzq_eh`bR5u zbN|fL{r-9{Nq%k3oS}7$h(4-d4WVapshY8?Ms0^?f5j5gL=ov!g%F_@@Gc_IacDN7 z8Fh~$2_aDd0|Cb=<3~ty;84VnYs8RK}WWD7Cc%93hsb= zzKU%5zPigp|6a-W>gDenY`lm4pMVpZto8>&nKecWRBY^bMYft5u+J3b&nvtP$z%B%xr z_3+(7szd+$=A^RCe9o^IiAAvK6|+jg3l&9+6%`diY88JY0148AK@Y&J z9_5OL4tV1GPSd;qYj~+CqB6;7&9d30obukeec5V45KkbQsfK3=T-~6C3PqJi zls<0is^J4Me0_QA&D!GP+1O@`jj4U9aXXZvTG@OQ_~4s`)2|^4`!U*2%ri6AEfo60 zhb+&fie1*>WkbKA5v?6V4mt|sD|2lxFs6bQ{%Y^sBs*6Ogkt@&XY(_1b&!D^8;*&e z#+Ba1*VOPluAy>2iMxiaj7f&gvy40<;KSZPQzOJKR4-bxe0AeNN2{`)4_V+bu#$g3 z`YrIabxh;B?To8}@BamuBnsPDFv%w3^P~fK`7_kR>AKo<-6n*tyz;3)$cc8m>DX(L zc37!)1qRyK7U4&>rX8PqCcSG6<11?EBLNzr5-e!0s^G56-Uq z&X!VK0mBAf{((mT_q~7aff_iqfP-y`?gft`>&)uo-VDq3va6GnDB);v>wJXKw(0)WIYG`ZKN!_FvYf_ zd2A_%<_B2`$CPU%v#;@uWCfOO`;b0k4Jb=WYSWc-Ylb5KcmEK15Fs zQEDB^BbrZAJn+MSZ1H4wt?YI9QbN>!Z>p(pH-yXhQJ`a1S}WHY2kmI?tt$PpegflS z(XW|9sg&sEz)+aPN5SsWk;>+>K?zbN`FI{gwX?(1$d6{-Eu|L2)Y&&10M4eEv2D?r z_Ao(?Eoz=T)jNbEOSGX!-=Td8=M-x@LS9S$!xz-$Lr|E$;b&nH@ANUbHJG4tlJ%8J zdtkdc8MsDgKC<@H9FVyg@l|^D>;9q-p@d$2MrzOyzPcbIt>d+kZqZHGKsw-aUR4PKIgLc5@) zwHQ&M9uu{{aqsFdgA)MT{XC)JWxT&vk;xHa7sIM2WQEvC?(vSH=ifhl5YGK^?WcOn zGIKYqW`|*~S*Q<-L~wnKRM9Pw5ZQzgsm!?E2u`|;5=_P!%i;dKSk-^9y`jP9h+F&> z-_mqyr`2Cvj2T)t>?z@qv)EXgDIXec2*u9d!e zF}hfQ&J0#C+8rbZp^Y75QfyHZS>(Lzb5auC@7N@= zE6fyr{K{4E=LMlZ{pJARTZa3w@Wt2yh-6@vVF&bZtj% zv&hOpnPpdPb&syA{GqZDkb6t6pFbJ_E74!+NWf(T(gS(BCtT*3)SM^9^E)xKTJ2%F z=q+@Tb*e$3vFN`qH%7gjh`8VfDFL(KtwV25zf3*>G-00(C$l#SQ;YDy=?OQ_>~1%V zRFC-Onl*=;Du{NT5a=Trd4zruZbqbYuGvjEo)CAp7!GIp+9v{t2ADyVWk z@3i{4>yhhT^qZMh(N8B7S{q$uTBo}wYfJfYG zAt9Sv-T0g{geraX(q@L1CE8HX<4bkb;ba?W?JOwEg&4w(gTwvyDnt2_D|r(Gf5>m^ z*^)w*N|oiY;D?_R;#E7!6cRNC)6rMFm35q14x%>1(;HPSZ#pMBGMqV?uFPv*{O#{ur&ZD8 zTV?KeuKXfsn=pD~kl6c)qpvO3Wu*9EAS7_cKKz)0N{1c4;t~fS- zrc%$`DE!=N=}BLlky#nqV|XMz1#Xlnc6vaZudCSAVpgxnj zQnpzymAO!*PtKEh7hmDt*I4iTBJp2N4TJ# z_azy~{BjBU6Tc#@?A03@%aeJ^-ckfSk?@t)wN=cw%g@QCX)bRw#dd|qs0FL4czTqN z*65~SUIl%27KF##B~G6D3Yfl{Iogj1o!F6Yly<@Gd1y!S`$>*g$j7W2oj7Ku!*ZqQ z7OOaCARAExh>(_xiUpy@)wqC^!;~kIyw1UVNCDbHJ^cq}94pR~EMVpYrxPui*_LAa ztK1}fuHNc0j2(tqxk#r@W~gQOk}s}8oAbcm;ENE5*Q-Vlr+-V(gV zJYtr%dzW&RIeG*sGuI@M7-+VXe<)ggd@aQ&QH%g*FIk#{FLh@S+>PQVz+h3X-QlZ# z^P|IX_Y&(ok{<1D^aKuQqQAsR>!Ce8)MQYSOKF&y17UtCmeei&s392Qg7q3-#=Qwh=LrMmlEP;e)Y1IFf-+>M zH4X!3crTT;3^uLYUEa;wM)D(ZiufhjJ&KO|yYB=QNRYq)-HRfg=X&^TM(Z93?zCQd zbn%2{x77?X!~(PR%&WtbJCzheu}w7U94BxJWZMUiR(+7b9jOQ4Zix*w#d>I;3_Ve4r|~aU|)uw;4uT()gce#)K7f!UV}>TxNJGMJ6bfTMYvL%Uv0ZD zKZoIAuAySQDg@t%i;&r-kgMEzIo4y^L%v2mA8WS>wq55Cam)wCqpNOyYX?Zs@YCBPKH?Kr|bee8L#{rS*{Ux68 zBvhZMjh@MEoc^OVrR*@MoS#bADN?#9n?KHig=KQvljCm{XRQ0qIfAS_L`~tX!)_R+ zU0&@$Yqyp5&IL@6vZdV9lK`SYdm=Jp{%^;Fq_ht?vZJgav_$`>FIWMU&`S zQmX;?lB0AyOIXE%jnFjPt5SFn}UA)O!n;tI@8U?ORV8M&k6@$M31Rp-t(t%qBj%+~KG`?VRxm4Gd?+Eb>L zMbkHk@0f-gQ=|8^pP$pp)v?p8KANVrY*&qmUY1&|#xsMJ29fm^+oRelawk!Tbdh>e zkldhki%>g#7vfJ@8$5OA0CU_rg!v$aM)z*mEK}M4B9cRqPZF!n1mCg|sbR@zg{KCV zNkD(3Xl)afPlJZU{>l9ptJttPEs^alfsrvAJ zW$Z)4qiY_0>G8shg$&23!EW5M#B3@M8kem`S{Q-#b_Mm8kAs`rXG6R2M^kQ|3v=AW zrV0Ztf1p$Ge?6jPl1Wp zMP&1IF?nP@XOBa3DTJX8>hPsDybc~B+B(dlYuY6!Tb04WKq|TWX0-9}f&uR@M=z}X z$@M!Ntuo(zR83xES11AIgZ@WXrB!f0*?v0}NbzF*kX_AeVhvzv%4>`^i;-5G(xKdoJ~vX)L;>Y`F~^F{|EXA%h_n zw9KLv>|{knc^ruF3^My^WtEv2WS=V(3Ozc-gINzLaLVapZeNe_IvpI9b{Jw9*aT>& zEE3#ZucIaLt+HXC; z!`awk7onJaFv1=8>P9#=U{lh*xVd`9)elM9d7MAD!gj}G-ttz2H;CygNw}dseBlZp zknJ;hhfq@Bx=*Eh_LwzNiVTz*uNw@L=c1Qa&oA(EW|%0SnOR403lwq%p^rqto0;u4 zRdlaGKi7N&on0IEPx1B$OBqz7o21FLkuZne9@$;^Qp`%^Xmuf;4!<)VPLBXVH3 z>zS0uJ-$1nTJch5-NXPaM%H}=_u~==thFZPwE1nK6eYQhXXM+xkvRXuXM$)>>E~u-C%QWinQ{ z#IX3u8XhOdq1=d+Py=6mI(g8Yb24q`VpXAci72sQ@9N!qk?WE>rN_&t?fK_RFXuZc zW%Gw=y}ah>;5Acumn_k34RE}H29ve>3(2ov6+T#XzVNW2x~@I_#CL8keXhRhSMB_? z>}5y_BR%HWkzAw~Cis0@(3O~P$jr&oxOOkJ7TpIm#*nx*8~nq|XLHf1S#oz1ddA`g zODsXTEWco15F2fu#b+}mhLc`r>HM&I)^#E#c?FjFOAgi7Rs#e8bWPKWw~gKFDxyL2 z9oh)#l#E7?PZZup3TY+$@uga)nF~AN_ko%YiHk4Von1iw=?ob`^STt3Hdd_bpJzpL zz2l4U$}?r#&EPIHOL}|J>Vx~QMB7j>P{2YrbG*9_ALf=m`uE;kpp`00wp1S9 z3gKNA^N?6FCG4no1K~UfIbRvU*=lqM$ht9?{4j!UM!`GQc;1FJ79H%47}o?rb>To= z1ka9-fowti0=2diqs3w&g5O0HjU=&Y6t!Q|K+vksMnT&h@P?Z`7n@hgp{e%CsSMX) z2=h&69j~TNI+;HhUVVvo9s6VPbD4r~N@#(U;}=F%MW~W9y%q-Wj|))NKBpz{?_L<- z9_L%}s6!+6klbueGxQpQbEQt%R7dMg3N1pbCpi500pZWYF2G7mc4+PPGZ|Z9-d4s6 zYk_oW@!w{)Y*B8zJ)aEe^iF@)s*t^q8RbiCvt~DRaN}`om z*BEFdw(kLhWQL};q^|E5a@q4$aKJmuAPNRcBSF%qp4*2n!#~>T3Y+>vCzvN8(CbJE zPd8l7FuDrQft2ZvzEDuK#AWR@CGcoa<9;TPYo22gB~|z_gf~x494c+^VUQBr70ZSk zcznrOU)*#{Tc^z)%ErQUSP%mt2QafI$vURic?wa2;hg$bKU=+uPbayQ6`8(eh zAQ+3xZnyoLF2Q@VD^{vE9(|v2BDS+;2U8irIGJ^NU^jnLG(fk`Wssq@Egy?U+h^h( zmO(x)A-~CPM&8{aB#IB+T|3AZS-t8>ywi8Yg1X~hF1XrgFZc*uW!hkXLfBH>6d)TB zzf=aS<)}<1k;h+blXO|FuA1^TotnB=V=<~9XQ_Q%MB7|OmIVdUUP(&ncgy`Wm9}te&k&Ha4j0wJ` z_79iKWULOzL~S0=dc$l zRtsut=WC{6baa!=cN`R&$z|<*BGx#+zo@b?Z}R}(0nAPuhNT5!YmT*!KJ89nv$=I8 zw(ah;fw--In@&Nvl^D-Q7#`+a=(h6o98NGBV%B;w=^-Czdv)(p(VfwX3z?XAKmKB- z=M<-7Ep22wCX6&E_Q6bG*N~?g=>Hb zjP}ElWYLwN{1>?!>*P2EFo=DhFw@54b;Cp8l2hzQ`-^Q0P6da4m?=L3ZNY80dL*-* zc?mv#@4L7uqr1gD8q_m?jijbEV=ugvbQ#W5jUmvhkLt5#f+->0oJ`=Oy4r{IIq?L9 z$lhxRl)|yCM|aLQ8`V1cp|wWRYnS4NL$ugdtcT%-=+7m&Eb^9~WkkciSr2oJ3ix?X z!8Gbx8>&0kBai!myVZ^S4F*K64C5E^STM=-&odB!V#MfW1LZt|SFpE0lM=nO)t$aJ z2oZXWofPv@v^Qqi3*TaccZaOzpxAJC+Ac+X(#(jjqIdPqpGmoPC;2yjKwWYUYNwcNpZO&Od7n?v4?bcso{(?-DK27eN&Hh_oWa=fopp6lHl`MLmhlo7oUqYE z_b3#^mDx!CSui7vlyAsf-s+DYvW`1WN6!ZIOT-`PM~p?fj3#N*JoyeVGdht+J?9H7 zLmP&bVaV`!UkrNb@><|JdzExj6>I`m3jbDybig&ThPLf#Euh#uy( zKl#GhvFaM-S+*6Ec{1<(w^@S zve!@}Ru2KP({B1S@5;|n7-JwYW_&K+KLl#l`r|Ps@1U3=W5dI)DS(xG=RXO#u|Xk! z4{wGK-kx0#AfA29flzRHx7f4cn*#~R8XEJAghmr_j5q8Tw^Q6`ns4ZjV?MMqdb8{^ zu~;ES{)(C%pa1DjI32;0LiPb4Y%T)gg%9V&4D``hxcYOyAw!G@)-z~tcpq6gdf zQDfRBxel$WpgXqQCORQ$xEH4BMg=1-jQk$%g$-?^ud$Td+fwT|ro5Da^_yS(4gNjc~&3HZk`6C#c92vwJ(H`;1vk0cDq zr!o&Iq?ODtO}5L^@Htp>4M2z$j*0tx?-%gY27nwT?GgpzOGd~Y#8@7d&s=s7fpKNq9DSkGhQkFNhIK{ zb^=3xo1$BnHY{kGSn?+yps#ZKe#Y{6QI!_X2SK&=b#x?hTfg3QZ5U zf}+kQo48`D&FmC2#)mMsy3konV=V3~?QatF$gMxE(H1;W7mp0!A*htK4E2P!1WYw< zxynC%m-9d*zYu5nCnW6l*5(-WQ#ohn$F5mGUmuTZq3Xc)q26e? zlT2!aUdw&!NokI?WWV7#M3`ahq ztuZi~+DWf%s0L&``HRP|c(6yR3B}&mNWg4$-|KtO4C40Q?DU8SC@JKB;8rYMFuiF- z$N*YRIFU_2_JD|55nTDw3VsH*71gN)xq(&Adig>#c-T+p@C_af`wP|zQgrdP7xBUS zL(_Lq=U9+r(ZT&iw_Y&|lDU zl_J962w)PHaMg@o%yLAbIfjXV=4~?ynJR7(UA?-D`y3H*Pe3x;&co_~IuG@1K920U ze%YsRs(2_Q>pyEqnl>qQ6iDQU^C043t`mFv1Of**DCq1KHeRmsE;FXpiJQLe*38){Iyy zbwk$ap_rVyos@};<0PSL*C10BzQsNLoF`?V?wfThLi0%yb_|Nm=MbPg)O*7$0lT8gE3StBL|bO-gVub^M$v%$t#^o*hAlZR0?CehF2gHxONk`kDD>S@sqy$0Tu@;{e^!; zIrB+A74Li~5G4^pwHhUH?ey*?)SOwYq6dX~VXD8U+iA8)>ZvyeP-CgD8&}W<5)~7D zh4giMTLXnvgN*L;T!kZEwt!?Pe_&qSnO)NYpil+S<6Lu2VU6QqKsdF|>o>p28ap!E z3A%}ZAX3``Bsna@dp@=L{+|IV+&0!lf4DisckJRy`JCB?wLj?2AescA$`HD~P2r%+ z9v+ja7Z1Eb4Yfk6HM!?rSbTGie8_}8BN*XRQYpg`e}j%WNUh=&!zN;;ncFt{rtG0G zgYWD+U|uyM!F29DG}RSZY9i6$6#L;*M}WWp!F{zo1HhFg03j8Lt$4kIRpngSi=t0> zG%Wn+0}41&DE$gpL+kjGl~?+AiIC|2aU5;$OzSsO#gS%k;{YP%pM_m#viU!}>&x;+ zY6_+WM?$bCuomZ`Qiq!{OP89dz6?ms?|ww8{t%8Z*93$TS*C*_$jTr0x(LXzve6Larw0IboDT9r zwBj`iA4H9v=9FBpL&vkl3D-lAWrz2>9oXd`*3V4~>p0k^3Oda1BFB~I#n2NU(q_z0 zaQFYFBcXR7 zBCcpZYUDhE0`TE@CHjvL3`zV>HZs4R3746d0!#lWV13dXaOa9IBqHvs(ps}{nfW1h;P-@DJT7IfdXDqL&be2Fzv#D*N^r?!o-oWE2jYjx2rt=)%eHfb=-HeP6t&ywl9xV+P z25e2q>7NilVtrLQaL^51dp+HtBnNY72s@R}&=k<7uTd0vnKGECSsOi@!i2%5)ej!l z9v==*@ImN2P$Y1(Cz3HiI(mCETl8@33BFyP@l5iA7n8^xI05G(3iIdz)0l0mvi6;S z;GKo8n;pjSd^9s+z^kPUqH!N~>Ls_3hsehffhfC4g#FA4W_Cv+@=97^DU=0^3B@yl z36_U5)sOaUB+83)y3tcbD|BFU>3eoj)cM9#QJln66+^iWcl^ep z6%<_Z&3jUgl`w#S7RHdXyEO!-{FsKjidrf^%N6p?dOH5B(1Z1;hI1R0fdhBlV#9z3 zhc1o`66h#|=+a8~!wPJ#>zw(DXc9Fxoz9fZ`p5I{txP$p9yjy~C!RW#mN~Bo_fA)} z-DK6D1Pb%R;2nxGWLgNGZe#tKgX!VQuyc!VRDaTTgpFK6CKNf)gN@Engf|R`B8saZ z8r;jk&}I+FvIkw&5(!!zng_nSLuauUhF}Cnu`lMXLGd1$~Z zlM{S)MA)D`h+gP|N0vV+rG4uW0vBn$i*Y+s-m!}XX^^}BaI+LQ8h~x)8Nz~o!Oz@G z+UXTs*jid+9EOwFeBucwLJpobl1l#-s-y<+rJ(C4YhAtIksqs|egeKWJ8Q7t2y#N? z#wVU`1urLHXGxMq^cIhki|Yn2)l565*3=fw__h_3Ypa5>H!(_bewp*a0?^H^tFw#0Uk04B&?0JUnAp?avLODq*YMwyPLb~QNJz`m! z5Di&E>k^boHKCX-<7OH8#kqkL-F6;9@=YLRJ4;a-$;b-*Jd9Np zY?ao*p|j7>=@j1wvV0_y123wyMa~jr@Zu|Q%=e+o&0dm`h#AHP&4`435M1b4X*i;o zu`1{8t*LEVW!O&ahIFg_viWyhFw-dCg7L)X8!LeuDSvz>!y3^$rF;;SI!pQkVt`>3jMX$k=81W75a%%*u;Q(-f2qSFs)s@&va zpa5}~)R5xLxD7h+G(h#b;>S|(p*7v_(L|QJ_#5mjH;;rRC1Mi%(`nCWnI=qNCfPcg zv`HOWXg;v(!hlhO4;aX*yl@yy5h525BU|&QT9)kpg83Vl zxDKp+!KiqzpX6HmEQ=>d@^I{|)~5#jmfkccVASd(<6BtDM`k`q9s(;VT1MOP95o77 zR);~0@aEC9Ich{kW}pj$_CZ2co&em~>53ae>sJO84^)^vynqLt`%4!wNPNA0Ri4yP z?Ca%&phOddR`c{KCCwB!&cC1+5x&wLVZB;$-kyGzpj~R{wp=|2he~xs88ta$T=UfK zp|M6OZ2;-9g}{ofP9bU8e11Cb&?%lVG}Bu#RanMDW{Po#Rtf5CXywkA;p;mia7$cA z1GdVRGOaoJvUhx?1DOzk!*l9AFY=YJL^#v+bw`xGl%y^Lu=FZ175xgaB>ja_OW&!b}Hjzi*pUeN|J6OYyJ?mW7zT zeit9)H`ACL{t8&YF@H%i{QP*xSreGNdsrzL0cQaNS&y}Cehwu>Y=7m}hY$hL0GpVt z2of|CbZa)cAG8;SoXIjL)C%eZCsZ>@*l&lS1%(M`-0kIkT-2O3)tStwa}rqoeF!w% zuQ?=R0#hAIuYygaBf}RW2%(i}dtA@fPS`Oe>ppFHgJUXoDbib7XUrD_V|^IWQFhf} z-=(1ole-~>Tm&xd*i)@sZ|~{S*l0{`V!JF7!ZsZW+mk?U^WfzN+Ex|Fzg181HtvO$ z;IfuofcXw;5|j|hN}2KfG*z;@>6lqF>6#4-aCBZdPsSSMm$?+=DNivz?dGwTJbVKRo;yTP0eBmojwraj;S*6>U(-6_Hqj8G|X z<+Ua+NLz$61Yk9(vfVr3Eq96)E{UXTLZ`%Oxo&oxk6~eCh9wBd505Gr-aDOfosK=M z`SCPkBE6kAq&O(w#}&G~itj$tbUfa7mu4QkEga+@(BUw4bSha&xNSBaMu68j+nJ5PhV7%Ls?^O63OoK!@`$p zfEpPeKh&-Y64WkR-XiDK3q%vIIv5xl6XcFC^n*94@H@*3lE>V~7%>RX!yx*GvnJA6 zo{+ey@$n#fcx*a71JmgVPl4jJat+eZwuYtbI|?K6{9J0Hi@HBnGm>U=g;k#GdyiAGtiNZSwq0J$j&Nxic!YKBWxgc zvwnF0p8(kfCi?z*oP8@iIn*WtlY z^0hNk!X;k;Mcbva7=?zCCs0Q%518)gXHNg`)m;4EpL16K?Co`OQ>8O;N(QfWPg-n| z_DFi0G&O3I(dg)9A-sR0j;68ppdZ_2elV%jAlyTUHO=0j*YZ+OZQ+_(UYQBSbEdk?Wnyu)vX^~ zhN?&9@(O><12}#yl>GHpV!pZ$$U(C|sf~vWC@~PucXMm;uyo@_q+LuyUHphV37C-l zcpvbMi#P-mUQ(vPqolrL)T}M$kXEML;!=EOKtO*D8^kObO!9aHE! z$J7qIHyMjkHF{U1RmS5w96Z3bM?ae)Yg9-M&!(Zv)(vbmGu$WvNkyLkprP8Uy4edFRA~PSip=dk4Zu zcr}>3N?6*{#|1A>#SI#!Ne=Tw zfEbzNH*W+^tjyXg|GT(HRf^-S2dd9bgS=3q;<-? zH$?I-IpOIFWI}cLb`;RLK*eP!DvC6Nr!PGzn$H77b)7meetw|(kw&p3y)dIQC|Qra z-ke*(rs=dZ{SyG=Yd8M1erMpIJ5WQV@MNtd6o?h<0LnW*^fPnHLgO5)s5CANuoW9h zpTc1lW;=PKceVuv`UKuptcf-4vEAGln?B4Tw}NJGlKNycl9Y2_Z22GN|ARlI$bQoY z2|32}i7;sYy+EcBQ&4=GC+l7AaHL7QDL1uyon|i72`t(#o#$Ld@q0d=$POMILFxY& zmrrwY-?Ee4Ry@PB)&p!63W%Cgr_UuWoQW{wPtk@v;p9!)JcG;w25ZxSbjk~+MyL;nqjk`Mx-RGQp-@D(NnK$!e zzS&=qnU#?d8M)TlD|S&Opk~5O&#y|Npt{LVmGyHI0&f5S;KxU#{jmc8)lr;#TU-EuEP?jD-Ml$Dg4%%2ow+yRthu{z zHorl%Z&^baYhA!OB?7Ls6!>F{FSs~fbJa_>gSw1B(VkNR4O7gxwU`p`9!iYeh<%D8$g5`aP z>&5GIfMa6h6upZ~2_R<>vOb=O!DNm*OP9d}+)n`mgbzf-8wmhJpPgNRpJl+*C4~W< zl$63`0xse`Bbk&Gj$a^&L;*wOO(^2c1i}YMB1uM%V4$ZjPf^TB5`iA~MG9b=%eS0j0(7dtX9Bnd z|1;!ACky~!1`lBJyZguA6j0WjlFYk|XOWzIUN^X8Qg{RmfWd%iMi6g?P?97`kk0@b zeg;X9KPDuX4_u1DVA$8h)H^(hP%<2EI(P`3BpksXfS6gVm?bCm<5ji?+WQvVgm897 zMnOgv90`8rYY`I&f1HS(x-!r0$@6X;(C@8 zUG!u+DJlPD$xptzqmbtz)zc~o z6u7(UYici4-J*N$_%42O+^#$i#zN+3k$N>+iri?(rD1`KJ*SmBoDgez&b-tt{2mgX zJ=ecO*<(?iaYC%5JO5f$uF}D=6LuWo@jl3v&jO)VpAj-y5)KxVSS4&e!e9UN$)4 zBJ2DlLB0I!xy1S;h^n)oN1WmM%8}ny5H$=+J5bqep|Za7L}&DQ#x5| z?(UZEa+fha*mUkkf#WM~@Cm`6A~+#Bz;D#Y(vLrDqfX0!xuS8mr-uDn3Du0|(DqbFMvWBapVJ=P84wGMY4kj)nv zMmqD=4v9C`$1vts$CKF?%W&jx*W-y1pV0~03?*PGaGj{vn9avpsCbriawcEsiV}kEJIP0_k5em5+zWrm0(^19*S_+OZ$$vim&^fVud;$ z1pqT1TB1~~=gV^&6`K$AS%`mHmY1fyTJxffCSk$cYNESuE}%_q{e45m%cHP=`yxgb z%VGV{a`lR~ZIpE3x~+W2s&CDa<;J$(`RLX|bKCWV7!3TFN)C)~=*-y#GZbG;$s5Ij z9~2=*m_!iYrko;79QIo_f3+G`po9W!$5pJk)5@3cN@!{c=0}#LK%j$p!c-f&N=oH- zdCEh5fRzrVQ)N3|nfB76T8TBOYT%>Kz#z(uU*rjjPN(IBSWJpgp;A+%_~&PJ^(-%_ zv%{KZ6~VrRg`vM;l#((3A|r?+b4aOIO9f_gyycX^GP7joOcOo~?`UoVJ{xaQpQjBA zWAT^Qo`wojVGo@aC}k3e7N(=InWF%+7P;k@ZUFK#2ER&Bl!HoTFOn^W?SL$R29l%6 zX+v!bN#Of|U`4gAssw@pB(V3H(njy+_~+j`u>vQV~Vcuy_Ua>LP-q zJ+x8@K|oOeo;UR>7={v`qA4;OJ^~W#Rj`Vlx2lgDJRc1nu%ZERYN(10@TvqVMYY_w zP(zgAzH2?mrX&(MAY=gwGI=tfPChXH(?V7-A#HtOJ|U!rJH$|6S}GyXgDXv9{-4jt zZacl?zjnfR$hRF1w(pgl^PFO3-Z*X6Qtl*?sZZhH3t}(#a+qhlzmUqi^5#taEa&FqLsIG| z^8umEh2pMYEfgxEdb}Y_RONT+Y*ZEpK$8%;TnF>frg`)lyST4UUuJmGI;dpZjkc6B zghn10Oc4P1D(9qr5ts}kQkpPMu}3YMB`>=RB?m3PKoqf#yjgS%e7cK{;NFbx7AdK) z|8BPDsYk2F`t$mi1Q8^XpHH~WCS(s^4`+Py4aQLd~rBgt50SL>qHMZ&is5j7L5utOyNBi7w@nwC8v`O~}I18ig7wY)S_R9&QSm2<=xq z23|`kV7*FCAv&pPVzUU}j|>8$v=VeeDzazuU^>R1Ge@{2-IxyT^Q5BvbW!aoKhM*L zVog9m7NmYY#VBj;?`tIqONd@{BvQc%RiTC#Wl*mT>YJbI>?IVoH*8XpP%o@y>HnWcG4Zx*z!+*fQ#@l{K7>(61W9LoU;mw-4j zSg^WDOSgN^He=o73v^&&aDqpz&y=YLEhQ1+sI}Ulp-tTjRn`KAk9F{ObqSy7G4PU| zA(4~-IyX9i?IfV5#IYC=R{*>xBDs{k3Ux-lI(H_nLZ3+o- zeVbpuYnbBM0dMwX5(=z{h`1~yyxXXP8g~#MfX^O`uC@->n^;dw28HK&nnUtR(K2c3`9zrL!!fmos5@oNpI0Qk5K!>LapN{NiTDF0vHw$L<$O2vIz{788 zD*faZu*$fqJa@0E&%c_FGY;xKB~qg=zQJ^;l=1%dXn;x zdljFTjCUFB1K7Rz2o@b!L`D%K!YphWIvg+8`aZvGqOLuZ7sW6wO zI{dtZWQ4zl6?-&m1}51D!C2vTxBNbv>W+G9o*nWtI#q%vQ4qOsb*WwCT-25;nc5l` zrMNVhPS*pw-U1{OV|=MCbb@UB6Mf@j1_`u1|DIE_MBO9VcXGc1)kx|5U)&VA5cV!# z1<-?m@c~KA;Rc#tBKni=({F}v>OWKUnZ&G4`~YS2zlgwhzj*zI7ZfFbLK+6Ndv=sq zMbxGz0X065<*960tz)9cu2(?w{M{*Qy=H6G8|aV^iipqqzz-O#)u49ExQ>p{O0GaI zh=j8~Wu*ODQLxkR@-g(~JcaItDkBblGYOcj3$>p@SDro)$n&0D?+l0k3Z&k(D@T9AW zvOX;!oG11+7QXSG=(uMkJ|c2)&N1`SRf_X1%Dj7KOQ)!1@1B}V^cEzBHN!^Kfq2Hm z=nS`j{7CBka+rG^J^BRk z=$6e+v|+))?Y?AeRc{u-#$!0y&^-H*aaEKMF*Hf2jDl0evV|Bu+AFx`H1gZ5=A*I zNkW7IYLyu!9ANyg)j%sC5ViQ$drx9j+H%`@>Sa%;l0_iV20^{zv##nxM}t4JmDBwR zuZH_1gzvp&AKF_v{)T$jbfDGpOxyu9#n-TBzsH0%*n7^y6Yj0Jj`J71#+>+G1LcsA z-H?tVx)JiQUykty&23Q1u9|l+;t@gdMvw?6NmQ7n~k4Tp;YA{6~q*~}AhPid4Sjo6x%^;#g)Fu@n z(?BePEWVn93w1>aSyKq2Ab3ZUN87*?V1U2}2Zs3>#Ts@i?A60R4zjjkr&}%jP^Fz| z5iKPa)j_uF)E?}yl%Yg{E7hAq4>y4GqXSobDruON?(KGMT z4b)n+bS^uHN(mmHta{!|47z&ic(VnU68ikXnEntH_p#r48vK_w%5Md&`=zc3;ZYzJ z-G;c^lNOMc`-P3jbf1>g)kNjgx~zLRQE1sP5nc#N*4$77VNNk5kU_?wN8aY&#@QS) zlo>U9Q)w-xAI>}X&J$W-zfC-$>G=IfGXVRFAAZP;r(^xCyj9n^9gXvP6UgmnoxW?u zH;?h!bYsL$jbY#U#g%#lhm8t14LA!z=s?OWeH z{P0vjCFYN4%;dM~XOX(=LS7t|W_Z?cBHUWS93BFUw2t+<47A)pv-LEvBJUw>_T_N& zfbljur@fp|vdt!}NS}pXs-Qp?#n?3)BCF?82CB7#W>s2Ed9}pRk4kRdv1D%h6ftjhXv45K z6P|Hb#2R-tZxoAq2S9rISx}7+s^C+wr|p!llA?yIxJd5NfDFqP9gB6cP7;b7SiAz4 zp*`}ta^iWe<}N7})%Cg_Ztn5mQLB4~k^bcNGDjQ141X$V+J+%MA?{p2`FZYT@No1c zt%n!)vQ>hL>3UzNa&PH#T8EA>*)1{{^!T?)tk33-okx{{m_%+(ml90io`KT1!6fqd z%k2$rya$WCxKMOaI30}mLhmk-2BlK;Eg0z6h10W+3L}}yz5e+_YypvIRV~XtZ^ofb z!jz!viB&OW{kwQDTzZf-d+e*ehu+yTIM{6^8bO6IkGpQ5E{_R5{be3@p%+Dpsdtx> z!pyjg5!JsY9kECPGin4~qpDf6rOR!@sBy7S$fr-Ku!cQEYb@hwFfpuU+do0+W&ezO?WYf?lhLVI52r@ z^2*A4aMJ3H2=J%&r1 zHobeKLE7T?$-w~G3?Zj0oWOB@f4Hq0Svoi5TpZpFF|7}ByiD|VdM-~>8l0W`n68~eUeQgquC`Cojr>O8 zl7B8a=;0v4wPPQVh9fPdCQOzpIR%yL*|z7O39PlKW-yy+Nh;z>1Ermqd=L4Aa1pY% zl}IcD#m(0F3~`_ovlAW$ z^D3`6>_7;W+^qLHZ{t{^M1xr2Gdxe1jF(pn^1 zxEWY4IDt+*$=aJ}wk^|Wn8<2CV=lt1USa&oE7lyJdXv~X!KZA~h>>n(0{HaaO>|a& zV9#Sr^H`DcE$eN9#%`gAJwm29V{u7q?PR?w1tNAac+{f>hV6TB0L7AKf@BQH;e(X! zk>RKL4e{rPat?NGD*EKy6!C__-9()RTMc>%!jh81iGP6%^tCkL$oKOBJKm}k@Q!cvvSYOlsCppePLhJ4_WUu-65miv|`g{ zXjnbU`BH;X;g(nY7)_hq+BXIb-<7e|GSLfOwYW{H3g-%OYb1?30=E?Q!uT^FxbVme zV)K|%%Q}V3vIBnw;MVg@{(No3QybT{K!rFczWv0G_z^Dm zE3PZDR94u9sg(?bSrr7L&P+}ksI;3?p$g9EvFA~oxsM(WwDcWU<)n=gPu6AzbUpNX6ea>btN;LCo-$hRlF&1=!=O1ktL0$W8c%aWH@0X{kp$s&Ng zC{OnyXdR-|_u1FR09oM8#9mP>Z}Ojumo&UHJ+!a28IfN^V*wI86ZlUv_U#dNIb1u* z3yRYbhlqo!Y$?2`X+}speip#r$Rv-Zrb^e}LB_8?8Bn02O2`r}DP*N~BSSa%@&1IH zK)E1POa08#*){YmV^gl~JRYNn4nvv^pTH=9dx+@m*FP&88V`l1pcAc(iT-YiM6#sa zWT5K2*g?`b(gs>OKu($Qm6GXkL@m2p)8||ba%SJ4D~#9EzeQ7B-B%HgNVwz|7wiv# zB;8ZxBqMKJmtW=g-ukvXg%pTSr91Ka1c}0CW;fru&}W(~&RGIK3w!FN$e=>~OtNX0 zua;~u%-KWGE9+^ovDzO%_n@op5FWr8%&a24w9i&-VBMHhfW7j)9{JwB#AELe3yBzz z;2Hp08NT%txth;y(UD8TENg;;n$Iz@i3rP}!nR#Hoy zN+-FkNxfItDLsQ_i|!$9_pPd=w@Dnkwa6||JJuva;b`(4waRO}+qrKjBCR%&da_Zg z#WkU=GEJ-4F>LxvC6N)kI-CqY*>EF%8aWuiy{2Vvy8GuvYh=WgcANK2{9Em?P>iaE z4pVas4FuEoz|vaTK5uVzIz{L&cT*6pdcv4}qnPKMGPn8$!WT+Z^~+>_F;rM?E}Ln4 z64a^7q2Eb3uGV67m@Vi)!Nsg7_%RMF!rUJ_F4il;o}((C=^ck`0z-v$T61~yPGl|? z;^}NBb(g&84+IMN^>*2>)K&1+>*4pZ()p}!ufgQ}4aRaDKx5ae1eiOYB8Kxq>}6QD zBpvgCAD>jOnhr6AUdbcX@qj+fp6w9>&$8-l(`z7ttQgg_RSDY2D>vFj`F z8JtiUPU`5u8&cF8`~sfr3c$SGYTQH?L%`$y@$c*Zr-7m*`k!6El;r>O)c^PIo1L6= z{+D+}QR4gfTEhnz6cQef&o3rzNEoyB@v3}LUF+4{M0Da4QqDVZC2k`1R2GD)UanwObfKm;z?g=?orsxgP4JXxZlC%w@?F(M?Nu%@R zv+x==g<60KOMB#G+YaUd*#~wpMkLP=B@ZFJ^Ih^nEP6y{K$d4sp+CN;Y{TTjoMM6~ zr9-tm3((mSW(g{X&G}2$hzM<&biO-B|xQ8KcSKrudm});$wM0z3(ca4uwIF!o3vidPq`3 z=fhVnZ@_Uy%W*}hxyBW6$$yO?E^mza`f_u%`T9vbihs9c!JNDPeZJg0!>Rq;a4=s< zyri-Hdg8wQOi4*FgHP$-A^6e#_ZZE;z?2l3%RwqQK5lnVQsT|po+A{3NMsU2@Ou{= zc66J0in?T@ya6|7;7?}=eNX@FsAc3F1BxFZeBL|pvapuXio@fop}mEZ6A|J%&Zse&(Ouq_+T%uG`q8pViw zStV_R@=@XabL2xH1(00N8Pn0;JY~AvmSGz;vFdu+5oHbeT6{8Q>DAz>^=v#*u4E+^ z79pG=AtA94g+ip+DHMz4^TlKS?8X|~&)wDyxfcqtA1-&)&O4sZJGwsqBZ!Juwz1!F zvL6ldU%38T0m?QTg;;w=Mn=XutnJ5tx7Sy=tlzgM;>0T%0ZR5$ij%v520hc9HawXt zK8Aii`)BClE)baC^83)wel&`b?4-7~#@N`=&A!|EecMP$DZo%M?;}K~b44OBm?EKx zcl0k;4d>98EZSEYZf=~rxNM531}W1LBKYJ2pW0%CW7JOF4;J&CS{g-y&)Pd#oWZOj z5j7nY(GcMA7&@~!u~p4?0pH~TD95fX6}O!rRZ*IMP!(fUw~v+Ctct>>pFg(z756v9 z4lOIqL~9m5#kif;8+~x3e~ZEPH$Sm|vlIKF3!)H2Rw+vRiD*{IJhA>3>15QyB~sKw z4g>WFAkh*9kW|A7yX4Sy4LO@6VS=Cm^yVg8$_X8^@NaJJs; zF#e9(48H#g>)%YNeo$bS{1NHi>-WDi_OG=4!1_+ZRY@rcxHQA8z!(65{baM@@i5=| zTLvxv3|$C-X8ya+@9Y=k_VBP{WGtOY|2-dyk}{xpC6$8vkJ*V1E7vr+DR%b-cN9R- zA?r>F>@cBCLEeyh(gJm9ONoWh6BC($4y8k&sSrPot0;*qJiW5E&1iekiq9_n(A0f^ z1Xp>*Fwweteup?cplOMG=(FOu=ZvVB0yhPP&|Nt&+NvfZ5El>#KZ)B!{Rdps!@r>= zp;A!Vz?DytX+J->^5`FSfU5Hs5pHq(Ph!&4^A2My(_?Kc;|hK^Uxv|QlS+o!pTvdP zr!!E`)O?+*uhW3*>N783ZAOdqQK zV8=-PL-pqjnJ|Zgo?Omk%&g`XhXe>trUa&Q;b<--9F3F9*1H!nW6%0lEXCMqgNC@R2!EcTb``&FI))_>DK zNB;@4W}?j*c14(cDI&CJ4LLb5av$-P=fs*v#AcC%X8EM1P!qAg=!b zDZ}rlbop`j|KFsT{OPXJ_pB}BF!=M~>Ae22Q|8d+c>|Yz@Xf1n8Dq33(B`!OS;$W- z?>XT;@fy3`AM6IS7|BND%mAq9R33^pZW@3U3|rbh=Vp7G{+CQ=%i8`Dsx!FlY3*}#c7Z+?Qa*disH6g&~!*nEDh>$wb{tj##r#UU+K6r0sBYI%Fj1D zY?B{ZF?QMoG)eu(Z0v?U|D)IP{STAbSN(7+mvo;6jq6G7zw9W(^|&J7qu5aOc38l6 zSkU~ENDXkkKOFS9-~YWTIj#L`{0WySXuHurn*USQFh-a&GIE`>&;OP}ypl4|$NUyF zjSGKojohqOUpF@1K%#P=WlCS78g^Em%&E@9Juv(bn?$L6i>;g0x>ClmrD`)>ZAa-s z=$klbP?uC8(f6KK7KgR>33?bS)bzDXD_}s482If0uj5 zjK6qk&pkQ|$KENoA!4lCOSgKQp}g2peGfo6u3af95(FbxV$-TdT+B%@_-^ME+lsNM z%|N?a*(7=^rY_bpiJ5Z;R=n`E>|1!jpE-i+4OAix2Nn#=ng?`~$I#Kl(9v(3a-Bz1{z_+@5?O z@pqih{Jv&vVikaOJ<0X)`ZpWK|E#rtoAZ~5u=?h_BSD>N-IxNLGHna*c8)I!_zL?1SDAYkiAY%yluh5Z2KZv)Fh!$3YWNoWbPoG}Z9*Wte1!Z(WAI}Bz|6Ah+?u;zZBJQc8J=VU2cNtZ*A);wQ0?UxeEPRs6agaPrWG;Lq05@{|~tLIB8DDe+zH%-|OK<;g=5*lGB?2|5o7N zxKFsBdv{sFNLU(ezW;C!K5ZYEdSa2Gu#l6PdRFR&sM!X>-pqCE3nZ|1Uw<% z53mpj5bzGA)1~9`IUG2oe;m#pawrsjd>r}f6h0yXflwH*kbk%+uErVtsZSlJtkE zX%d49r8~+U%Qqh1kV5IylBOlzg=zA}K);YK0t9}5hEmB{PNeNknt7W>4&48+i^uHG zghPId(z@oouD9?CRc3ET^au%XSBNgA>!p&Bl7Q%?-Kgrs7`mW4>7Mq}!L>c+zP*fN zfj6*i+twlxV8AamVt_?A5saz+DX)qk8rTXc;`$~7w6oeURDR6}#$(M#eeYh#TO7!^ zSWoCX3k>7Iy38rc;;M^3ry%Ju6q?VLKMQKD+uT8E2Wk(qJ+cEl=C&y#sYv7H9KjDlax3NS+8JxK8Fb#Z|9b(*?(QK8ium zLL>MW@g-iO5MTYh#!_N(Ya!GcTofmDoO-1B-pLh7sTyau*Xhw6D(u8UXAZulUC?SH ztClp{2B*GNU7+}B@;sJ?z6|b#`V3PPMYUA!UK@m^^Al)2Z{#ql#VhVb905BpSZUImyz4)VAC`KOFA^RO<+0B?w;$ zP{nWk0khBZ>kY-sw2|$elam@Zy_Ik_TXVhN8js}o2d+_ADr*OXS%%>l3ZcDtc~h^T z+6fnDVQ6>^wA@35ajc!!fzzp_{k8F5^q^p$&@!9|l;%cg-%yU}8VBh6_QOaoQ-3Nc z%AiPVKKuA7Y9am@w{t{hS+SylFj?|g`uz2Ny;u60x$q3E8YBUEMUKzx|owE>a6BlfqHXdJXXp8|m6Mwo!)ZTfPTu8Q_@b3x2)@3N0 z7h`OC4;&7;SlB{~Ug*=ZsK7pSTmtT2Lu|aUtI@Fnp$XvyURd`(6;p zqM|*Z)!c%egiIQBu76P!WaV=!#16)64OfxaEH8${%|&yJRXJ*wX?-)3ut_=p#i*5D zfU#_Mh}V}f+IOzg(fG1*#}x6PhCz)x2obk`AcQR7fZ{ghi*EnWdcUs6Z&VS)Yhw`? zBnZ}f@u<~|eB3-!D)&lZ!OOymNXsqihJ)E|Woaz z-6gyo2b0;Dk(JqqfaWBQ_e!m{jIZZCkEEdL;kO$HyLZz^P-Wc5TBqYgUTWkOj3D7G zp-%f@khWW=W}M1nV{_`xEu%&^Gz}h!?(wDmOOJ>L^oZyC_QoLIvNhfP;x`usud2*Z zS7TC-I;4A2DYo9r`H`iU9r1a+yE_uTzb+4KBu$$R{U*ZiW}K980bY&4i7 zr&qZ&)8)H~+b3<@xxE}?tmQRNH@{J`E!klwt8(N{F9(kS*31FtYeT}zRV=A>!Ie7q zN`CREY{b;@`G-BP8YirFi5CdtQQ?9KCZXALtJG5|Fk;%Mm#U3Rt2fh=bJiKh?k~L5 zv##BBi`SP_K~egSE^ORq8%x^w(@#ftYVj$!XihUKYcgFbo6RpruvVk3;>C-4r>txi zyXTo4^=orHuSO|}wap!FGK3P1PhF!IOlrcU)G#tushTQhmwi1Z9P&(U?w~2qP~n1o z<@*AiNi>vY^B6A+BPR>u{HX0mwb(gFKbMNzFgbEbz3w_qQ@w^m!<-9P0?|;Oy=u?i z)ML8LChuyY)`mPm#|moVijm`DYd40rRV(e~WUAwmquP03o+=ndWihv$qhXH70`1DI zvpXJ~M6BwXy)wEyX`H#TiS;h>Qu4jBCtloea!7aC7DZm~4xT|eY$;pWA5m7ZcjpW9 z8?pAEdD?qv0vZK*<9qz*e;9YL}z8fWUKC6hTeXCvnP)`VC@_{H34ov*F_t=frg>q?Z-~@hgnCYJbfJr zqb(;jBk)?*r_+8R?4Et(x~hlF(N-xH|V5lx;ENQPzslQ3_ix zw+QYE5|ACTXeatX(E(bQDl_}a$ana>Pz?%8r^m$?Ws&z%pSZ+$LxtVvFNDSfB--_t zq3#@o?B~)Qte%~756hkXJlQqTqj&cRifs#>f+`y*dws?!h8&01(vwb_X_oOg^5?Fu zX!`BbHZ|N6R?;;cxEPl27Au@#ZS|Q6jWf3n?iHEx@8{?Hs8vH+zpR_s+XB28Tj3)W zFu@ccY;vBbdS`^SpC7PeraTTKc)cLA_xnk&+DncPU##m}cq(j%UZSp$gmDh#YvvPh z#1u^T*9;%9VA*JB3NWiLJA@>5F|b(S%+`08Xjf~F8s~DKu`LISox5J}8^_lD7^iI*ZfvVw87#iBH4s**dvHUfCfhzI`s%k=3*AcvW9occ z`6i~-2kzG2EnncZj+^%|?|hlSK0h&$Lz%c@*g7$+k>fF?qlUz+Tu`zD-F9QZL^zP4 zt-n~hZ^iWt=?t}cudWz5;*Fd*NtQTOauO66)@eb$c~Yb3nD4eI)9+B}$=%u7rnb1G zXnSJ&B+eUz`yr>oc+M zug?_D6YZ0sohhI8GG|&9(?M6(hKrI7z83znw8)n;&~|q^eup5vi`Z4#bg9EV|Ag}B zx_{9V`;;A_?Z3HWl_q6)7dV5juq;eTEOdRnnR6l|KF#jD;MlsBC>8djCcw4u+#o|g zV=1(A^@4cK>k6EBW7fj5Is}ZDS_6rC_nLBP=LrL?vmYA=45!g?`lOv4^w2G4Yj~Jf z2Do%ju!3+n2Q1j?Wab4P_=d8sUeaN3rrJxw z=_|Ug?PuiKSpq3F^Ok%FP?BcPH#emxN4Qpm2;tEWl8+?7g~i+xSwIKEnd zt&h=ELbZ-6%>rUYq?tyR=L>#5YmEu3-neiye+DYp{6<_!P^D&<>V+3FJL{tn4Y+~_ zi0X)nh5!@s0eniO9GlO=S!r^H6A&#SkFky&Z~{>zd0<*n+;m1HQ<_%5wG!1S+T|Kw zEEzB>!M<{WHJjPaHOpudYi0eQb-G+5kFu(Ic||lg9*-h_P6hHpT$Pb#>`rv_4vr|@ zuGgNNJ!6TaFDo`I)NPl=re?lcgYbEhJ0NkjDa=eN%f2O<({EFyiCTBDnGXfuDV81H zN>i*#k@3sFzpJBQf8&j3(ho&tA8_nY;}AdiRaaKQI}QqqcwYHB$M^8U#v=r_KKOWZ z{mbnM_j5@<6^ujMb6K3xsVS+W;9y?l^t&-?vLelX!E?mrI$H8%yCLjeN@LAK+hCvmOevJqDF0q%D`#zRIQ#UIb+qEy66S#+2M{=VxT5_}M zuI*KKcBfw8TCI=yO6^xZK?Fs6Ywe=6k;C_>Eyb37&-$!At*3H~S*-!H!oY%y*M{cgT>rT;a?Ge^LPE9ViJgM#4pDY!m;*%p^JzAYM&IYS$ zKfb>+$1-8CU~jvh*_XT2%{Pzg({rR6b>=>Qj-I=#V7|MZ#bt#&FN11IGnh1F*|?X9 z%be$8IdZxmhnwFEbTr;efJuqtK7CL)*_=$fu(z8vxwl*xOIvyMG& z+#G!kYWi|s^jF?xfzeOKzdYaB&?}j=CvCt+%yyMZZ9Fj}dHBz#E`OyS8$XaTRevj; zlhA28rI=b8T|e4KW9YW3Ji2hERaFW8q-u4W@VV3Vwz**4A)&M(QMBIU_3UbEDR8(v zL&j>!Vq*XNLM_jiliqKI^zq@xx)+v;X3n7JK1sPI%79bTJ^yPH{dg6OlLu)9@_u2q zY~aYsR1huv{WUDx@*a87_a9bInI5l(qw^jPwXh`ys48X;&(Mjaqth*__blHqV0dG; zV{y!d6?0EzXo(lL4GikMDDUEZ<*YChV6JL41E3g-mM9C$j}KOmhpSEW5ViHsTd*co z%t7kLmDn_2qm|`(PNpVlgd8j$-oZK~jHzwKoPb#OCB5l~46Zygh*oCSTXPEnikh7! zUB7Iz@~}HEzIHap`?1s4NCphP1lv5hrkoMGYEnXLIT?C-^^kQwa$#4jwi3D#>V zr|o(WIiVGLE!pYYSjWde7RiyAR6NOyTwGb4$Ud*i7)Iijke4`Xg^EN%(A*y=QU7C6`CpCv{{+ye{U}?w-3_tjRNj!cdA@*zTl8?y;D8c zJAXTP&E&P3cyy>3(M@Z;)nb*ZIgPX%c0SFHH`UAv`R1H6(aB3ZDmh~Bi6s)D-}9tv zw~^jE%;;(QAO~e#^9hA>b&zv?VY8)me&>jDt_JDL9rXqtJN0U=_&d z3y0#ht(xL5&JG7Hn5J`cJTICC0y#OxhM&E_Pn{5ZavY8%t^Vh@Xc986H} zeuW^s*wtlAR24g;;WX?IG&Me2KGQn&{p=2s{^Y0<(;nDbdAJAvRHv>?m!c2cwTo0a z=#JrDKC+N1TWNta!gK9qYdZgx5(@2k*=y>pbe;Rs?RYEh(uT&MDHf?$ zbJ26??oLXL8&gJr;9(0lIrDgHgQHO!3WesCq#BHoN}FdP-QC76U*iaawY7a_>vAO! z4xDxCBsY^g^4D7Vl!09-+RC5>k4rPjjND^!vdR-*O+|L5cH7RTCB8GyYT0;3dX#(p z+0ho)d7G;M<)>HJPMN}>n~OU))y#gO@(Q1G?z^7#bncUCE5-ygri**(nKZ~%SfEDy zfFW}W!aVHS^*vI|9q=6OvD4d_{BwTkc89y!RI}&r850t$J&FCM9hH#~cQT6i9pj2^ z59XN}Qn|imUOt*>9;IP7hvDTmJ~O-Tk>c>*2aRrA0P7Z=X%_btWUyEBpnC0QRG73(-2*AtncCDNgg#i3 zSQ6nTG68XI7cH1(@h`q#UjYh11J~%B*F#+%wslikGW&iK%>oe7T`@3`BCM6CLZ5m& zJU#;(b(DC*BXsqd(rid?L4E<3iDCzDpr(ENx-_Xewa?OA-@eRr><4Dd)ZehWq25Sz zW7*tNN)#P<{c7pr2GPB!MiGa7JUh2E5W7ZZddCcAxbR zos@{CCVjWP^$W0|*qG=lFDkDP$5Yu;)D!QK6Gx28velI26&VOYsZ2^|U8R+cixHhBeDjHlti26M-nVZphh+GhLfBFqzSH?wkfT42exBZbVtPk(u+Dbd$SD0`D7A8@Z0iNKnK4T*c>R}+�}(iY zKa+VDKW(iD(r74%-4r`9inv|bJgB_O4sI-nXG^Y42;%wv;3+)GO-YtoW}+iG3P&Noc1)IDn=wmh*%ezPl0`*9XBKTfLXaI%aV@MyZ>FHSaWK6PrN7Mm;uMJedsn-b@DiDp=@+B#+pJ7HxYyTMui z6Duut-#@HHdZCbsZ_73tuNyt#y<#ftX-*D$xOh^B9~j?CrePvdF=s71^;`8qM-2X< zvvIR;T}yFFQikwF$W=x`^`X<_U6~Qr=GVq%Jw;rhY-8`Pcyy%I%&$Ij7ZV!bnSP?a zA;-1zh>Y2^84Q_ zf-cx{W?4+tgm!}Pz?o3I=q zbZ~7@bagH7HF@JHwSF=rRAmH{o(~+lVi_ft()xP(uX(J{o`JpOUHI6AH@Lo;_!VI)K$Fb4`B7mKBP@uA3e2K+_8 z;Iq5Dnj(h#Q2ePm19-{cjt<&muSll(WR@`B-J%MKPIO@?tg6W54YXI_It;sV9t zz1U4?;^*s@fk#s(y?H|X!6xhTPaCGFq08c;Zf0gp-Pa5z+DztFW}&zv;a;gT-#b*m z>cjMQOcohivJL5Y`-*4y1T)Ih3IiTVHI0?6F01#U?f6d7soHUAT*nbm^yEs{)Y;F& zOrAQa=}VPok4v%nIjdE2d>3fc3)o=4z%ZAea0!oAFinGvXF~2|IghTVob}rkv2dz% zz`X7B7>Y3D?{XTpniBv}6{6&V=(+C7Zk`JrnJTS?M0xE6`KjyaS@Ui$Q7<%tNwrzR za37-$^25JVq<5|GmUsBz&^2}{c65fa>4K4pdFjk{*bH#bNF@s>VH-w}K5(5@5RZ=W zXy~+s`UY$VKH9J#$hp2yFIx3PD|qhPHfsVj^0cZBPFIkhZGdF@C!E6Xqo5@@^zHPB z7nY+4rhj5B7TJsj1@Od6_e5|!TV=E2_akXhObI#wfm7w5tw_|?|H{C#X9eM~l(*L~ z|LRbIn1^tYTV!E9NxPj%qwxf_GMH@Q1}nQT6T|eddOO6ETW`Cv@1X@2pzGRfrA7a= zO;&xwlG=;?&>ys?z2es;IDTj(fg_A_;7r#Nxap?=Md%-9fa3cmduPuf^j$&GIiXLbZ@HaG ztjIHtS^>cv;};mXj%1TS8Cn?(0gOf4=W&^2t( zj|3&Hz!4zx)u_+)V{s*-4mmwG8J^_QBihm;TS;lyiq_MsUhgJ*K*%VwM{Qjktu%74 zFfXDELR}&w^~o=!*YOilEu|=7N<*}YDwC&U(KeW;R~;?Wkja=pCS%yE6F2dh(&alp zCPaAp^N8mNg@9kF6yK2O^TYr?e+I**qF9@bx;d+!EFw=g*HV2$wD1&2VBZ-?>@h!m z#1&;JCs^Jkz5Dq2BV>-Xvk;ImGC9H`m$75cHyb&Fn`+W^L6aKa2==FjGAHL<1!~-Q zx;JjxlOKB3A>YO%3HOr;hA#?!3P;vBECWyw^!YH62JSF8TM%8;g6*xNZi=t1C^}N8 zsxZoGp?#&PSnR49nU1#`pp}4OXvi!Az>nyELXB*U+bWqW>Gd2uBS~}WIH+xiG{K17 zc$|K(_F%=^vSU}yth>eH%~qz?REf@C?emIoS75ZIxq~d0y6Z~Cytq6WN+%oC#n1HV z*1D&-q1)W?aQZCfP@f73^cT@j*WTCHEGv$BSE01HdIVB2uG4@M&(S8^}g!Ty1 z3G&Xc;2d5I``wZ3Fb>pi6%TI71guE4K`w*HDc8h!#kv~Obo~FI?JJ=2>Xk)5+}))( z6f5rT4#nM_;_gmyrxbU0cX#*V?(P(qM}Iy4UFY3<&s*z-kZ&@XNhaAd**kkpvNd_t zSr|dlb46|&9is3%@!9t;SYN{RfkM%IB7JU{jd?t5D@7*;u=kX^#LaADa6nX?T~K75 zX3^o!k6IkQ)$Tc+enB8PkU>idrRaX&M@ZM3J6T28jt>F~qZZMNeC$+(ROkbu`J`1a z*I%0ZsbZ4W?&0!zy_-?91+N?Y${_wGglqn4zc#|PO>+;U&MS=T;bgq*vA+QK(`X1` z%K~FQEW#T4k4q&CUOxl~oW)gn*3CO7#sjVZ5fB>5gie?EF*T%JAO?f{vVHK*5Kz|n z@sKqjTWxr5HQFIYF17_BcSIsWh}(>x!F9s2B16e0xb}_#-EpZD_vI=k8Ps*bnJ8#< z!(;)gVrohPMHgqIcbeVbJAu9$h$U%24&b0)e15D815X6S6$MjYL^#AVrD?i(@&sG* z4xf8_;qf5<_)W22CIphWNvxBd7KDzEowfFJAv5k?TOsAnHR=-(`@%LIBYtzcb@A2s z{XzFYeAsiEGIv$P{S%SEdk_l_eibD86&Qd0{~m}Lej)yYl=k)IbbHNO|El5s98ZUF zY`1kyc}OL7B+28LRNJ1$=(;rCb+jpAyjp3WVNZwSzbiUkUAxnAu4#S~nSQ#`TxWM> zd6<)E-P0V|SEIa6vZqZmEEzW%ZFh{VU{7H9-xRTqtR0u%I%`|fc94!;C&XF*_cfF^ zkBl5AeUg87l#W-TR8lNzcTStvsA;}7^L(IHK`zddD2}HrRxB=({|6{}&NzJR^m{8u zTkmX2f7kFYpy!^emeu(2Sl-=Eo94f-=^e}2a@9PVHlMO})tXQe@-OWF01KSGRMg_$ z1@m(KhhPeE<$2DYu3FkM@9jM7G}Z0Lr*Kwq<~^Wro|g>OtxZ2gaUOS2l`gIqb7QQh z{cKx(+dnxb_|+nBWO zsV!Z8o3J8v-d;gA?=E>p=De;FXWo`~hr;?N#u|g6fx;byH7rTvTU$s<-)PyecJJ8M zp7JiO!34+o@G*eS%-u!cT z+1ZEQ<^5N?BL3an7=D@F?*{n4OBrt5oTIo8E)QGRxYBimcUsr%ehtx|&Hu-88}t{H zH?O0+Ofbxy^Vn-%AMTgC?5DHuN4jpO{|?Cgtrz0I5AlDd7bvNzJNqAhjez6OdQSYi zIZ=52abf@8rGD3lQM;!0NLS~B>mk<_w~z9BkL+qJEr03E|9jOPzbl)z#k-+4wcA}; zI{#OF{Lkwi@N!&_pR+h?U6ec@@`@jS!5vGRPkOh5|Aj{Vcb62;?GIsp&2W#>?^B%n zcu@`QyY;LbrC_ycj*S;p{m&WgYjcjW_>|vfY3JQ@lhoXB3cURA8%V`(-S`tVp|+%uhb}$sf~mu2(_T36;#YnmsJ_MX0{Bq@w$aMpbTj?CQ&NoE zW!t$IYuj@)*TePxM2wQsKlVu>=;-Lk{tJffH*cxG5D-y#TrPN-4u2uu0bG~M?Eznn zma^4f;rch1!C#*A{}SJwGkpMnUv%$3e+9R5_w|T#-M{jHcR%jGGyfw5(x(#I@N0L# z(eJ)otx7J%|761Rc<G{{U#j`D?3cf>Hpk(+HgKh^-SYj32Ee_)yn7F8 zztkfG&-qs)cXhw}y=lG^{V{@nk-u+Z`3wG^0R%K{%Aad@9XM+n{~!kX&$|9M@4Nft zf0YU1w+{d2rTc4x#_yNoZ;pQt{p#|s4)gH+S^i61f2sTRub;oL0FaG#m8EBdg2C&7 zk!SC!YaOgBo{8P&%d7RW7n4~Y?*aUXm!P31+HVh2NL^DUBcdXF;@p)MPTF97{R={4 zN{Q90Z!=d(%hWH_ZHcLKk8fq~$6u+vQPeqWY!j@?2YKH=FF3*n)f^seX0GT1n_9Jp zf9+749(J~%fGmVeq%p$;^Sv1@x$Tv_SAu8R9XHh0RYrV21ddO@c)G!Rx;V|DmPqr* z&Ka7cn)H(vXl;LTv_^crN}}A)#-A~(S}Pd&^=$K3 zzz|-=aL}4^7G4qhPl7xKKu%EtQXl5NnDo>)RzhobORfBN6-oJQN#KCbY7z~SfT{WY ztS`TkCHd&)h(S7{!qhrMGds!)B?7eZIw0BBR=g4sZI&|R&yic=B(Z;M z&Yy|}fcgviCvetM!JG5L^_NY#OF9=0{#SA<7P^U4pu24v66F@utS}!syyy^%x z`kh({660Hyar`ERa-e{=8a1RgB`FLG6=Iph@Nua?9Tio174(nN^5$MDhPlYR+A!50qe?;nfLi=DoMQ{Qkp~k{$ z01D7k;Qq(Jpl4c7>dUEf8tB4yoaa5RpsnMEcOSF)zU7qFQ50sT-4K8f8#tzIFd~8I zfwOv8s~^0WOBY9^fP<3KuLRN_9e+e>)Q~X|KkyZw!o?a7m!Xf?tv9 zqL+3%C8XS-dlO$|>g|1tDZ=1rMOsELG%*Mi^AT4g4gv;k`G`kNV6Y`YIm;4_hnH1p zZzH;E+VS<_%eC6@tVBJQpmM|MMbhVviSH5lCboWs8B!sb(V<0jrBW05oQEr4bVg$M=~Y7D)m?4k}OyRz9zG(6&>lF&t%qLfzJGm=IrksApl zVaZ|s?7~>!U?C#Pd2x`I+X>N=w0%r95F&xILp~Sif{x+4$2jQ=uX#yOJn&TkS)~}< z3ck|r)6`e>8H?ptt`%R=EiWqJmY)hgnL_qPA2g@n(SVKfb|8SX7 zPj7!72va4VPe+tZ^I;K8Gy$=r+}8{u0szGXJ6e>Im1N)NaAx2VR;ELxRP*!sMs9JyH%pq9#va4Pr$hsR}w{(Y<(>i2s zT$A)&assl-Rq*BRW%!iaHd=~FsRuH&R=T)YKt2~tP=8TV+(&k<7rb*_Lk$2xgao>$ zv$0*6JQa}T3l52KA`qZx>X;1VfIi9d;yDZq=c@RLjWmXjaqxD5K4G$VRiiIKjQ9NBRLx2$RU0;zP0|Z(e zw?;i03+pLEZsPcozs+lwHgBGKs)`!NPa~O;mK#m`39P>?1ScCiO1=D zjDr@2@YH)EsxZImF7Z3QnI`fVh0^i-Z$T3*(q6SDl!7?USv*rF7!XEP{ zNfK6Ep1s3Nrbb;zs7)lnJukPn%-|T==^OjXN?stNF@N{kAJr8-)wr=3KZzR+0ljRK!kv^=i$M?RPF4G-lUIppx4};LGhtYXiYrj(ZbjHml4fGZDup#}dC^#~UQ)a-DjPQR~D`>mYflgoSg=Y{w`R#6n&j z+PWzu>^j@FTRLdZ_PK*}JOO`rEK;n!v0;AH1Cjb1(fiZ-Yq9pQhl#iyCorHwF8;Yl zE)=u)qeduS&r!a+5q~~{o{avF4VMZNq^LH;EnUAv@ErQ&))wlb;oLdNVU(z8?S}=x zHo%QFU8Q=7u?`D>hU?=L3W5mW1A?oGUqS=|R?i>Ec%i2VchIWEksig|#7e8+Y+nra zrjdYw^@@e`=?}gkz}!GtN>ko`YHS!>XikUe+-Wa#7&+Rp6G)Gub8jVGeDe4t$tyK7 zdW#*N@DyVs9R>;+TsIT)4H1!PUH1d_D+a)7qqT|>gadD$kw8~`t<}PRkE+< z)jp>dIj5MVVMQfph9PXi#<&M}kZ}aVZ#I}d#;+Aa`)ea2q)47B4KKx2?zo(A&+40a z4OFZvO6b+9w=;`2fl1Q_J;NFhhv7tGsd~lLf@eIFQB|%f3u3(Dr8ABa9Q21R+IN8e zX1u?W!-tfL*7C4;x4K^@{2PI^V}kH-^`CYemft**y{q0v0AT%@(REJ&0AM=-Aanr0C;-6tcLw;^or8iIO((P{ zvy4M5*ac{qP}@bD51N#_(%9%;u_V*E6#g_|`miorbGegOS^pcr%Dv zTz&eG)Lz>lhLQD`vHamHYiP3CFy_Sx@*{$JjQoJGQmN3epFs@`DW7J2Wp|9zsOZ7< z=^3M$ePQ$|XCLgBB*{yR?rj+J>QJ>3B{F0G=nd!UZ<7~6EYy3X&h-Df(mxogs6HnD z(|_LpyuyVYk4xcV5S}-qxq~JxmgbSF+15R6!1;2rr(PT8RMWZqN8og1OAj8%GV2V7 z_qfNh$?c*S?S4eW92!ksOWBA%+&K?XhBsFs$mkJVF^;+)q>2!#$_e4^6IIap3HTel z2#`GGork?-ai@zd>S!XQI=>tX^-C_8K#L{sH#Aak0L&q}8XF@ocn1(EA4j!cDU@c8 zo8Jiq%uDA9P6C|q5@rG$wGHQt_qXrQ!=Jhw+*sZ+jUJFm3QtHHr#V-?ED!;J!*%DH z31BHYf%3hMcYeSA!c+Eb>VIASg0Q{|9SFw+j&_6@<@YDpU{GPzO!F1dmsF#{g-}Y? z%E|u6PUy%D$~@`ag_Li|{66wfq<`uX&xqrugJwzhU$y;qQ`r39D$~5$JM&-nnr8EN zwNpwE?)~FlBt}vS5mxtUx!>Arap4;8GZ+rY5)qJge&CHjPM(6l|3t>ZbD}ts#ujrV z>O)nxXZNCBgBkA8X5hH0wKUezmpFg(^be>R)bZD zV6S@o;pKwPJ*6pkfFckXp3NV20*yXD-Dn0-rW(4gU5_SrPIp4^Fe?D|BkdAjv;Fri zqpd~2+Xmje3jCXQ7?R6psH7a4KmvJLF-B~}N`_W<7ziji>j1eh(5Tu7u6g>ZeiYd# zhx{a%5Yv8t*rtOP_XkIp=8N~9{>v~8IBp$xA2g|a{c~V3K7W`GtANSg)&BFEIcRY? zYtyvSgvGmP{jRdVrFkM_dp#r9uoQY0LWFiEcO26=S=EcR+Q~*pq8{03iXakdNHQOD z0dJb%A7XcfX=mHmk=P1J`~h1=f47A(W7oPC-wDiE+2eBO9GbOv{bm0SU2A1t0->AF z$kv^YsDp@;*h7xQ{4ihzhV)<)w}r}Bv_84<(f0BScxA*y@8-+IH*W8Ytu@Y7{qnO& z65NH%JGvc`jaF}59PB>048Cs_kFNl0K4GYPYT7eb-)D^q5Nu6-0GdSEc1sHu9giw2+; zyGW4ve~UEE`+pA=xAc7b`$)M-{_z;oOp^iR_zLz%k2TNh%A>_W|BNo79XhtF3TK?0 zsPptSDlQddU56_o{@(*!)_;kyY*~BpI}!4~r+t5; zx5o1KBH#R9npxKPm(0@NG?w*qodBS^3mrRd1mf2wBXGM)yL5zVhZyfhXC zCW}d@D}@QQPKSv=<}ida>yQ+q141(geZ+qM3-#s~Lj@?D3MpmMD~gGULm@+l#-Ldh zt|x}?t^2nFTs;H%8u=O=R!Lx53t~N3%muN=zLdz~oWK@(TF*4vc-<`&_`ix0KXWBE zM%`pcBJ#>OS7Yi8X4YTswua`cPef6jqZth1RQm|DK6(uKfh8QSp|V)EtSt9yTCI?& znDXVVs*%X^!(#FgP9c7Ue1AkWG(Hzzb^m3-J%3MU?sfAm?@H*w@!RZp_)Fh1=ts0~ zxMeM!SW&sX8Za@(i#XJpoZ8N&#=Q-C&v;4u&{Dv`+Ow?u+DD{Rp3 zZ1Box3l;3$f{a~i+rGnVI5n#x((IijegCm{`8?;*K526VSpeS!bo?+ju&Xll5?=Xp zIZAl-E!>WLA=QvKxn-r2(BQJNWs}jB0#bs1%kUE$x7crt3Yz0AD0jmYLr)n;UnwL|7e8 zzBop?xVQ-IOYv_&-g}vB@s&?D<}g|`#{Hdo3 zaKRcnSp!bya>M;CbrGx+2~M1gIt3CxyFe!)CW4@BnA#GWL}%M46bow-6J;QG=p55Z!i8e9RJ4Aa$gSpq`kfe)3gONPE2h zIrzBL7nCUfW5B2G`yq^B*AxPdMQlGPLmxI@$;9qLEj&KDyAo!um=hu)kh-=)`}KuB zjwikk6Ak+*IhYhvN>@z+OLfm0gwCPdI%<_Kl<0yOtNPj*6e*??l5sfak9g2FJ#oZ) zFMz3aPE@_0=-WG1uf0`oKZC~vb?W_8B)MCAbOaK(OiXmY*~W`j@DX3%*P?SCm_qvWvUHY&$Hb8|vsfc0JPD#n!C{|6qzW|C-$8FwFsA%O}9( zi2jZpfHfwa!VsmuIF>##@9B%>Ce{ROddUzOx63<<)iq(hHulr2*<~_(F|i$?=^&&R zeAOoZ!?pz8|vz1`>lg>^?A%^qN#vAUE#pA!9FMEl;?WQgB$E$A{XG|k9-$7O*OB~$lt7oz+S+bZzyA% z7fI#h(yB6L#LU5}NA%hN>Nlsq?%aO!ca;qQH6WzF#Ca=nzgaLFuO&a-P|hpN>zQLZ znp>VrVDzuK!n7{l#P_V)Ou|)8tEl=qQ1&6bl5O@P+2D0a5}H|TkngyO=;+{}#PjZ| zlUR%F=ygF?pPII)fBbszS^QEB0~yK7$-aORL!Y3LH%AG9NP~`OR{N4gprG~BXPbT%u$2pIio^~ZKg+V&I9aCtPk08-iEW6XeP{96pxxZzlJ#u<;P^yK*N$mwcPv`{$Gb915N-sWL#SI- zw|<`}-gS&*`w!eh@B;NeVjnO9gC) z@rb-?5mo~H;N#@Mk@h6lxNw2iLx@8h>tu3P7bXINvaoW1VRNjygxo`PI||EAJ$9*<8zox5dB8oTC? zHBTZ##v7{>P5)rfRQG~9f`T2*SE==JSE#pseWrP$wClV0ey2u;;}r&R3Uzy&U0q^e zStG)ST4+?UIs7&A`$tOJ%`Y^ao-jrQzHgwp=Oodd1YQR@mtbw$y^G-U ziW{pD^~JL0os}IBEdJ5v7EayN#1abyaoP#?DzLlX{Pt{=uwb&(GF6U?zs-(L>TEQq zg*f2Hj7n_bkh-@L!rQt}%EqE}=tsV*#0A`luX?!$e90Y`4sJg(MChTL2bnSW-8~x} z3_m>sP9a|(z;qQaXHu_WDndR(VStO+;uo_nZVoPNAP-x3(LapGZQ$FflPkMFx|92J z$EAeQI?}ViBHX|lTMm1_X!b%R98!|%S+f7bc+!-IQmawVK2^mt?ny^_u7K_?JBo-? zHT(QFL;$^fDMhQ}xBDPs22oU+$k1%sqY_N!;q{v}tflSVdUCfp|0)jPQO286I^Gb^ zgc!%ufYbn&63~PpCg~0QMJcFt%bil@{uD)p!xV13JZ@#?G@Fn;3Wep>tZtnHNWkde zQn1B~5u!Kk<@?u0@X0td+<`(XN2{EVu~P8vC?7@0EnCnvgP+rNc{FkZ+}wzc8H4yZ z#UIO)lj^XH`={kuY+OYO=sM!NWJy4XvblGPy9>d#ro`H7u-$)pcp?OQsmJoJZ zGCJCqxSOeqh)H0}a(=njPSnVKF@i`62=Sy8T(mwk`S5lW1LOwQnRM)2>I8~ea8IJ( zs{Mq1kN7n-6xO>U{wFJWcC>#z>(NN|s&oZj#iT~-XcTrA_tdd<5eXfzbDDd^)R+5! zMY2V=#s%&J?oMhg2h*Ouh_P8&GrMz}9I(I;O zRJeynv-*{wGWOrLT(4;2wZwfH>)qAT1No8`c9guRihEJ2A=lmX38Y;@0sCd}GME^H ztYEe|QI|)Tz7=>QPPHR2YO8n}&4m8z%2j-x?3~B@YA{cCpkP5%5#A~7>&fS-tq53U z+&ZtR!5p1G;4oKxd?kZSmZ~h*8%y?oB-@i-epehJl5kJ5T2kGN>B)1|_h{rMn)ib;pXTVdxhxYQ zXIuN`YAk1=w@A%Bz8s}$+H;rTVBN=sLzEfdd2RfhzyapJAK00y)w}5OCyqzgIckg{ zDm*k&uxsaN!DxgjVxKH<5z#!LDM_pW_|WwYM=_@E~6=uA3sP(se&- z4B&2z12{#2KGWaF(!Q|jpQ8$`YtB&_G4{@?eROtqsm#V2&nNofbs+&E?$&1-qU0+v z+zu(NONV`1HC6-!W1?;uoIO=CBfjHpFXmy0d25x^%fuBc96Ybr6B20p^=v%ub6F|4 zVq!zVy3-*LthItB({R|fa0)(H-V)u|6#LJS%e9BXB%#5O_8sn^8|yuToFbQlfd*i> zRuElS+fCDZ?yxVD#9Q!b%OLMZj@T~RK)7Xx6^4mRFgRzj3E+tKo+zoZ1vQu|dD)0r zIWSVTD-h3q-eGn&>PQpQTaoP;LEy=aDeuDn(DS^jtI`}%)xNcxZ1icPw?5=ac3e16 zsNS4__4_QIqJ9`vuWxnT0{kL!u%JUzQ@8+w0{niPE*2h&9H1%T# zD+B&6(u>TXskt__-WE5Qz2-3*KdNb92B@ZclMsiNPxoy_^i=KyE3jrdGLW{Xkpa|G z^5qhI@1x=9fGM2*tBW;$+$rFItC}OLm0%}5Y%3B48wv*csjJcFBPPCSSs!AdgC*h} zMu(BlHc2yVy6g>W7+2|#d<#JrWbo2J-;E+zztn*Cjj7BEG$(?;%NKUm*0C{A*$wn; zn@x?2s@SDCWY7zW)Uh5165dN@ zmOVu{L5O^J1K!ODfG!{A~yYI)hV+~HnD#mFSgK(TBDv{`4{Q&uV+OF{tmN4+uy}PYH`Z+Xn?5=ej zL~@S{ogitflU>i#k~ky|U)V3T6>BJI&A&|CG3^4F_hMYIkDk462AGd|d|JJuywsS` z591(w6M-s?O`A@on${Cq>P|Dn`~5RBGNB}4oPd=kN(67jr$dfquAk zw!iFE9L?%pgLx_B5`CXD1%vi{*n-qvv#eymxxu}P<1G_0@V)) zBhC^5k9MJ$1Aj8(#x6L)UVN0Qf1{`I!|v6t9U1LFE|t0DUK5{hE$d4$t>X0qrmru% zAWYlkX=N>bai6-3keCk>tpR)N)q#!kiXcZ1!;LQfBu(B*N=vs#Ja4caybW@r@rb<2 zV*5sr)vQ5MhitvzfA1ciCX=eDu054+Oc-wB)F2Q=rV)f~(DfCD#!%;C;K{#P{{ZC1 zN{x4;|7mMDQiE3-A8|0twvBJ~AzV zgt82;%10b|c4II|jRU^t>a^CpjW=wjw#-7iyA_E;7Y~s(1)^iCq0ejk?%c*R8 zP<%}o$GNLX`A$D1D3m4nw#vm}U|U!-aD~I9(n>c<;WxgqpSv~JL+hL{%#b6l9mxmA zA$W&=fP2LlrdcC>OrOl4ZCanL%~Wc$ty{fFmQb{crg6;!7~A*xRL~d&4z-4Hu5y7v zjLMIDNE?=!wM%8H<6A_9$gFPV8Q07Qap;Zn#W!Hvde%}|L&4>H10(AlD?$HJZcazr(G&MzrI zaFUs5r3!Nv&7^J*V;%Pjk@lw)`|!GVh@ph7`}lRt#HlN=TJPIbhnCTxhD=i>e7CUd z3+-S-VC)u>-5r|Pu7{}SonI&sG-4R*R+8)NPTN~fJW1(~xtQCf%AUos25n+eo<$VP zO|{U|AXm9Av!v(XiDa(MEEcze5VS0S$uz}k+S>>FC5>lEyeDh z8ExMs#aJw>pixVmwj@+%IOvi3QRzXch*~`SDpdn-P?3eo4^OuEfd+o3ZSf>ZP8Dg) z6+u@i^yifh%2qA9#i8#zOF2ZoxJ;yX7aSU1_Z^1he7RWOrK?r&9F8%Q%l;|IL5XCB zn=+3?XBl+v_Esf8RU!N8IV-p(fip??+SpDT(*mY1h+OS~MsV7UU0O$ntk~}GOy7(7 zh%lasd}$U)leK;c-7ycQYq%|LuH;1D)Xn_A%=V1SZo^WtOH7G$+z16oa8O zm(dpKC(Hfs%mY+-Y{BNd166*I-^@GDOy;T%adoXIlhJlQ9xI#aFvE{&8`s-6F}$!Q z-X4b7!QOp^cseSPjZw9NC)`onqs>8!9CPA}gT*?SU^G-Ngg&o4&(+CZ#Lgj`>0)@M zYA=^JwWn7)%sn$MTRr!}0P7?f%Z$Y4dtUqTA#y&cFK!EG@z^KJPW1bS6naVz*I{#y z<(o!c7o5DyG_5+VGbmS1L__w5Nf{4)DsV#!OOZLu?d6*N37W=|6)+QrQ!`UdMsgKw z%9%W*l)Q2iw$KS_R6^tOXi9w+Q784J`AIEzIQDa=RU)>v@80a|G}KW;*W);>_y;4r z0}?*xTLXdasCh&No{V<^I2hPd;BYuZh~E5l&^16I2OJDq!%4g-<@bV`HB6c1jd%Mw!TECHwvB)bQ*l7r6f^LtzstBS(rlh zW-}PqS8oO*0PSc0&@pqaN-y@#GJ2Ne^3O%z&hpQ~OhWy_+yXcyDy#{$D3A`SOzY#> z&rmsOa#~li2h6krXp0>K3nA`2 zS_!Wa#2lG{q-^LPQuKZh%|(Mqjy`Uhv&Vn_E`SH)wQD*e)vdq{#+nnjFRArL0`#4e zQBKmJ;sxP(C3)}~)ksa>o2#S`CE-R@(E4k1++JXkb7xVfP5E1qg^K~}%m(6!J|aBo zd`z_4w~Eekymri|sHH=*U^w%}iKtSMa>f^xYu04f;`8yvn}?PSvHGeKZ|_W04V;3K zdHXrs?1R^BLCssTQS8Uo&Y$B0=P@`eQ){%s zF<~%JaLRXLH`T)+Dxag`3Lw>lB8!AMnYus|Rig0SrJIKn@Hd3lnMooCq17WI`$Y9O zti5+zs|Xu(f+`b^KsiE9^dl_TTeL$$H`_pfTA&Sq?VZu?MZdicZUM=bDBPHjdGe^5 zY2`Pl$y%^VZxuM{jwrBVUk9>jdpFCDSYEsFIG@SgbJ$S9xuTSJYr->-b9E7bd4oJeJQj&|M5!?MjwT%M#7*9pB$bI~! zcAzBe;#1HR*_Ur-s<=jWFN0A2LBewTXTsk6PY4<(6EH}3z%sI`xn&+|<|Qr2FglLa ztximbYcOY&^)PD8q~HgQ<;7imrsueA3aP=`hWEK(89_O#4TvW@J^>l-Kf6DB?27=I zT5&NDs=0f?Ak(WQO|@q<(OtqH7z4FiwwWaqATd zz0lrb4^hQ_$F}BmkD5Y0Z&YoCLEXS<=}*2cgcB>blOAKqXCpY_G$RRPiC*Ty*6Rym z3hoI-qK!PF`cC!Y7^9lrPu6@sme(MUQl+?87%%g$tgbJ`rgETegm9m!TwjhjL%^!O zg=6n(=dYjAwRTa9qvDN}(d)7X$j}5NJ(NXCHW$xqE5NkLP@EB5%NU1E<)&sMJkv0@wO;L{#Js0j!lhTYWm>&|&>$2&su^WUO^KPw|yvoUa5%G)tmO4;x5 zeVz-c$0~DQC%W>|<)%*DB$l8DuRJKfQ{fmvvEC{><$rpupL^IVSzKQ&ZHiW1Y@Ry< zCp%XIL;{dv4oLy@x{ISvpF>1`KW7iSf>z6})uZ<;lRXhwRX=FCEx9C--bB1$i)RRfL$(Vsay{*l~2dT{%^)Y2d^!+39dx95Yy;XU%yACR{PWs;( zh?=r6){tCngWzANI#dq80OeMBCF9rUR$U?8O?p$p^}ICSlXJ22$ay&}XF&s|A3tnJ zmC1sb1-k-;OqVKWg)YY=c+!F+yAMyX(xg}>4|ophpli7z`L)Cbm=N*2NfRSbCBT)z zS`SAA-{rCsD^X5`ndFI-vF4mcCt{L}z@;eo8UCdv)4E z!D}*42RACFT*HXoOAFSubL2EvS>THLoXN}ES+!Od;InvQqP6q5DsHqXQD2U=V2>x9 zqVvFL`OR*4o{oh?N>#fOq~Oqz{eF6$xd{A8ZOw<2f^?H?8RZTNF>PEv6IMCK^#W+S zJTI~Pi}BD_h=iae48w$F{55w;IUd^d?U>SaTTz^6Y|7IYhac}RGtIs9Dw6uJdo^@P zP-um5tHL24iI~hziwv>`u(3Xo){F3PtGL6R4c%VVO(vIWdmShPTYj0tlRkSbOR7AW z$6z7S(i!|lnJ+1H5ivvU+jQG=FJA0~BwvJP7#|b7Cr(s3eD5~tg%v*-k-Lam9}3g= zLm?AE(;M8vw$FaH@Z0^Q&nl^=7t=->vhExc0jh<@cjQ1r7*t+-J zsJCKCTDeWGh$owKIi-l)U#cm9#te43VA}EedQiMNjRO@31--0s`#9+LnGw+3%NPTp zdV{Z{K4i}K%n9{g*ISH?P_MSkBKwIBfVol40|d;ST0QqebLx@Am=<*O9vvpYtwWFG z?eMtQ$3;?oGL4OMrqMKU3;JbyFX1+#2o+2nohwf0pHsuY(VtXcK6QHFXoC^f*>}%^ zT%4zTE2iGvd3_W?J(=ARWy1C%dI{FU;A@sWaL{gu@Id(S88fx52hH$>M~IhR;3nAS z3i>Td{t+QsAjE?sYFzB6MT*A!{%M2{PKO?K-3N;%2gMf(!Z?(2=m1$T-Cug{LQE`!2Rdej_4=!hAq z7g&kes|PM^nzKs7Z&_*|SxfFM`Iv_#XX`C}mhd7&s+frK^nDUTrp7jq;bzr@1lKuV z5XH!OSg!c#IxT9L>JPe+YCnCAXzL&U#yMpx`mj8sEEE+uACdS?s&g_k#8xT3?5nHT zn*0fr^E|`y#I(^a> z;IXIa;X(@Y3!r81KP)76ocZ*96*y4(-0*fqI~}ZGqLT?P;!8gOW68!Q4aAL=2C)dc zi#nBZ$aOBzBbT&X;U=_HGS&4UyRl=1gc-C00vyB|wqqluXKFg>e)@fY0L7W`Dx@Zd zi=d5{Zf$nl5?C^{zVdiw{rR~`%};}cE7%7bR){Yv900Hz;N{%&NzXUV3tC5F#PYW@ zx2*2@?n4iu!MyQEFQ#ad*<|KRSaihavgGxYY}wimEY&3u znIdPX&(u2Ed^BLn1+fTR_6GrVQ68NWK~ikoUcwPn&+K9P;Y414Ch!)O_5#JhT2gBjU`19_W>be(n zFO<-d=)1}uNxiZ!_U#lGxmT!Yp%T6x#7MXImMNC&wMi-ioTcm5j{}*${RYS_lbNl& zi!C8u$i6I2Rj5f!zp4edm^G$h3o=klCvSES0|n|W7M5biJbS!(EdC9FSA0lya|U=b z&@c_z>b;MY#%>JWmFTc4=XM1p_;INEU2TlvoS1Yt$E!S0D?~@Wtzr{zuvQqj(9!$vZ6qhrdiZaBWNJ{9KzY!)_mP<1k+F@M@nrIk1Q4K|o&Hrlsw znf@USX?vdRLCmOQyS-}$q$c!%DZmmT!RtU9t_gq|?U}1k?6$q3D{BWjLTvnI)QQ}F zS^5wXYxKQeC%{LwSd*w!5@pFtqSZG?pRLvWpUJ#c>{k8xt3yX8X})9wPSYO-RN*x z^2A_Bo-7>qNOJS31>9TF*LH^s^<-H!s&3NYsVW=23#Fj;?a+hFLwj~1h*tqBO~Ldq z7nsy}$q$Za@@`DrOc`Y#>XhqGwjp#rwi(gap|Z9#I3w5M38w1W9EC^1sXI?8OqaWA zn!LO$eGBeGE$y2Hxq+;*`#7o_x%mhcf3; zTkHkFL+jLJ`efB?ia&P^QZYoqeb1ahwP3{wt;8YLeA2s53iE8 zUi-XzdaY5L3y$Y$o1No~n~Q|Sc&5G^VA9(3=@)f419`0rb2=R(*~-=$6f*%ZV~wiHuJQIf%pg zl{!dL#XfGW**q5-U>58As18TZ#%k6$Qe3P@V7`k{`?xaqCa?I?5h!Fu9$1FrGueC* zk*)r`t>=w&Flos%gGjPl=Cko4DyisD0phqeCl11NEzRoUb5*GPAj`fJYLQ%rsMyTT z6%+KSW*Fdgx33k~f@Z^oZ{r!Ko&|SN%(^y8b%vD^L?L|oLqDgzt*~@<2n?+>p9T@K z@UkYqAyWahc@gs>-?@;a-+ma%UMIs(_MvOs!elww7%Uw_r}wN?Q(-ZW+o&rMh;N4w zyk3vi3^6gKk?J%#FD){Wq!V}8J;aLEFecDfr$kx>cBi}h6R28u`;Rnhe`pU~7 z=Q}2=!z}@!`;y&p*I7avfq;z zTA1RLM}iDFh0pvEjh2?avgb}`nFXIvz&1k0jP0}V8g^B1sQ~>Fvr!-8IDJjM_~zF) zB+c|(0#)17tRHz4PB{VoJ9K?WCId9H-;}{}&}%PkNygwpM-~EZAC=KRux&Jh@vecw zZf05Oh4mZ_R`>xaV`>OM_7mhV!C;tg7lx*%8<=XTGy}lw6Hrz*i_t+%c2*;c>FCa| zlfHuifzjXNb}mpr4t~Zc4V$3W!b>;kmh4j2-X9?`dtk*%NDd6T`ywn`;_Kx*585>R|Sv9&Y|{)la+Ougq6;~5i7=#PcTuK44ENAJ88Me@aKyWUzfwz;6sK$ z-G>P4hRl-w=&=ndpa#^tK;~u7IQR0EI<7KBS_E%IM_jGO)(F;u+AgMZbkp`H+Diw? zfiThwDYe^T)9FP7yK^w~FU|SyLxY zZcbt?28Hd2SAhg|4zpl$n_@>pmQfu!f%Dm_qeF69Y>N>Y{&tUMTPd-=Ai#%W7d;Vw z*&JE)NTVX&`$9K@TsmWXaz{Rd+>nlCuLzMPk0o1!c_Y32Lb$NQMHXcP>BlsWRVnKJ zL2wzc2n0r{*4vL$P?McUZ&BxM6|e_4nyllM9!yz9x*y;-1>+BrHThj=j4))OYMiRy zzq03RvY5^t)oPRH$MNxt%^LRN%|Q=8l15W%zvG1@q0rgoPgS$5A=6~7t;0qs=amOy zS@Y%T!#6Fb_Q0yG_?zg*NrpDWFuH}Wxvc&6*@C&95V4n~z0ez6KnQ1a$Bf-aLZ+S! z(N`b>UNSU?1NPNB@b^i~O_LbDy_bS$;)4e@jaD5SSd>nZm{FIC)L3M!WG)IqWW;^X zNFeBRvr`oVc&gEQPpikDzu<&kzfF81;4&T6;`|VE75!+iBUK2CFNMb>!pV#=&c&4c zaj($3VcfprDF<+ovtsMf$?Cvyw2-;dWFB|qHZrw3gR=euo|YScub|_`<^cc^;oGS*tmyZ3?eX z>s-7e9wOG{ZH@Ot0e(cE`vN1sPu_K>G)*LdcG$S+Hb0yEY5WilOlA{; z5aOrEA=IWQFZ#8djDKHN$ArJ%`2PvF1xWhT_TdA5I64K_sr+i)^gLBkdlB#e$M-b> z^$y2?Doq4U_{97N?5z(LdgsJb3OIj*(l{FV2w9&;tfFTk9k*Oi4E%b3;YITN`(_pf zH!s!mc0Xy|}d2@4BJx&*u-r%+bM*2OdL!pnpjGk@Vt!jP*U8 zsHRqYa5`txrY{E$udfXZL;sRz^E6IWpC8E3;bVeB50QRm`SMsYP!BUjg+{J#?9dr@ zMmprgD2>#PrRk}mcaYdNFYgys2Vn~0&FK?nt^=rj%GiW;c9mgy+*um|9X6Bvpp z8XHn@0q83K577W@jsN?vU07LKnssSs;Dp3YLiCg)Kt(+SZ~>Kk^|&yFAWi2?!bF`E zN~h>bfeSsVM_eq#A>a>w$@UEa7NCvQFq+GR>NP`X5dbByaW~AEa7D!;8nKz?gb=0x zVFxRzxRtEmG`RyS53;AF2sn!j@N)hzUpNFu?`Drrr1Nxu!dj7H=8_EE!mC$q{>^E@ z$deVmkvA*!Z~saCllA${aen z<0E^pF{*;G6YI&+sAkgNkjTXKnl62)`id-@A*YzMVivtm4 z>(2+`Hi-3<4aYc%X@o2{;Y;xj*0=|23~-53cHJ_;h>p$R27A#sI!an(wS-s!(>>$^ zImFcEzFA3;keqXzQS%}N6X&urnH%Iqu1eS*I8?Sk@*a8R?ie}=LtM@9>MpFgob zdw%X`@7EI7I*%tbaGe(O2%%>a7gv+cP9yv9YkeMY4ctDd2YnSHre3mZ06;Is(XN)n z)lHx60K5UPO#<=}^GI&wCb&On?ps(h` z*2A#5Q;OkwaSL1TJ&5L9-np8_IJ8jdY8|nVr1`*5Kbk+$w- zI__=Z_WK~y0cJ$GTF2$FatVhChiHbKj$di+!-B*~8#=%I?I8rf;DL?V8 z0b(-bLl1h*TGd|kpxUf(jqlvRU}BbJrIUR~stz-TT>n}EQH7C{3;clwnxMsjW86Xt zB)*}M>~(zFvJ)8&>*(1>$&XnROSKPAyOJrwgogqN9N^SSargiL diff --git a/R/wwinference.R b/R/wwinference.R index 1e10e6ea..385d5e39 100644 --- a/R/wwinference.R +++ b/R/wwinference.R @@ -31,13 +31,15 @@ #' `get_model_spec()`. The default here pertains to the `forecast_date` in the #' example data provided by the package, but this should be specified by the #' user based on the date they are producing a forecast -#' @param fit_opts The fit options, which in this case default to the -#' MCMC parameters as defined using `get_mcmc_options()`. This includes -#' the following arguments, which are passed to -#' [`$sample()`][cmdstanr::model-method-sample]: -#' the number of chains, the number of warmup -#' and sampling iterations, the maximum tree depth, the average acceptance -#' probability, and the stan PRNG seed +#' @param fit_opts MCMC fitting options, as a list of keys and values. +#' These are passed as keyword arguments to +#' [`compiled_model$sample()`][cmdstanr::model-method-sample]. +#' Where no option is specified, [wwinference()] will fall back first on a +#' package-specific default value given by [get_mcmc_options()], if one exists. +#' If no package-specific default exists, [wwinference()] will fall back on +#' the default value defined in [`$sample()`][cmdstanr::model-method-sample]. +#' See the documentation for [`$sample()`][cmdstanr::model-method-sample] for +#' details on available options. #' @param generate_initial_values Boolean indicating whether or not to specify #' the initialization of the sampler, default is `TRUE`, meaning that #' initialization lists will be generated and passed as the `init` argument @@ -124,24 +126,27 @@ #' calibration_time <- 90 #' forecast_horizon <- 28 #' include_ww <- 1 -#' ww_fit <- wwinference(input_ww_data, -#' input_count_data, +#' +#' ww_fit <- wwinference( +#' ww_data = input_ww_data, +#' count_data = input_count_data, +#' forecast_date = forecast_date, +#' calibration_time = calibration_time, +#' forecast_horizon = forecast_horizon, #' model_spec = get_model_spec( -#' forecast_date = forecast_date, -#' calibration_time = calibration_time, -#' forecast_horizon = forecast_horizon, #' generation_interval = generation_interval, -#' inf_to_count_delay = inf_to_coutn_delay, +#' inf_to_count_delay = inf_to_count_delay, #' infection_feedback_pmf = infection_feedback_pmf, #' params = params #' ), -#' fit_opts = get_mcmc_options( +#' fit_opts = list( #' iter_warmup = 250, #' iter_sampling = 250, -#' n_chains = 2 +#' chains = 2 #' ) #' ) #' } +#' #' @rdname wwinference #' @aliases wwinference_fit wwinference <- function(ww_data, @@ -150,7 +155,7 @@ wwinference <- function(ww_data, calibration_time = 90, forecast_horizon = 28, model_spec = get_model_spec(), - fit_opts = get_mcmc_options(), + fit_opts = list(), generate_initial_values = TRUE, initial_values_seed = NULL, compiled_model = compile_model()) { @@ -160,6 +165,18 @@ wwinference <- function(ww_data, ) } + fit_opts_use <- get_mcmc_options() # get defaults + # this overwrites defaults with all and only the values the user sets in + # `fit_opts` + fit_opts_use[names(fit_opts)] <- fit_opts + + # Check that the fit options passed to wwinference are valid cmdstanr::sample + # arguments + checkmate::assert_names(names(fit_opts), + subset.of = formalArgs(compiled_model$sample) + ) + + # Check that data is compatible with specifications assert_no_dates_after_max(ww_data$date, forecast_date) assert_no_dates_after_max(count_data$date, forecast_date) @@ -204,7 +221,7 @@ wwinference <- function(ww_data, if (generate_initial_values) { withr::with_seed(initial_values_seed, { init_lists <- lapply( - 1:fit_opts$n_chains, + 1:fit_opts_use$chains, \(x) { get_inits_for_one_chain(stan_data_list) } @@ -220,7 +237,7 @@ wwinference <- function(ww_data, fit <- safe_fit_model( compiled_model = compiled_model, stan_data_list = stan_data_list, - fit_opts = fit_opts, + fit_opts = fit_opts_use, init_lists = init_lists ) @@ -329,15 +346,18 @@ fit_model <- function(compiled_model, stan_data_list, fit_opts, init_lists) { - fit <- compiled_model$sample( - data = stan_data_list, - init = init_lists, - seed = fit_opts$seed, - iter_sampling = fit_opts$iter_sampling, - iter_warmup = fit_opts$iter_warmup, - max_treedepth = fit_opts$max_treedepth, - chains = fit_opts$n_chains, - parallel_chains = fit_opts$n_chains + args_for_stan_sampling <- + c( + list( + data = stan_data_list, + init = init_lists + ), + fit_opts + ) + + fit <- do.call( + compiled_model$sample, + args_for_stan_sampling ) return(fit) @@ -348,42 +368,45 @@ fit_model <- function(compiled_model, #' #' @description #' This function returns a list of MCMC settings to pass to the -#' `cmdstanr::sample()` function to fit the model. The default settings are -#' specified for production-level runs, consider adjusting to optimize -#' for speed while iterating. +#' [`$sample()`][cmdstanr::model-method-sample] function to fit the model. +#' The default settings are specified for production-level runs. +#' All input arguments to [`$sample()`][cmdstanr::model-method-sample] +#' are configurable by the user. See +#' [`$sample()`][cmdstanr::model-method-sample] documentation +#' for details of the available arguments. #' #' #' @param iter_warmup integer indicating the number of warm-up iterations, -#' default is `750` +#' default is `750`. #' @param iter_sampling integer indicating the number of sampling iterations, -#' default is `500` -#' @param n_chains integer indicating the number of MCMC chains to run, default -#' is `4` -#' @param seed set of integers indicating the random seed of the stan sampler, -#' default is NULL +#' default is `500`. +#' @param seed integer, A seed for the (P)RNG to pass to CmdStan. In the case +#' of multi-chain sampling the single seed will automatically be augmented by +#' the the run (chain) ID so that each chain uses a different seed. +#' Default is `NULL`. +#' @param chains integer indicating the number of MCMC chains to run, default +#' is `4`. #' @param adapt_delta float between 0 and 1 indicating the average acceptance -#' probability, default is `0.95` +#' probability, default is `0.95`. #' @param max_treedepth integer indicating the maximum tree depth of the -#' sampler, default is 12 +#' sampler, default is 12. #' -#' @return a list of mcmc settings with the values given by the function +#' @return A list of MCMC settings with the values given by the function. #' arguments -#' @export #' -#' @examples -#' mcmc_settings <- get_mcmc_options() +#' @export get_mcmc_options <- function( iter_warmup = 750, iter_sampling = 500, - n_chains = 4, seed = NULL, + chains = 4, adapt_delta = 0.95, max_treedepth = 12) { mcmc_settings <- list( iter_warmup = iter_warmup, iter_sampling = iter_sampling, - n_chains = n_chains, seed = seed, + chains = chains, adapt_delta = adapt_delta, max_treedepth = max_treedepth ) diff --git a/data-raw/test_data.R b/data-raw/test_data.R index fbbeb29a..15abb0e6 100644 --- a/data-raw/test_data.R +++ b/data-raw/test_data.R @@ -46,11 +46,12 @@ model_spec <- wwinference::get_model_spec( params = params ) -mcmc_options <- wwinference::get_mcmc_options( - seed = 55, +mcmc_options <- list( + seed = 5, iter_warmup = 25, iter_sampling = 25, - n_chains = 1 + chains = 1, + show_messages = FALSE ) generate_initial_values <- TRUE @@ -66,7 +67,7 @@ model_test_data <- list( generate_initial_values = generate_initial_values ) -withr::with_seed(5, { +withr::with_seed(55, { fit <- do.call( wwinference::wwinference, model_test_data diff --git a/man/get_mcmc_options.Rd b/man/get_mcmc_options.Rd index 454b2c9a..193bb6f1 100644 --- a/man/get_mcmc_options.Rd +++ b/man/get_mcmc_options.Rd @@ -7,41 +7,43 @@ get_mcmc_options( iter_warmup = 750, iter_sampling = 500, - n_chains = 4, seed = NULL, + chains = 4, adapt_delta = 0.95, max_treedepth = 12 ) } \arguments{ \item{iter_warmup}{integer indicating the number of warm-up iterations, -default is \code{750}} +default is \code{750}.} \item{iter_sampling}{integer indicating the number of sampling iterations, -default is \code{500}} +default is \code{500}.} -\item{n_chains}{integer indicating the number of MCMC chains to run, default -is \code{4}} +\item{seed}{integer, A seed for the (P)RNG to pass to CmdStan. In the case +of multi-chain sampling the single seed will automatically be augmented by +the the run (chain) ID so that each chain uses a different seed. +Default is \code{NULL}.} -\item{seed}{set of integers indicating the random seed of the stan sampler, -default is NULL} +\item{chains}{integer indicating the number of MCMC chains to run, default +is \code{4}.} \item{adapt_delta}{float between 0 and 1 indicating the average acceptance -probability, default is \code{0.95}} +probability, default is \code{0.95}.} \item{max_treedepth}{integer indicating the maximum tree depth of the -sampler, default is 12} +sampler, default is 12.} } \value{ -a list of mcmc settings with the values given by the function +A list of MCMC settings with the values given by the function. arguments } \description{ This function returns a list of MCMC settings to pass to the -\code{cmdstanr::sample()} function to fit the model. The default settings are -specified for production-level runs, consider adjusting to optimize -for speed while iterating. -} -\examples{ -mcmc_settings <- get_mcmc_options() +\code{\link[cmdstanr:model-method-sample]{$sample()}} function to fit the model. +The default settings are specified for production-level runs. +All input arguments to \code{\link[cmdstanr:model-method-sample]{$sample()}} +are configurable by the user. See +\code{\link[cmdstanr:model-method-sample]{$sample()}} documentation +for details of the available arguments. } diff --git a/man/wwinference.Rd b/man/wwinference.Rd index 41306ea9..bfc62d04 100644 --- a/man/wwinference.Rd +++ b/man/wwinference.Rd @@ -15,7 +15,7 @@ wwinference( calibration_time = 90, forecast_horizon = 28, model_spec = get_model_spec(), - fit_opts = get_mcmc_options(), + fit_opts = list(), generate_initial_values = TRUE, initial_values_seed = NULL, compiled_model = compile_model() @@ -50,13 +50,15 @@ forecast date, to produce forecasts for, default is \code{28}} example data provided by the package, but this should be specified by the user based on the date they are producing a forecast} -\item{fit_opts}{The fit options, which in this case default to the -MCMC parameters as defined using \code{get_mcmc_options()}. This includes -the following arguments, which are passed to -\code{\link[cmdstanr:model-method-sample]{$sample()}}: -the number of chains, the number of warmup -and sampling iterations, the maximum tree depth, the average acceptance -probability, and the stan PRNG seed} +\item{fit_opts}{MCMC fitting options, as a list of keys and values. +These are passed as keyword arguments to +\code{\link[cmdstanr:model-method-sample]{compiled_model$sample()}}. +Where no option is specified, \code{\link[=wwinference]{wwinference()}} will fall back first on a +package-specific default value given by \code{\link[=get_mcmc_options]{get_mcmc_options()}}, if one exists. +If no package-specific default exists, \code{\link[=wwinference]{wwinference()}} will fall back on +the default value defined in \code{\link[cmdstanr:model-method-sample]{$sample()}}. +See the documentation for \code{\link[cmdstanr:model-method-sample]{$sample()}} for +details on available options.} \item{generate_initial_values}{Boolean indicating whether or not to specify the initialization of the sampler, default is \code{TRUE}, meaning that @@ -170,24 +172,27 @@ forecast_date <- "2023-11-06" calibration_time <- 90 forecast_horizon <- 28 include_ww <- 1 -ww_fit <- wwinference(input_ww_data, - input_count_data, + +ww_fit <- wwinference( + ww_data = input_ww_data, + count_data = input_count_data, + forecast_date = forecast_date, + calibration_time = calibration_time, + forecast_horizon = forecast_horizon, model_spec = get_model_spec( - forecast_date = forecast_date, - calibration_time = calibration_time, - forecast_horizon = forecast_horizon, generation_interval = generation_interval, - inf_to_count_delay = inf_to_coutn_delay, + inf_to_count_delay = inf_to_count_delay, infection_feedback_pmf = infection_feedback_pmf, params = params ), - fit_opts = get_mcmc_options( + fit_opts = list( iter_warmup = 250, iter_sampling = 250, - n_chains = 2 + chains = 2 ) ) } + } \seealso{ Other diagnostics: diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 59e37f77..8264c677 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -131,3 +131,10 @@ diff_ar1_from_z_scores_alt <- function(x0, ar, sd, z, stationary = FALSE) { return(x) } + +silent_wwinference <- function(...) { + utils::capture.output( + fit <- suppressMessages(wwinference(...)) + ) + return(fit) +} diff --git a/tests/testthat/test_ww_model.R b/tests/testthat/test_ww_model.R index 0e9b90b6..697d201e 100644 --- a/tests/testthat/test_ww_model.R +++ b/tests/testthat/test_ww_model.R @@ -2,13 +2,18 @@ test_that("Test the wastewater inference model on simulated data.", { ####### # run model briefly on the simulated data ####### - withr::with_seed(5, { + + # This seed sets the initial values seed. Must be the same as the one used + # in generating the test data. + # model_test_data contains the seed that gets passed to stan + withr::with_seed(55, { fit <- do.call( - wwinference::wwinference, + silent_wwinference, model_test_data ) }) + params <- model_test_data$model_spec$params obs_last_draw <- posterior::subset_draws(fit$fit$result$draws(), draw = 25 diff --git a/tests/testthat/test_wwinference.R b/tests/testthat/test_wwinference.R index 6abf6ab5..aa7f904d 100644 --- a/tests/testthat/test_wwinference.R +++ b/tests/testthat/test_wwinference.R @@ -59,12 +59,9 @@ test_that("wwinference model can compile", { test_that("Function to get mcmc options produces the expected outputs", { mcmc_options <- get_mcmc_options() expected_names <- c( - "iter_warmup", "iter_sampling", - "n_chains", "seed", "adapt_delta", "max_treedepth", - "compute_likelihood" + "iter_warmup", "iter_sampling", "seed", "adapt_delta", "max_treedepth" ) - # Checkmade doesn't work here for a list, says it must be a character vector - expect_true(all(names(mcmc_options) %in% expected_names)) + checkmate::expect_names(names(mcmc_options), must.include = expected_names) }) test_that("Function to get model specs produces expected outputs", { @@ -77,3 +74,16 @@ test_that("Function to get model specs produces expected outputs", { # Checkmade doesn't work here for a list, says it must be a character vector expect_true(all(names(model_spec) %in% expected_names)) }) + +test_that("Passing invalid args to fit_opts throws an error ", { + expect_error( + wwinference( + ww_data = input_ww_data, + count_data = input_count_data, + forecast_date = forecast_date, + model_spec = get_model_spec, + fit_opts = list(not_an_arg = 4) + ), + regexp = c("Names must be a subset of ") + ) +}) diff --git a/vignettes/wwinference.Rmd b/vignettes/wwinference.Rmd index e7000813..9e5b81e6 100644 --- a/vignettes/wwinference.Rmd +++ b/vignettes/wwinference.Rmd @@ -17,6 +17,7 @@ vignette: > ```{r setup, echo=FALSE} knitr::opts_chunk$set(dev = "svg") +options(mc.cores = 4) # This tells cmdstan to run the 4 chains in parallel ``` # Quick start @@ -357,7 +358,7 @@ to achieve improved model convergence and/or faster model fitting times. See the We also pass our preprocessed datasets (`ww_data_to_fit` and `hosp_data_preprocessed`), specify our model using `get_model_spec()`, -set the MCMC settings using `get_mcmc_options()`, and pass in our +set the MCMC settings by passing a list of arguments to `fit_opts` that will be passed to the `cmdstanr::sample()` function, and pass in our pre-compiled model(`model`) to `wwinference()` where they are combined and used to fit the model. @@ -374,7 +375,7 @@ ww_fit <- wwinference( infection_feedback_pmf = infection_feedback_pmf, params = params ), - fit_opts = get_mcmc_options(seed = 123), + fit_opts = list(seed = 123), compiled_model = model ) ``` @@ -561,7 +562,7 @@ fit_hosp_only <- wwinference( include_ww = FALSE, params = params ), - fit_opts = get_mcmc_options(seed = 123), + fit_opts = list(seed = 123), compiled_model = model ) ``` From 46e896b4a3e0702fde50aee53ae2c67492b60be3 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Fri, 27 Sep 2024 20:07:58 -0400 Subject: [PATCH 26/46] Hot fix validate pmf (#191) --- R/validate.R | 5 ++++- man/validate_pmf.Rd | 4 ++++ tests/testthat/test_checkers.R | 10 ++++++++++ 3 files changed, 18 insertions(+), 1 deletion(-) diff --git a/R/validate.R b/R/validate.R index 5c927966..5a420569 100644 --- a/R/validate.R +++ b/R/validate.R @@ -227,15 +227,18 @@ validate_both_datasets <- function(input_count_data, #' @param calibration_time integer indicating the calibration time #' @param count_data tibble containing the input count data ready to be passed #' to stan +#' @param tolerance numeric indicating the allowable difference between the +#' sum of the pmf and 1, default is `1e-6` #' @param arg name of the argument supplying the object #' @param call The calling environment to be reflected in the error message #' @return NULL, invisibly validate_pmf <- function(pmf, calibration_time, count_data, + tolerance = 1e-6, arg = "x", call = rlang::caller_env()) { - if (!all.equal(sum(pmf), 1)) { + if (!isTRUE(all.equal(sum(pmf), 1, tolerance = 1e-6))) { cli::cli_abort( c( "{.arg {arg}} does not sum to 1." diff --git a/man/validate_pmf.Rd b/man/validate_pmf.Rd index 20fb0362..4e84ce76 100644 --- a/man/validate_pmf.Rd +++ b/man/validate_pmf.Rd @@ -10,6 +10,7 @@ validate_pmf( pmf, calibration_time, count_data, + tolerance = 1e-06, arg = "x", call = rlang::caller_env() ) @@ -23,6 +24,9 @@ each day} \item{count_data}{tibble containing the input count data ready to be passed to stan} +\item{tolerance}{numeric indicating the allowable difference between the +sum of the pmf and 1, default is \code{1e-6}} + \item{arg}{name of the argument supplying the object} \item{call}{The calling environment to be reflected in the error message} diff --git a/tests/testthat/test_checkers.R b/tests/testthat/test_checkers.R index 3f17ac23..139bd22f 100644 --- a/tests/testthat/test_checkers.R +++ b/tests/testthat/test_checkers.R @@ -269,6 +269,16 @@ test_that( } ) +test_that( + "Test that validate pmfs returns the expected error message.", + { + invalid_pmf <- c(0.4, 0.4, 0.4) + expect_error(validate_pmf(invalid_pmf), + regexp = "does not sum to 1" + ) + } +) + test_that( "Test that assert dates in range function works as expected.", { From d35647e451efc820cc7472979d5353083584bbde Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Mon, 30 Sep 2024 19:45:18 -0400 Subject: [PATCH 27/46] Restructure hierarchical estimation based on reference subpopulation (#158) * update validate to warn if sum(site_pop)>total pop * modify to center around the reference pop * temporary change to stan file path for troubleshooting * model compiles * reorder pops by size, reindex subpops to sites, add switch for include_ww = 0 * wip rmd * reindex labsites + other changes * ensure the sum(sites) * Update inst/stan/wwinference.stan Co-authored-by: Dylan H. Morris * Update inst/stan/wwinference.stan Co-authored-by: Dylan H. Morris * Update inst/stan/wwinference.stan Co-authored-by: Dylan H. Morris * Update inst/stan/wwinference.stan Co-authored-by: Dylan H. Morris * Update inst/stan/wwinference.stan Co-authored-by: Dylan H. Morris * Update inst/stan/wwinference.stan Co-authored-by: Dylan H. Morris * add ofsets to intercept and growth rate of unobserved infection process * update test data running on WSL2 * Change how offsets are handled (#168) * Update model file to handle offsets slightly differently, clarify parameter name comments * Fix missing close paren * Fix variable name * Fix more variable names * Remove separate handling of reference pop, fix a few more bugs * Update docs * Fix check for warning in get_stan_data test * Better fix for test_get_stan_data * Fail more informatively if test_ww_model fails to fit entirely * Further customize the fitting failure message for informativeness * Update get stan data with new variable names * Add new variable names to example_params.toml * Fix indexing and initialization * Update test data * add test of no ww model * add conditional for inits, add test for no ww * tweak prreprocessing to handle no wastewater case, add tests for all cases * update testing data * Update R/get_stan_data.R Co-authored-by: Dylan H. Morris * Update R/get_draws.R Co-authored-by: Dylan H. Morris * Update R/validate.R Co-authored-by: Dylan H. Morris * Update R/validate.R Co-authored-by: Dylan H. Morris * fix initialization * update language around the sum(sites)>pop * run pre-commit locally * whoops, fix init * aux site -> aux subpop * add site_to_subpop map to get_subpop_data function * create vectors to pass to stan using the subpopulation mappings * revert to original initialization, use index explicitly in df column name * remove old comments * add functions for making spines in wwinference * move spine functions to get stan data file * update docs * fix fxn input * Fix typo * refactor handling of sites, subpops, ww data indices interally, commented code, expect to fail * include lod vals in plots * fix get stan data to be all based on mappings * fix tests to take in all inputs to get stan data * fix lab_site_subpop_spine fxn * first pass fix postprocessing * minor tweaks * update expected column names from get_draws * update test data * fix labsite to subpop spine handling, add docs for get ww indices and vals --------- Co-authored-by: Dylan H. Morris Co-authored-by: Dylan H. Morris --- NAMESPACE | 9 +- R/figures.R | 17 +- R/get_draws.R | 151 +++-- R/get_stan_data.R | 650 +++++++++++--------- R/initialization.R | 43 +- R/model_diagnostics.R | 12 + R/preprocessing.R | 13 +- R/sysdata.rda | Bin 38166 -> 0 bytes R/validate.R | 46 +- R/wwinference.R | 71 ++- data-raw/test_data.R | 90 --- data/default_covid_inf_to_hosp.rda | Bin 640 -> 637 bytes data/hosp_data.rda | Bin 586 -> 607 bytes data/hosp_data_eval.rda | Bin 615 -> 655 bytes data/true_global_rt.rda | Bin 2187 -> 2169 bytes data/ww_data.rda | Bin 1663 -> 1657 bytes inst/extdata/example_params.toml | 22 +- inst/stan/wwinference.stan | 189 +++--- man/figures/.DS_Store | Bin 0 -> 6148 bytes man/get_date_time_spine.Rd | 37 ++ man/get_draws.Rd | 18 +- man/get_lab_site_site_spine.Rd | 21 + man/get_lab_site_subpop_spine.Rd | 19 + man/get_model_diagnostic_flags.Rd | 1 + man/get_site_subpop_spine.Rd | 25 + man/get_stan_data.Rd | 54 +- man/get_subpop_data.Rd | 28 - man/get_ww_data_indices.Rd | 45 -- man/get_ww_indices_and_values.Rd | 32 + man/get_ww_values.Rd | 50 -- man/parameter_diagnostics.Rd | 1 + man/summary_diagnostics.Rd | 25 + man/validate_both_datasets.Rd | 12 + man/wwinference.Rd | 5 +- model_definition.md | 22 +- tests/testthat/test_get_stan_data.R | 267 +++++++- tests/testthat/test_helper.R | 9 - tests/testthat/test_models_run_without_ww.R | 122 ++++ tests/testthat/test_preprocess_ww_data.R | 21 +- tests/testthat/test_ww_model.R | 133 ---- tests/testthat/test_wwinference.R | 2 +- vignettes/wwinference.Rmd | 82 ++- 42 files changed, 1430 insertions(+), 914 deletions(-) delete mode 100644 R/sysdata.rda delete mode 100644 data-raw/test_data.R create mode 100644 man/figures/.DS_Store create mode 100644 man/get_date_time_spine.Rd create mode 100644 man/get_lab_site_site_spine.Rd create mode 100644 man/get_lab_site_subpop_spine.Rd create mode 100644 man/get_site_subpop_spine.Rd delete mode 100644 man/get_subpop_data.Rd delete mode 100644 man/get_ww_data_indices.Rd create mode 100644 man/get_ww_indices_and_values.Rd delete mode 100644 man/get_ww_values.Rd create mode 100644 man/summary_diagnostics.Rd create mode 100644 tests/testthat/test_models_run_without_ww.R delete mode 100644 tests/testthat/test_ww_model.R diff --git a/NAMESPACE b/NAMESPACE index 6adf538f..6b5cb25b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,11 +21,14 @@ export(generate_simulated_data) export(get_count_data_sizes) export(get_count_indices) export(get_count_values) +export(get_date_time_spine) export(get_draws) export(get_draws_df) export(get_ind_m) export(get_input_count_data_for_stan) export(get_input_ww_data_for_stan) +export(get_lab_site_site_spine) +export(get_lab_site_subpop_spine) export(get_mcmc_options) export(get_model_diagnostic_flags) export(get_model_spec) @@ -34,15 +37,15 @@ export(get_plot_forecasted_counts) export(get_plot_global_rt) export(get_plot_subpop_rt) export(get_plot_ww_conc) +export(get_site_subpop_spine) export(get_stan_data) -export(get_subpop_data) -export(get_ww_data_indices) export(get_ww_data_sizes) -export(get_ww_values) +export(get_ww_indices_and_values) export(indicate_ww_exclusions) export(parameter_diagnostics) export(preprocess_count_data) export(preprocess_ww_data) +export(summary_diagnostics) export(to_simplex) export(validate_paramlist) export(wwinference) diff --git a/R/figures.R b/R/figures.R index 9a63adb5..475fd7c7 100644 --- a/R/figures.R +++ b/R/figures.R @@ -111,16 +111,13 @@ get_plot_ww_conc <- function(draws, draws_to_plot <- draws |> dplyr::filter( .data$draw %in% !!sampled_draws - ) |> - dplyr::mutate( - site_lab_name = glue::glue("{subpop}, Lab: {lab}") ) p <- ggplot(draws_to_plot) + geom_line( aes( x = .data$date, y = .data$pred_value, - color = .data$subpop, + color = .data$subpop_name, group = .data$draw ), alpha = 0.1, size = 0.2, @@ -129,7 +126,13 @@ get_plot_ww_conc <- function(draws, geom_point(aes(x = .data$date, y = .data$observed_value), color = "black", show.legend = FALSE, size = 0.5 ) + - facet_wrap(~site_lab_name, scales = "free") + + geom_point( + data = draws_to_plot |> + dplyr::filter(.data$below_lod == 1), + aes(x = .data$date, y = .data$observed_value), + color = "blue", show.legend = FALSE, size = 0.5 + ) + + facet_wrap(~lab_site_name, scales = "free") + geom_vline( xintercept = lubridate::ymd(forecast_date), linetype = "dashed" @@ -246,7 +249,7 @@ get_plot_subpop_rt <- function(draws, geom_step( aes( x = .data$date, y = .data$pred_value, group = .data$draw, - color = .data$subpop + color = .data$subpop_name ), alpha = 0.1, linewidth = 0.2, show.legend = FALSE @@ -256,7 +259,7 @@ get_plot_subpop_rt <- function(draws, linetype = "dashed", show.legend = FALSE ) + - facet_wrap(~subpop, scales = "free") + + facet_wrap(~subpop_name, scales = "free") + geom_hline(aes(yintercept = 1), linetype = "dashed") + xlab("") + ylab("Subpopulation R(t)") + diff --git a/R/get_draws.R b/R/get_draws.R index c029726f..5af9da11 100644 --- a/R/get_draws.R +++ b/R/get_draws.R @@ -50,6 +50,9 @@ get_draws.wwinference_fit <- function(x, ..., what = "all") { get_draws.data.frame( x = x$raw_input_data$input_ww_data, count_data = x$raw_input_data$input_count_data, + date_time_spine = x$raw_input_data$date_time_spine, + site_subpop_spine = x$raw_input_data$site_subpop_spine, + lab_site_subpop_spine = x$raw_input_data$lab_site_subpop_spine, stan_data_list = x$stan_data_list, fit_obj = x$fit, what = what @@ -77,6 +80,9 @@ get_draws_what_ok <- c( #' @rdname get_draws #' @param count_data A dataframe of the preprocessed daily count data (e.g. #' hospital admissions) from the "global" population +#' @param date_time_spine tibble mapping dates to time in days +#' @param site_subpop_spine tibble mapping sites to subpopulations +#' @param lab_site_subpop_spine tibble mapping lab-sites to subpopulations #' @param stan_data_list A list containing all the data passed to stan for #' fitting the model #' @param fit_obj a CmdStan object that is the output of fitting the model to @@ -84,6 +90,9 @@ get_draws_what_ok <- c( #' @export get_draws.data.frame <- function(x, count_data, + date_time_spine, + site_subpop_spine, + lab_site_subpop_spine, stan_data_list, fit_obj, ..., @@ -111,34 +120,28 @@ get_draws.data.frame <- function(x, } else { what_ok[what] <- TRUE } + if (stan_data_list$include_ww == 0) { + if (any(c("predicted_ww", "subpop_rt") %in% what)) { + cli::cli_abort(c( + "Predicted wastewater concentrations and subpopulation R(t)s", + " can not be returned because the model wasn't fit to ", + " site-level wastewater data" + )) + } + what_ok["predicted_ww"] <- FALSE + what_ok["subpop_rt"] <- FALSE + if (what == "all") { + warning(c( + "Model wasn't fit to wastewater data. ", + "Predicted wastewater concentrations and subpopulation R(t)s", + "\nestimates will not be returned in the ", + "`wwinference_fit_draws` object" + )) + } + } draws <- fit_obj$result$draws() - # Get the necessary mappings needed to join draws to data - date_time_spine <- tibble::tibble( - date = seq( - from = min(count_data$date), - to = min(count_data$date) + stan_data_list$ot + stan_data_list$ht, - by = "days" - ) - ) |> - dplyr::mutate(t = row_number()) - - # Lab-site index to corresponding lab, site, and site population size - lab_site_spine <- x |> - dplyr::distinct(.data$site, .data$lab, .data$lab_site_index, .data$site_pop) - - # Site index to corresponding site and subpopulation size - subpop_spine <- x |> - dplyr::distinct(.data$site, .data$site_index, .data$site_pop) |> - dplyr::mutate(site = as.factor(.data$site)) |> - dplyr::bind_rows(tibble::tibble( - site = "remainder of pop", - site_index = max(x$site_index) + 1, - site_pop = stan_data_list$subpop_size[ - length(unique(stan_data_list$subpop_size)) - ] - )) count_draws <- if (what_ok["predicted_counts"]) { draws |> # predicted_counts @@ -177,37 +180,36 @@ get_draws.data.frame <- function(x, ) |> dplyr::select("lab_site_index", "t", "pred_value", "draw") |> dplyr::left_join(date_time_spine, by = "t") |> - dplyr::left_join(lab_site_spine, by = "lab_site_index") |> + dplyr::left_join(lab_site_subpop_spine, by = "lab_site_index") |> dplyr::left_join( - x |> - dplyr::select(-"t"), + x |> dplyr::distinct( + .data$log_genome_copies_per_ml, + .data$log_lod, + .data$date, + .data$below_lod, + .data$lab_site_index + ), by = c( - "lab_site_index", "date", - "lab", "site", "site_pop" + "lab_site_index", "date" ) ) |> dplyr::ungroup() |> dplyr::mutate( observed_value = .data$log_genome_copies_per_ml, - subpop = glue::glue("Site: {site}") ) |> dplyr::select( - "below_lod", "date", - "draw", - "exclude", - "flag_as_ww_outlier", - "lab", - "lab_site_index", "lab_site_name", - "log_genome_copies_per_ml", - "log_lod", - "observed_value", "pred_value", + "draw", + "observed_value", + "subpop_name", + "subpop_pop", "site", - "site_index", - "site_pop", - "subpop" + "lab", + "log_lod", + "below_lod", + "lab_site_index" ) } else { NULL @@ -228,12 +230,10 @@ get_draws.data.frame <- function(x, by = "date" ) |> dplyr::ungroup() |> - dplyr::rename("observed_value" = "count") |> dplyr::select( "date", - "draw", - "observed_value", "pred_value", + "draw", "total_pop" ) } else { @@ -242,29 +242,22 @@ get_draws.data.frame <- function(x, subpop_rt_draws <- if (what_ok["subpop_rt"]) { draws |> - tidybayes::spread_draws(!!str2lang("r_site_t[site_index, t]")) |> - dplyr::rename("pred_value" = "r_site_t") |> + tidybayes::spread_draws(!!str2lang("r_subpop_t[subpop_index, t]")) |> + dplyr::rename("pred_value" = "r_subpop_t") |> dplyr::mutate( draw = .data$`.draw`, pred_value = .data$pred_value ) |> - dplyr::select("site_index", "t", "pred_value", "draw") |> + dplyr::select("subpop_index", "t", "pred_value", "draw") |> dplyr::left_join(date_time_spine, by = "t") |> - dplyr::left_join(subpop_spine, by = "site_index") |> + dplyr::left_join(site_subpop_spine, by = "subpop_index") |> dplyr::ungroup() |> - dplyr::mutate( - subpop = ifelse(.data$site != "remainder of pop", - glue::glue("Site: {site}"), "remainder of pop" - ) - ) |> dplyr::select( "date", - "draw", "pred_value", - "site", - "site_index", - "site_pop", - "subpop" + "draw", + "subpop_name", + "subpop_pop", ) } else { NULL @@ -290,18 +283,23 @@ print.wwinference_fit_draws <- function(x, ...) { ifelse(length(x$subpop_rt) > 0, max(x$subpop_rt$draw), 0) ) |> max() + # This calculates the number of time points in each dataframe timepoints <- c( ifelse( - length(x$predicted_counts) > 0, diff(range(x$predicted_counts$date)), 0 + length(x$predicted_counts) > 0, + diff(range(x$predicted_counts$date)) + 1, 0 ), ifelse( - length(x$predicted_ww) > 0, diff(range(x$predicted_ww$date)), 0 + length(x$predicted_ww) > 0, + diff(range(x$predicted_ww$date)) + 1, 0 ), ifelse( - length(x$global_rt) > 0, diff(range(x$global_rt$date)), 0 + length(x$global_rt) > 0, + diff(range(x$global_rt$date)) + 1, 0 ), ifelse( - length(x$subpop_rt) > 0, diff(range(x$subpop_rt$date)), 0 + length(x$subpop_rt) > 0, + diff(range(x$subpop_rt$date)) + 1, 0 ) ) |> max() @@ -342,9 +340,9 @@ print.wwinference_fit_draws <- function(x, ...) { if (length(x$subpop_rt)) { cat( sprintf( - " - `$subpop_rt` with %i rows across %i sub-populations\n", + " - `$subpop_rt` with %i rows across %i subpopulations\n", nrow(x$subpop_rt), - length(unique(x$subpop_rt$subpop)) + length(unique(x$subpop_rt$subpop_name)) ) ) } @@ -370,7 +368,7 @@ new_wwinference_fit_draws <- function( subpop_rt) { # Checking colnames: Must match all exactly predicted_counts_colnames <- c( - "date", "draw", "observed_value", "pred_value", "total_pop" + "date", "pred_value", "observed_value", "draw", "total_pop" ) if (length(predicted_counts)) { checkmate::assert_names( @@ -383,19 +381,15 @@ new_wwinference_fit_draws <- function( "below_lod", "date", "draw", - "exclude", - "flag_as_ww_outlier", "lab", - "lab_site_index", "lab_site_name", - "log_genome_copies_per_ml", "log_lod", "observed_value", "pred_value", "site", - "site_index", - "site_pop", - "subpop" + "subpop_pop", + "subpop_name", + "lab_site_index" ) if (length(predicted_ww)) { checkmate::assert_names( @@ -405,7 +399,7 @@ new_wwinference_fit_draws <- function( } global_rt_colnames <- c( - "date", "draw", "observed_value", "pred_value", "total_pop" + "date", "draw", "pred_value", "total_pop" ) if (length(global_rt)) { checkmate::assert_names( @@ -415,8 +409,11 @@ new_wwinference_fit_draws <- function( } subpop_rt_colnames <- c( - "date", "draw", "pred_value", "site", "site_index", "site_pop", - "subpop" + "date", + "draw", + "pred_value", + "subpop_pop", + "subpop_name" ) if (length(subpop_rt)) { checkmate::assert_names( diff --git a/R/get_stan_data.R b/R/get_stan_data.R index c63e4aa6..515e44a4 100644 --- a/R/get_stan_data.R +++ b/R/get_stan_data.R @@ -42,68 +42,230 @@ get_input_ww_data_for_stan <- function(preprocessed_ww_data, last_count_data_date, calibration_time) { # Test to see if ww_data_present - ww_data_present <- nrow(preprocessed_ww_data) != 0 + ww_data_present <- !is.null(preprocessed_ww_data) if (ww_data_present == FALSE) { message("No wastewater data present") - } - - if (all(sum(preprocessed_ww_data$flag_as_ww_outlier) > sum( - preprocessed_ww_data$exclude - ))) { - cli::cli_warn( - c( - "Wastewater data being passed to the model has outliers flagged,", - "but not all have been indicated for exclusion from model fit" + ww_data <- NULL + } else { + if (all(sum(preprocessed_ww_data$flag_as_ww_outlier) > sum( + preprocessed_ww_data$exclude + ))) { + cli::cli_warn( + c( + "Wastewater data being passed to the model has outliers flagged,", + "but not all have been indicated for exclusion from model fit" + ) ) + } + + # Test for presence of needed column names + assert_req_ww_cols_present(preprocessed_ww_data, + conc_col_name = "log_genome_copies_per_ml", + lod_col_name = "log_lod" ) + + # Filter out wastewater outliers, and remove extra wastewater + # data. Arrange data for indexing. This is what will be returned. + ww_data <- preprocessed_ww_data |> + dplyr::filter( + .data$exclude != 1, + .data$date > !!last_count_data_date - + lubridate::days(!!calibration_time) + ) |> + dplyr::arrange(.data$date, .data$lab_site_index) } - # Test for presence of needed column names - assert_req_ww_cols_present(preprocessed_ww_data, - conc_col_name = "log_genome_copies_per_ml", - lod_col_name = "log_lod" + return(ww_data) +} + +#' Get date time spine to map to model output +#' +#' @param forecast_date a character string in ISO8601 format (YYYY-MM-DD) +#' indicating the date that the forecast is to be made. +#' @param input_count_data a dataframe of the count data to be passed +#' directly to stan, , must have the following columns: date, count, total_pop +#' @param last_count_data_date string indicating the date of the last observed +#' count data point in 1SO8601 format (YYYY-MM-DD) +#' @param calibration_time integer indicating the number of days to calibrate +#' the model for, default is `90` +#' @param forecast_horizon integer indicating the number of days, including the +#' forecast date, to produce forecasts for, default is `28` +#' +#' +#' @return a tibble containing an integer for time mapped to the corresponding +#' date, for the entire calibration and forecast period +#' @export +#' +get_date_time_spine <- function(forecast_date, + input_count_data, + last_count_data_date, + calibration_time, + forecast_horizon) { + nowcast_time <- as.integer( + lubridate::ymd(forecast_date) - last_count_data_date ) + date_time_spine <- tibble::tibble( + date = seq( + from = min(input_count_data$date), + to = min(input_count_data$date) + + calibration_time + + nowcast_time + + forecast_horizon, + by = "days" + ) + ) |> + dplyr::mutate(t = row_number()) + return(date_time_spine) +} - # Filter out wastewater outliers, and remove extra wastewater - # data. Arrange data for indexing. This is what will be returned. - ww_data <- preprocessed_ww_data |> - dplyr::filter( - .data$exclude != 1, - .data$date > !!last_count_data_date - - lubridate::days(!!calibration_time) - ) |> - dplyr::arrange(.data$date, .data$lab_site_index) +#' Get mapping from lab-site to site +#' +#' @param input_ww_data a dataframe of the wastewater data to be passed +#' directly to stan, must have the following columns: date, site, lab, +#' genome_copies_per_ml, site_pop, below_lod, and exclude +#' +#' @return a dataframe mapping the unique combinations of sites and labs +#' to their indices in the model and the population of the site in that +#' observation unit (lab_site) +#' @export +#' +get_lab_site_site_spine <- function(input_ww_data) { + ww_data_present <- !is.null(input_ww_data) + + if (ww_data_present) { + lab_site_site_spine <- + input_ww_data |> + dplyr::select( + "lab_site_index", "site_index", + "site", "lab", "site_pop" + ) |> + dplyr::arrange(.data$lab_site_index) |> + dplyr::distinct() |> + dplyr::mutate( + "lab_site_name" = glue::glue( + "Site: {site}, Lab: {lab}" + ) + ) + } else { + lab_site_site_spine <- tibble::tibble() + } - ww_data_sizes <- get_ww_data_sizes( - ww_data, - lod_col_name = "below_lod" - ) - ww_indices <- get_ww_data_indices( - ww_data, - first_count_data_date, - owt = ww_data_sizes$owt, - lod_col_name = "below_lod" - ) + return(lab_site_site_spine) +} - ww_data <- ww_data |> - dplyr::mutate( - t = ww_indices$ww_sampled_times +#' Get site to subpopulation map +#' +#' @param input_ww_data a dataframe of the wastewater data to be passed +#' directly to stan, must have the following columns: date, site, lab, +#' genome_copies_per_ml, site_pop, below_lod, and exclude +#' @param input_count_data a dataframe of the count data to be passed +#' directly to stan, , must have the following columns: date, count, total_pop +#' +#' @return a dataframe mapping the sites to the corresponding subpopulation and +#' subpopulation index, plus the population in each subpopulation. Imposes +#' the logic to add a subpopulation if the total population is greater than +#' the sum of the site populations in the input wastewater data +#' @export +#' +get_site_subpop_spine <- function(input_ww_data, + input_count_data) { + ww_data_present <- !is.null(input_ww_data) + + total_pop <- input_count_data |> + dplyr::distinct(.data$total_pop) |> + dplyr::pull() + + if (ww_data_present) { + add_auxiliary_subpop <- ifelse( + total_pop > sum(unique(input_ww_data$site_pop)), + TRUE, + FALSE ) + site_indices <- input_ww_data |> + dplyr::select("site_index", "site", "site_pop") |> + dplyr::distinct() |> + dplyr::arrange(.data$site_index) - return(ww_data) + if (add_auxiliary_subpop) { + aux_subpop <- tibble::tibble( + "site_index" = NA, + "site" = NA, + "site_pop" = total_pop - sum(site_indices$site_pop) + ) + } else { + aux_subpop <- tibble::tibble() + } + + site_subpop_spine <- aux_subpop |> + dplyr::bind_rows(site_indices) |> + dplyr::mutate( + subpop_index = dplyr::row_number() + ) |> + dplyr::mutate( + subpop_name = ifelse(!is.na(.data$site), + glue::glue("Site: {site}"), + "remainder of population" + ) + ) |> + dplyr::rename( + "subpop_pop" = "site_pop" + ) + } else { + site_subpop_spine <- tibble::tibble( + "site_index" = NA, + "site" = NA, + "subpop_pop" = total_pop, + "subpop_index" = 1, + "subpop_name" = "total population" + ) + } + + return(site_subpop_spine) +} + +#' Get lab-site subpopulation spine +#' +#' @param lab_site_site_spine tibble mapping lab-sites to sites +#' @param site_subpop_spine tibble mapping sites to subpopulations +#' +#' @return a tibble mapping lab-sites to subpopulations +#' @export +#' +get_lab_site_subpop_spine <- function(lab_site_site_spine, + site_subpop_spine) { + ww_data_present <- !nrow(lab_site_site_spine) == 0 + # Get lab_site to subpop spine + if (ww_data_present) { + lab_site_subpop_spine <- lab_site_site_spine |> + dplyr::left_join(site_subpop_spine, by = c("site_index", "site")) + } else { + lab_site_subpop_spine <- tibble::tibble( + subpop_index = numeric() + ) + } + + return(lab_site_subpop_spine) } + #' Get stan data for ww + hosp model #' -#' @param input_count_data a dataframe of the count data to be passed -#' directly to stan, , must have the following columns: date, count, total_pop -#' @param input_ww_data a dataframe of the wastewater data to be passed -#' directly to stan, must have the following columns: date, site, lab, -#' genome_copies_per_ml, site_pop, below_lod, and exclude + +#' @param input_count_data tibble with the input count data needed for stan +#' @param input_ww_data tibble with the input wastewater data and indices +#' needed for stan +#' @param date_time_spine tibble mapping dates to time in days +#' @param lab_site_site_spine tibble mapping lab-sites to sites +#' @param site_subpop_spine tibble mapping sites to subpopulations +#' @param lab_site_subpop_spine tibble mapping lab-sites to subpopulations +#' @param last_count_data_date string indicating the date of the last data +#' point in the count dataset in ISO8601 convention e.g. YYYY-MM-DD +#' @param first_count_data_date string indicating the date of the first data +#' point in the count dataset in ISO8601 convention e.g. YYYY-MM-DD #' @param forecast_date string indicating the forecast date in ISO8601 #' convention e.g. YYYY-MM-DD #' @param forecast_horizon integer indicating the number of days to make a @@ -189,9 +351,35 @@ get_input_ww_data_for_stan <- function(preprocessed_ww_data, #' last_count_data_date, #' calibration_time #' ) +#' date_time_spine <- get_date_time_spine( +#' forecast_date = forecast_date, +#' input_count_data = input_count_data_for_stan, +#' last_count_data_date = last_count_data_date, +#' forecast_horizon = forecast_horizon, +#' calibration_time = calibration_time +#' ) +#' lab_site_site_spine <- get_lab_site_site_spine( +#' input_ww_data = input_ww_data_for_stan +#' ) +#' site_subpop_spine <- get_site_subpop_spine( +#' input_ww_data = input_ww_data_for_stan, +#' input_count_data = input_count_data_for_stan +#' ) +#' lab_site_subpop_spine <- get_lab_site_subpop_spine( +#' lab_site_site_spine = lab_site_site_spine, +#' site_subpop_spine +#' ) +#' +#' #' stan_data_list <- get_stan_data( #' input_count_data_for_stan, #' input_ww_data_for_stan, +#' date_time_spine, +#' lab_site_site_spine, +#' site_subpop_spine, +#' lab_site_subpop_spine, +#' last_count_data_date, +#' first_count_data_date, #' forecast_date, #' forecast_horizon, #' calibration_time, @@ -203,6 +391,12 @@ get_input_ww_data_for_stan <- function(preprocessed_ww_data, #' ) get_stan_data <- function(input_count_data, input_ww_data, + date_time_spine, + lab_site_site_spine, + site_subpop_spine, + lab_site_subpop_spine, + last_count_data_date, + first_count_data_date, forecast_date, forecast_horizon, calibration_time, @@ -212,6 +406,7 @@ get_stan_data <- function(input_count_data, params, include_ww, compute_likelihood = 1) { + # Validate input pmfs---------------------------------------------------- validate_pmf(generation_interval, calibration_time, input_count_data, @@ -228,14 +423,21 @@ get_stan_data <- function(input_count_data, arg = "infection to count delay" ) - validate_both_datasets( - input_count_data, - input_ww_data, - calibration_time = calibration_time, - forecast_date = forecast_date - ) - + # Validate both datasets if both are used---------------------------------- + if (include_ww == 1) { + validate_both_datasets( + input_count_data = input_count_data, + input_ww_data = input_ww_data, + date_time_spine = date_time_spine, + lab_site_site_spine = lab_site_site_spine, + site_subpop_spine = site_subpop_spine, + lab_site_subpop_spine = lab_site_subpop_spine, + calibration_time = calibration_time, + forecast_date = forecast_date + ) + } + # Define some global variables from the input data----------------------- # Get the total pop, coming from the larger population generating the # count data pop <- input_count_data |> @@ -250,59 +452,33 @@ get_stan_data <- function(input_count_data, ) ) - last_count_data_date <- max(input_count_data$date, na.rm = TRUE) - first_count_data_date <- min(input_count_data$date, na.rm = TRUE) - # Returns a list of the vectors of lod values, the site population sizes in - # order of the site index, a vector of observations of the log of - # the genome copies per ml - ww_values <- get_ww_values( - input_ww_data - ) + # Get wastewater inputs------------------------------------------------- + # Returns a list with the numbers of elements needed for the stan model ww_data_sizes <- get_ww_data_sizes( input_ww_data ) - # Returns the vectors of indices you need to map latent variables to - # observations - ww_indices <- get_ww_data_indices( - input_ww_data |> dplyr::select(-"t"), - first_count_data_date, - owt = ww_data_sizes$owt + + ww_vals <- get_ww_indices_and_values( + input_ww_data = input_ww_data, + date_time_spine = date_time_spine, + lab_site_site_spine = lab_site_site_spine, + site_subpop_spine = site_subpop_spine, + lab_site_subpop_spine = lab_site_subpop_spine ) - # Ensure that both datasets have overlap with one another, are sufficient - # in length for the specified calibration time, and have proper time indexing stopifnot( "Wastewater sampled times not equal to length of input ww data" = - length(ww_indices$ww_sampled_times) == ww_data_sizes$owt + length(ww_vals$ww_sampled_times) == ww_data_sizes$owt ) message( "Prop of population size covered by wastewater: ", - sum(ww_values$pop_ww) / pop + sum(unique(input_ww_data$site_pop)) / pop ) - if (sum(ww_values$pop_ww) / pop > 1) { - cli::cli_warn(c( - "The sum of the wastewater site catchment area populations:", - "is greater than the global population. While the model supports this", - "we advise checking your input data to ensure it is specified correctly." - )) - } - - - # Logic to determine the number of subpopulations to estimate R(t) for: - # First determine if we need to add an additional subpopulation - add_auxiliary_site <- ifelse(pop >= sum(ww_values$pop_ww), TRUE, FALSE) - # Then get the number of subpopulations, the population to normalize by - # (sum of the subpopulations), and the vector of sizes of each subpopulation - subpop_data <- get_subpop_data(add_auxiliary_site, - state_pop = pop, - pop_ww = ww_values$pop_ww, - n_ww_sites = ww_data_sizes$n_ww_sites - ) - # Get the sizes of all the elements + # Get count data inputs----------------------------------------------- count_data_sizes <- get_count_data_sizes( input_count_data = input_count_data, forecast_date = forecast_date, @@ -357,7 +533,7 @@ get_stan_data <- function(input_count_data, inf_to_hosp = inf_to_count_delay, mwpd = params$ml_of_ww_per_person_day, ot = count_data_sizes$ot, - n_subpops = subpop_data$n_subpops, + n_subpops = length(ww_vals$subpop_pops), n_ww_sites = ww_data_sizes$n_ww_sites, n_ww_lab_sites = ww_data_sizes$n_ww_lab_sites, owt = ww_data_sizes$owt, @@ -373,17 +549,19 @@ get_stan_data <- function(input_count_data, generation_interval = generation_interval, ts = 1:params$gt_max, state_pop = pop, - subpop_size = subpop_data$subpop_size, - norm_pop = subpop_data$norm_pop, - ww_sampled_times = ww_indices$ww_sampled_times, + subpop_size = ww_vals$subpop_pops, + norm_pop = sum(site_subpop_spine$subpop_pop), + ww_sampled_times = ww_vals$ww_sampled_times, hosp_times = count_indices$count_times, - ww_sampled_lab_sites = ww_indices$ww_sampled_lab_sites, - ww_log_lod = ww_values$ww_lod, - ww_censored = ww_indices$ww_censored, - ww_uncensored = ww_indices$ww_uncensored, + ww_sampled_subpops = ww_vals$ww_sampled_subpops, + lab_site_to_subpop_map = lab_site_subpop_spine$subpop_index, + ww_sampled_lab_sites = ww_vals$ww_sampled_lab_sites, + ww_log_lod = ww_vals$ww_lod, + ww_censored = ww_vals$ww_censored, + ww_uncensored = ww_vals$ww_uncensored, hosp = count_values$counts, day_of_week = count_values$day_of_week, - log_conc = ww_values$log_conc, + log_conc = ww_vals$log_conc, compute_likelihood = compute_likelihood, include_ww = include_ww, include_hosp = 1, @@ -393,8 +571,8 @@ get_stan_data <- function(input_count_data, viral_shedding_pars = viral_shedding_pars, # tpeak, viral peak, dur_shed autoreg_rt_a = params$autoreg_rt_a, autoreg_rt_b = params$autoreg_rt_b, - autoreg_rt_site_a = params$autoreg_rt_site_a, - autoreg_rt_site_b = params$autoreg_rt_site_b, + autoreg_rt_subpop_a = params$autoreg_rt_subpop_a, + autoreg_rt_subpop_b = params$autoreg_rt_subpop_b, autoreg_p_hosp_a = params$autoreg_p_hosp_a, autoreg_p_hosp_b = params$autoreg_p_hosp_b, inv_sqrt_phi_prior_mean = params$inv_sqrt_phi_prior_mean, @@ -437,11 +615,18 @@ get_stan_data <- function(input_count_data, sigma_rt_prior = params$sigma_rt_prior, log_phi_g_prior_mean = params$log_phi_g_prior_mean, log_phi_g_prior_sd = params$log_phi_g_prior_sd, - ww_sampled_sites = ww_indices$ww_sampled_sites, - lab_site_to_site_map = ww_indices$lab_site_to_site_map + offset_ref_log_r_t_prior_mean = params$offset_ref_log_r_t_prior_mean, + offset_ref_log_r_t_prior_sd = params$offset_ref_log_r_t_prior_sd, + offset_ref_logit_i_first_obs_prior_mean = + params$offset_ref_logit_i_first_obs_prior_mean, + offset_ref_logit_i_first_obs_prior_sd = + params$offset_ref_logit_i_first_obs_prior_sd, + offset_ref_initial_exp_growth_rate_prior_mean = + params$offset_ref_initial_exp_growth_rate_prior_mean, + offset_ref_initial_exp_growth_rate_prior_sd = + params$offset_ref_initial_exp_growth_rate_prior_sd ) - return(stan_data_list) } @@ -506,192 +691,97 @@ get_ww_data_sizes <- function(ww_data, return(data_sizes) } -#' Get wastewater data indices +#' Get wastewater indices and values for stan #' -#' @param ww_data Input wastewater dataframe containing one row -#' per observation, with outliers already removed -#' @param first_count_data_date The earliest day with an observation in the ' -#' count dataset, in ISO8601 format YYYY-MM-DD -#' @param owt number of wastewater observations -#' @param lod_col_name A string representing the name of the -#' column in the input_ww_data that provides a 0 if the data point is not above -#' the LOD and a 1 if the data is below the LOD, default value is `below_LOD` +#' @param input_ww_data tibble with the input wastewater data and indices +#' needed for stan +#' @param date_time_spine tibble mapping dates to time in days +#' @param lab_site_site_spine tibble mapping lab-sites to sites +#' @param site_subpop_spine tibble mapping sites to subpopulations +#' @param lab_site_subpop_spine tibble mapping lab-sites to subpopulations #' -#' @return A list containing the necessary vectors of indices that -#' the stan model requires: -#' ww_censored: the vector of time points that the wastewater observations are -#' censored (below the LOD) in order of the date and the site index -#' ww_uncensored: the vector of time points that the wastewater observations are -#' uncensored (above the LOD) in order of the date and the site index -#' ww_sampled_times: the vector of time points that the wastewater observations -#' are passed in in log_conc in order of the date and the site index -#' ww_sampled_sites: the vector of sites that correspond to the observations -#' passed in in log_conc in order of the date and the site index -#' ww_sampled_lab_sites: the vector of unique combinations of site and labs -#' that correspond to the observations passed in in log_conc in order of the -#' date and the site index -#' lab_site_to_site_map: the vector of sites that correspond to each lab-site +#' @return a list of the vectors needed for stan #' @export -get_ww_data_indices <- function(ww_data, - first_count_data_date, - owt, - lod_col_name = "below_lod") { - # Vector of indices along the list of wastewater concentrations that - # correspond to censored observations - ww_data_present <- nrow(ww_data) != 0 +get_ww_indices_and_values <- function(input_ww_data, + date_time_spine, + lab_site_site_spine, + site_subpop_spine, + lab_site_subpop_spine) { + ww_data_present <- !is.null(input_ww_data) + + # Get a vector of population sizes for each subpop + subpop_pops <- site_subpop_spine |> + dplyr::select("subpop_index", "subpop_pop") |> + dplyr::arrange(.data$subpop_index, "desc") |> + dplyr::pull(.data$subpop_pop) if (isTRUE(ww_data_present)) { - ww_data_with_index <- ww_data |> - dplyr::mutate(ind_rel_to_sampled_times = dplyr::row_number()) - ww_censored <- ww_data_with_index |> - dplyr::filter(.data[[lod_col_name]] == 1) |> - dplyr::pull(.data$ind_rel_to_sampled_times) - ww_uncensored <- ww_data_with_index |> - dplyr::filter(.data[[lod_col_name]] == 0) |> - dplyr::pull(.data$ind_rel_to_sampled_times) - stopifnot( - "Length of censored vectors incorrect" = - length(ww_censored) + length(ww_uncensored) == owt - ) - + ww_data_joined <- input_ww_data |> + dplyr::left_join(date_time_spine, by = "date") |> + dplyr::left_join(site_subpop_spine, by = c("site_index", "site")) |> + dplyr::mutate("ind_rel_to_sampled_times" = dplyr::row_number()) - # Need to get the times of wastewater sampling, starting at the first - # day of hospital admissions data - ww_date_df <- data.frame( - date = seq( - from = first_count_data_date, - to = max(ww_data$date), - by = "days" - ), - t = 1:(as.integer(max(ww_data$date) - first_count_data_date) + 1) - ) + owt <- nrow(ww_data_joined) - # Left join the data mapped to time to the wastewater data - spine_ww <- ww_data |> - dplyr::left_join(ww_date_df, by = "date") - # Pull just the vector of times of wastewater observations - ww_sampled_times <- spine_ww |> - dplyr::pull(t) - # Pull just the indexes of the sites that correspond to the vector of - # sampled times - ww_sampled_sites <- ww_data$site_index + # Get the vector of log LOD values corresponding to each observation + ww_lod <- ww_data_joined |> + dplyr::pull("log_lod") - # Pull just the indexes of the lab-sites that correspond to the vector of - # sampled times - ww_sampled_lab_sites <- ww_data$lab_site_index - # Need a vector of indices indicating the site for each lab-site - lab_site_to_site_map <- ww_data |> - dplyr::select("lab_site_index", "site_index") |> - dplyr::arrange(.data$lab_site_index, "desc") |> - dplyr::distinct() |> - dplyr::pull(.data$site_index) + # Get the vector of log wastewater concentrations + log_conc <- ww_data_joined |> + dplyr::pull("log_genome_copies_per_ml") - ww_data_indices <- list( - ww_censored = ww_censored, - ww_uncensored = ww_uncensored, - ww_sampled_times = ww_sampled_times, - ww_sampled_sites = ww_sampled_sites, - ww_sampled_lab_sites = ww_sampled_lab_sites, - lab_site_to_site_map = lab_site_to_site_map - ) - } else { - ww_data_indices <- list( - ww_censored = c(), - ww_uncensored = c(), - ww_sampled_times = c(), - ww_sampled_sites = c(), - ww_sampled_lab_sites = c(), - lab_site_to_site_map = c() + # Get censored and uncensored indices, which are relative to the vector + # of sampled times (e.g. 1:owt) + ww_censored <- ww_data_joined |> + dplyr::filter(.data$below_lod == 1) |> + dplyr::pull(.data$ind_rel_to_sampled_times) + ww_uncensored <- ww_data_joined |> + dplyr::filter(.data$below_lod == 0) |> + dplyr::pull(.data$ind_rel_to_sampled_times) + stopifnot( + "Length of censored vectors incorrect" = + length(ww_censored) + length(ww_uncensored) == owt ) - } - - - return(ww_data_indices) -} - -#' Get wastewater data values -#' -#' @param ww_data Input wastewater dataframe containing one row -#' per observation, with outliers already removed -#' @param ww_measurement_col_name A string representing the name of the column -#' in the input_ww_data that indicates the wastewater measurement value in -#' log scale, default is `log_genome_copies_per_ml` -#' @param ww_lod_value_col_name A string representing the name of the column -#' in the ww_data that indicates the value of the LOD in log scale, -#' default is `log_lod` -#' @param ww_site_pop_col_name A string representing the name of the column in -#' the ww_data that indicates the number of people represented by that -#' wastewater catchment, default is `site_pop` -#' @param one_pop_per_site a boolean variable indicating if there should only -#' be on catchment area population per site, default is `TRUE` because this is -#' what the stan model expects -#' @param padding_value an smaller numeric value to add to the the -#' concentration measurements to ensure that log transformation will produce -#' real numbers, default value is `1e-8` -#' -#' @return A list containing the necessary vectors of values that -#' the stan model requires: -#' ww_lod: a vector of the LODs of the corresponding wastewater measurement -#' pop_ww: a vector of the population sizes of the wastewater catchment areas -#' in order of the sites by site_index -#' log_conc: a vector of the log of the wastewater concentration observation -#' @export -get_ww_values <- function(ww_data, - ww_measurement_col_name = "log_genome_copies_per_ml", - ww_lod_value_col_name = "log_lod", - ww_site_pop_col_name = "site_pop", - one_pop_per_site = TRUE, - padding_value = 1e-8) { - ww_data_present <- nrow(ww_data) != 0 - if (isTRUE(ww_data_present)) { - # Get the vector of log LOD values corresponding to each observation - ww_lod <- ww_data |> - dplyr::pull({{ ww_lod_value_col_name }}) - - # Get a vector of population sizes - if (isTRUE(one_pop_per_site)) { - # Want one population per site during the model calibration period, - # so just take the average across the populations reported for each - # observation - pop_ww <- ww_data |> - dplyr::select("site_index", {{ ww_site_pop_col_name }}) |> - dplyr::group_by(.data$site_index) |> - dplyr::summarise(pop_avg = mean(.data[[ww_site_pop_col_name]])) |> - dplyr::arrange(.data$site_index, "desc") |> - dplyr::pull(.data$pop_avg) - } else { - # Want a vector of length of the number of observations, corresponding to - # the population at that time - pop_ww <- ww_data |> - dplyr::pull({{ ww_site_pop_col_name }}) - } + ww_sampled_times <- ww_data_joined |> dplyr::pull("t") + ww_sampled_subpops <- ww_data_joined |> dplyr::pull("subpop_index") + lab_site_to_subpop_spine <- lab_site_site_spine |> + dplyr::left_join(site_subpop_spine, by = "site_index") |> + pull("subpop_index") + ww_sampled_lab_sites <- ww_data_joined |> dplyr::pull("lab_site_index") - # Get the vector of log wastewater concentrations - log_conc <- ww_data |> - dplyr::pull({{ ww_measurement_col_name }}) ww_values <- list( ww_lod = ww_lod, - pop_ww = pop_ww, - log_conc = log_conc + subpop_pops = subpop_pops, + log_conc = log_conc, + ww_censored = ww_censored, + ww_uncensored = ww_uncensored, + ww_sampled_times = ww_sampled_times, + ww_sampled_subpops = ww_sampled_subpops, + ww_sampled_lab_sites = ww_sampled_lab_sites ) } else { ww_values <- list( - ww_lod = c(), - pop_ww = c(), - log_conc = c() + ww_lod = numeric(), + subpop_pops = subpop_pops, + log_conc = numeric(), + ww_censored = numeric(), + ww_uncensored = numeric(), + ww_sampled_times = numeric(), + ww_sampled_subpops = numeric(), + ww_sampled_lab_sites = numeric() ) } - - return(ww_values) } + #' Add time indexing to count data #' #' @param input_count_data data frame with dates and counts, @@ -723,46 +813,6 @@ add_time_indexing <- function(input_count_data) { return(count_data) } -#' Get subpopulation data -#' -#' @param add_auxiliary_site Boolean indicating whether to add another -#' subpopulation in addition to the wastewater sites to estimate R(t) of -#' @param state_pop The state population size -#' @param pop_ww The population size in each of the wastewater sites -#' @param n_ww_sites The number of wastewater sites -#' -#' @return A list containing the necessary integers and vectors that stan -#' needs to estiamte infection dynamics for each subpopulation -#' @export -#' -#' @examples subpop_data <- get_subpop_data(TRUE, 100000, c(1000, 500), 2) -get_subpop_data <- function(add_auxiliary_site, - state_pop, - pop_ww, - n_ww_sites) { - if (add_auxiliary_site) { - # In most cases, wastewater catchment coverage < entire state. - # So here we add a subpopulation that represents the population not - # covered by wastewater surveillance - norm_pop <- state_pop - n_subpops <- n_ww_sites + 1 - subpop_size <- c(pop_ww, state_pop - sum(pop_ww)) - } else { - message("Sum of wastewater catchment areas is greater than state pop") - norm_pop <- sum(pop_ww) - # If sum catchment areas > state pop, - # use sum of catchment area pop to normalize - n_subpops <- n_ww_sites # Only divide the state into n_site subpops - subpop_size <- pop_ww - } - - subpop_data <- list( - norm_pop = norm_pop, - n_subpops = n_subpops, - subpop_size = subpop_size - ) - return(subpop_data) -} #' Get count data integer sizes for stan #' diff --git a/R/initialization.R b/R/initialization.R index 04cf8172..18a3ca93 100644 --- a/R/initialization.R +++ b/R/initialization.R @@ -30,10 +30,25 @@ get_inits_for_one_chain <- function(stan_data, stdev = 0.01) { init_list <- list( w = stats::rnorm(n_weeks - 1, 0, stdev), + offset_ref_log_r_t = stats::rnorm( + stan_data$n_subpops > 1, + stan_data$offset_ref_log_r_t_prior_mean, + stdev + ), + offset_ref_logit_i_first_obs = stats::rnorm( + stan_data$n_subpops > 1, + stan_data$offset_ref_logit_i_first_obs_prior_mean, + stdev + ), + offset_ref_initial_exp_growth_rate = stats::rnorm( + stan_data$n_subpops > 1, + stan_data$offset_ref_initial_exp_growth_rate_prior_mean, + stdev + ), eta_sd = abs(stats::rnorm(1, 0, stdev)), - eta_i_first_obs = abs(stats::rnorm(n_subpops, 0, stdev)), + eta_i_first_obs = abs(stats::rnorm((n_subpops - 1), 0, stdev)), sigma_i_first_obs = abs(stats::rnorm(1, 0, stdev)), - eta_initial_exp_growth_rate = abs(stats::rnorm(n_subpops, 0, stdev)), + eta_initial_exp_growth_rate = abs(stats::rnorm((n_subpops - 1), 0, stdev)), sigma_initial_exp_growth_rate = abs(stats::rnorm(1, 0, stdev)), autoreg_rt = abs(stats::rnorm( 1, @@ -41,20 +56,12 @@ get_inits_for_one_chain <- function(stan_data, stdev = 0.01) { (stan_data$autoreg_rt_a + stan_data$autoreg_rt_b), 0.05 )), - log_r_mu_intercept = stats::rnorm( + log_r_t_first_obs = stats::rnorm( 1, convert_to_logmean(1, stdev), convert_to_logsd(1, stdev) ), - error_site = matrix( - stats::rnorm(n_subpops * n_weeks, - mean = 0, - sd = stdev - ), - n_subpops, - n_weeks - ), - autoreg_rt_site = abs(stats::rnorm(1, 0.5, 0.05)), + autoreg_rt_subpop = abs(stats::rnorm(1, 0.5, 0.05)), autoreg_p_hosp = abs(stats::rnorm(1, 1 / 100, 0.001)), sigma_rt = abs(stats::rnorm(1, 0, stdev)), i_first_obs_over_n = @@ -96,5 +103,17 @@ get_inits_for_one_chain <- function(stan_data, stdev = 0.01) { )), infection_feedback = abs(stats::rnorm(1, 500, 20)) ) + + if (stan_data$n_subpops > 1) { + init_list$error_subpop <- matrix( + stats::rnorm((n_subpops - 1) * n_weeks, + mean = 0, + sd = stdev + ), + (n_subpops - 1), + n_weeks + ) + } + return(init_list) } diff --git a/R/model_diagnostics.R b/R/model_diagnostics.R index 1f71b366..489f3a43 100644 --- a/R/model_diagnostics.R +++ b/R/model_diagnostics.R @@ -102,5 +102,17 @@ get_model_diagnostic_flags.default <- function(x, #' @family diagnostics #' @export parameter_diagnostics <- function(ww_fit, ...) { + ww_fit$fit$result$summary() +} + +#' Method for printing the CmdStan summary diagnostics for +#' wwinference_fit_object +#' +#' @param ww_fit An object of class wwinference_fit +#' @param ... additional arguments +#' +#' @family diagnostics +#' @export +summary_diagnostics <- function(ww_fit, ...) { ww_fit$fit$result$diagnostic_summary(quiet = TRUE) } diff --git a/R/preprocessing.R b/R/preprocessing.R index 1a8838df..29cbbcc6 100644 --- a/R/preprocessing.R +++ b/R/preprocessing.R @@ -46,12 +46,15 @@ preprocess_ww_data <- function(ww_data, lod_col_name = lod_col_name ) - + # Order by site population so the first site index corresponds largest pop + ww_data_ordered <- ww_data |> + dplyr::arrange(desc(.data$site_pop)) # Add some columns - ww_data_add_cols <- ww_data |> + ww_data_add_cols <- ww_data_ordered |> + dplyr::ungroup() |> dplyr::left_join( - ww_data |> + ww_data_ordered |> dplyr::distinct(.data$lab, .data$site) |> dplyr::mutate( lab_site_index = dplyr::row_number() @@ -59,7 +62,7 @@ preprocess_ww_data <- function(ww_data, by = c("lab", "site") ) |> dplyr::left_join( - ww_data |> + ww_data_ordered |> dplyr::distinct(.data$site) |> dplyr::mutate(site_index = dplyr::row_number()), by = "site" @@ -183,7 +186,7 @@ flag_ww_outliers <- function(ww_data, .data$n_data_points > !!threshold_n_dps ) |> dplyr::group_by(.data$lab_site_index) |> - dplyr::arrange(.data$date, "desc") |> + dplyr::arrange(desc(.data$date)) |> dplyr::mutate( log_conc = .data[[conc_col_name]], prev_log_conc = dplyr::lag(.data$log_conc, 1), diff --git a/R/sysdata.rda b/R/sysdata.rda deleted file mode 100644 index 60e01c46ff0c8dfd177db08b7b26b789bde9186c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 38166 zcmb@q1yCJZw>7$v;0^(Ty9IZbAi;e@kl?}H-8Hxc-?&3?cX!v|?i$=54i1D2gqSx4f=_0&w=^J8nnKK*m31P+ zBrlOv8fG9bEKxd4-h_nJ05;=wt8}t)w+;odf4@nduvijUtPGS`G6b9pf;WH_5rPN+ z0M`NJhlF?oz_N5EiayAhrf?i9#sd)ntgJY%yRV=N08rkqlmB%<6&0nwoLL%_(BD~J_nQxR3a%#J3z3z6EF^l zdy>p$!vPhsPg2N<8$%J-5F|&+PecJajmMdoSdAII$C(WPU>P5naIj?n6B&BA@;C-> zQ-nal*T(~hiTPwe2n!}L71q3NU0`K429uMf$d8p4lgR+f<(*(O z2Eh7aCxeoeT$ptrL1Gl>q%v}>h4+NbZD~!07Wp5)Wf}gMoWiZv&|6dz6SJsIF>|b) zsInMgsmV5}bu?j14?8$%cCXx^J0GYJb0l;?8|BZH@i2x=iVpqyyYZ5h%COvHsuMT$ zQ?Glv3d6m=e8;J5_e;I{Pm>oq4(h`B3Zg=X#dlJ&1Lp_BmRj#}F?zp!s|p`9t<#z< zWi=xP5^&Zl?_i56?|FEs{lwCISh*2sH(QQw(o>^a&`4);;;s9pMR0GDjq`{*!cNI> zDhxpM>A;2dAD!}N-h~IPhu2!~qDqXxAUT0b*szEWaKWNRgzLR}JfTouAIil3lN}MTg$g%bN zP-AB5FwkXlfJvb%opISuVZg`2d=Zk4k-?zS?JPYwI=cF4wD&O-jn>?3ez?n?m*CqC zW*}5-!8{hFrcIOpmY8q%j){?sqi(i@?GFRAFU?v%vU17ABKgdun7gchtb)9QM8K@o zz8aAm$<5liK~5uTt2MEvYqa}@5;!zCAz{-nh?*Aac1$ZnM(cgn;N%pH8pGp!H;qPS z5X?-IO$7Vt2V6JympTJTv?-n1k48eqv_*BW`gVd*B2|Vz%qrPM%*Lp@I_Nr=;T^rJ zi@yTj6CsX#F9KHR1q+CVvwZ@`2=-f%XLUnra%$h@Z2H>LW(4hD48Ng%@Vt`s05++6 zcB`xiK$mPFr;&N4KP6(;BD|&$rC_nZ$m7e3@9A#5M(`Iz1xTiKbi?_0)$22yPz8{y z0Dv`+C}N@*iOpYo`IOb=9TWqgdW14JL*5OD_4H5z9N%M0C2FWsjIc3E%FKU&a`{?zP`e{sZ<_TuSYQRKI13S2nJMhK(cRPa9q*G@`w*c zkKn*U7L|IiA`JL)yF#w=JF#dXn`l(Vy0}kG7~sS3^S)p<0JLl@+9k!NV9bp#6~OP` zyOoqx6@7gkGcuB4Y*7)c!KwTK5G?O7x<%h9+~{}{J^H@~GxJOPRd|zm+3s9PLSYq= z{bI(yV)dXWhr3-7d)^#I2pXi_ z<$I|YM-t8+ei8W3Of}mMHEa&&tLDDH@d!K^+Rs~+s0;Wk6LPSrbCjaL^UCR%uXf4=TP=Fy6eOo+ z^-hO^2OlKY4<|W&xwXdYIvdjZSaTY9HR6De9p?>#siesx9)z{Jl8_Tek6de54 z0STa?Oy!@biFIjE0E+6hn830$RDsyu>?v(M-Y9T6zp$5?mg zgyc-Dk(FEg^Q&2=f+n1_MNwai3(sc+oBVTRWF-K^C5Lp5OI=+asSiQ{V|*9wxL;DD z7uNtd1P;YbW;Y3L6qGJqEs@bz9*&LhWha2&|M&!UtsvAD+0 zN~MC40BYgV1_e?WA@i0IWicfvQ=-gnLeE~l!qm11o&T!t)|ZaHFq1Y#dwJspe8|;7=Y$EX5?|vvt*x;P)SY+kw z;gg2}^QPZ8=fT9Lycg|f%(xwfi6v4ZqUlXsewutmZ8gIQ1_ywi=cn3<1ih8Q9#*N; zWIif0vL6h7KYV%@aO!vLWX?6c$#pC|JdSg%yXzLo5WW+Bvp1}-2EhdPNm7uQFZeu= z42E0h<%3TYo<)OAm${%trrw3g)$I#L(4qQ#W%GqHaZCaR67kJK$q#TXRJm;orFSSo z(hTT}JCy={c3)+7KJLhox<9!`$Y1km^ca%TYxHNcN3R(}ox=kjM3o%+FK+FU&N&NO`A_I;@FpT3w4kXI#jz$1!?j4`>T!?x zY-2Q;t$D9Whl$2BV0^lhqsC@)x_6iWettsjWa!tNo8yVW!G1_Fp%6aAcLoTjtgd`#W?&q3>iDgdXBBCkw)8o*%rl=w{?FMX#D-6oGQ`6hG}Sd zP3VnNlS2_H%J7aTvVHvX#Tlrt@YwARIfp;l9R1sJLsJK0`(Xv97ZAc$OVOKepWi<@ zqlkh=+{FkLg?O70Knf`!3EiZZw}2UxGt;`t3tO?-h;E70=iAVc+(JBy`)G|Htm}}; zj*?3PiSo`_d`;Le$IkplW1S`yMNx15(FaTc^_SC-c=?K5pS4+k5bk6O+I-4_Q=KB5 zZWbmUrf>Yk$rh$Ycbax+8yCsYHx2Zai3*oM?GVWsE8C_0G?-|gM?u@z>_==fG;POw zU!sKyApm~?NdmcQl2_9-{!9=DD0er1!~9-=dmwSm*gdxqYT|o-65+y*xbcVHufTIHYeTMX35{pl!N_v@L~{&U1oaDyKRSD9`o+wbsXg;=n=68ss9xZ~<=TLdLJDoc?w8c<}2q*1y1?@HoV9 zN#A=v?`iyezz%|-o5(eZB#FEW0(1I4G;7h#@kkx^)C5A$SAUi^Ow%mG(h^|$W`&4# zneD=w!>i&{`Esc+=-IH^%@|WxoQ1(Urq*RPquL_;8JT~E-#S`Hl}pAmuxhb0q-~>a zvJ4KlRxD-iotHdb-^9#2`O7_x2rWyI3Ax|^uWwLM&*Qc^yGR6nPJ9q*mmbfw&ni|9 z)HZvYSH+HX;$|0);aU3G%lC0?wg!`5M-F|#7)90KNtA@SCFH*gjpx*%cgRR-6cUQr z%QvQv|=4J9L`n&6g0pS)R2@KjjyWn|t+L zZZO!_7bh$FPiu7^8Fk6nk~TQ69v3o$Qxj1M+xR>i#R<8l?cOLiQSb*A`b}FFyWJAr zU9ukN;5*rxqvc#?=}OEz--~mLJD#uRRSSQ_LYLGJV}r=ku|9i@IY10)*>G+zWZkpk z+Z0(rdTH8f9$FrJKxIQtKH9fJ%kt_zd(;bANZZHZ{yJ4KhrV4QD8FDFmq@1-{wTXn zTybbWub&&FN(kCy6Di<`EDHS0Cj+%uK8@{iYm|braz4Gld^y?vaJFRhN%TImT-a-Y zdTmZ<3R1W8yHOb)dnZa?gP;V5Huw1X zA7sMF7qhvT6;lB&MZe-Dj;+dk_CRA%(6W5f@P-?5T&x8j6x=0Fzk{-c`V1rkh?%% zN-LY6B1A8pq2k7dsz9DVX!e{>ofc4L4~}4lze9G#5N1G{B^Jly6~M-pB<}8*ZJ@KK zky3CJ-(BD6lR(UZ5pNsHn7&JQYv=S(0t@QAyD=PrzU$6mXTUIS2~!#1;LYokmk-p! zhS=Kr?z59+Tk&z*ajj4SYv5%8Iu~m>O++^P27{EbL6T<+ncJfTod-J1AlNDgDGO?! zzdp^;*ROgD=|Ex>1VJ4P4e`m3Em0o3ahcQ`+cdpB@<9V8^_i=WF36~HvqDo=$^Lz6oO(%c%J`RGe-kkG&}SAoS3`)R_YdFY3hI*p5$v}q&m!BKJvikgr&Q1T ze|%HxPcFk1;ergbqHm}K)makf*Gl=9$$q!c zCh(dzMB*+Q-REck%py{B=cSn&09O`Q-A(^IqF2wO8pto%MU5zouX4JyQ!-ud6y2rd zndbQ=`v+y|?$r1&o@;nNjA%nD0tY{OWiQUkNx8uZO6YWzk4BMogaBE)LqjGWL^;zL zsMKaXb;cz-k`p3tjGII8z36uFA;u6c^6FZlmmg+ur!UoJ5Ls73w;1x5woYKtP+v#@ zUW8}hWfy4082fl3eBk%^2uKDw4*s4mjIo=rg)njkbgon^J4)c9N~sWdqocs^Vu36b zNyQ(+6gB&D5+q;I9*%7Ngzr@ zj5QnL$0~Ukc4dY>cB6oWf;o&;XdJ4m(BkzDT`|K2q<@%%A5v7K-YPdzwFmmul_?Pb zf@V0jiTbCAo)TAe1hk$pOi?8@A*`ai=B@7!zAhp89ID z$3H-?&#j04xPG*PYTVpk-mnwPUu1R3p0wAUeU%&&Z&Mr0;^(?vsSCk(v3nsdOu~w* zo}SQ8ug9Pg+X-Xa?re(^&oj2B7zSk)s$T#w({oD657#3BQznnglRYzsB+qP9TPO;; z$f$>qsUZ}AnpC=&(o?1X)b*uV17>wRjQp7aPmoBQJSq{y%Ww>i?a`d zb4UHldMaaZa_#x-SB3gvy9KcoJTXQ*c-V-{9%;GLdUGsTvug-7(?@5%fix0sEyR;> zhTq_)5r}j?+I@&K><&<|;@Yw6Q{NW9a?L@$gAGE45(Gz5K7io*EvbUS=&MhESlao! zGoy0d9D#Z-y_V)3sp~ro%F!b8??w~xtqhh9swC;c)0hd7G2$>8H)`FN!#bE(^~Bx_ z@^;StNm!VoT~`x%nMZr-)&!VlwSW&O88E1buJ2cpJca=skpNR&N!rYe`9z|wvYCSn z12f1&(odPW97C;_L({kbp8I%O!yPO{U0IvbRi+qLLVX{vSn~8nE1xH(m*y*ioNk>Z zmLY?m5U#6&vhxtGsG~%#tpwsr1mLH*POG)|auWOh>&NT=_bWgk(f?fZ9w`1lFa77d zsp-$h{{LL~Kh6l+oSbz2k9Yt7y#WNi#k^1kS`uqednj2Cb%&1dE(wlvb-g3l&k=qWybHh0Ka(k!LYh88}f;bLcgNCx?-@_?c80h{j}oJi;;HN zd?bUf}?Nr(D5D|h&Sp}+JYZY&9*Y&c@e@cU+;O0}0JI60B3 zc*UN+bFi%<3K`h5ZaXx=)Mh^hK_}@E|NM~-0Sz(H>3Yb`j3?oJIMN-0pS*|VD)%S+ zXoME67VC!J&%krT8OaW`w;By3n zIKo^}q{#zOIAp~$`g0|@Wa&CrJTmZ91XsY9moN}G^2@* zauB+bj_={pYw8L0bR~>iIoWcQFpK;f_ry4JVNE+ znGXlD<7hC@det-87TtVUWXNyPqEahVGJP!dHvppb;k5OEy40>8uIS$b?>E3qeYU35 zOnr{m`(HP_Ia&_?x;|U;(`DtRC4pcDNK>?OGsd%W(*Oh_xqt!xGZ6odu^aUsC_h_` zbo=^SrH%AjgzoSpW9UUO;)pZ0bIR2^Ac2hJ~k>M~!~ zd5Wyyw)OZFafP9hVpHf9}j2A%jk20FCH(B0B7fA5mod2x^wLZ|2UDE3S zy%PT_sXw}!ZP;~Nxz=<80u#ZDL8f^|0B8a?n_ZCWZ1ZdAi@|?F=K~Pf{@w!;1OkQm zo}MmPSeh2o-kyi1s01t?s9O6br?C+Csm<1f&4Z<9%JhXNyU2};-wfKQyW53BoS&NWKDU8JzCo%+&VICIT8v8@ z{E?T77t0Wb1pV!dxmyR%0v=R=k5|rS{xJ4HRA!QHCTJ~DcTquM!QX)aO7hyC7%4eK@f(eXMnSyZIDZjPGe-1Z1Xe}z)$hJB$P3nT z`cHzF+Kt|{9MxYJ6*In5<(-ip1t9TWZ;tU^mA-~{*^U1vwk!bq-)0f$_VBP{XyjD) zY6&enK;Rb$avJ4A#azi4`OHrNa2Vu^Q*`~9433V8Jc}@~d}cF}Ics9orZ2q8%Ld0` z?gt(FoTLOM;Z|(aWk>J1Xbj>hdgjUmmt%bAm^15Gkr^ohNB{=GKIoDMpchk3b9G76 zhcuqWD1=HFq=xwYBDQ%0G*oh8@7@Khbmf}{u1Ki3Z&wnwBZNVSUeIW zg0_wmP#VNV;za+o5c9wD;HEy*Cox5`%tQ8cGsm{>@^`quSA~B`fxQlidH9OQuYR=) zdKqo)hz#PPXm4!7E8@EFJ9$O&sS75 z3E@LMwSg{hRqr(DUFE%Q?(AEn=1bcSLP0WAokszs^mF_-pnLM`iyr3I197&w@A9 zmBlAfKo*hNUdxWfOKf9%GZ!lGS9!#%bg`&kIk;QO)P7fSrq)#7srGraVl8g2LaezX z`&`IHJwELAnyDovCB9+zR(Dpu@e3XIfm;4{n|APj?523k@+}Qmc)7L!e*^sUUo|b& z<+zXQm7b(E#8cP*A^_yna{8^W2B_vu)38%yXbrI0ts`*R{o5x030-6j==wXg8n)g6 zm04C-S6NtiS{mL2!CX|-{s9Pdvw9_<`BrZ9!A%Rl;tPXj;|X#(8#R6gFYPYG1C%!l zzprgUHLmM>fMrOVx*m0aMPM716GTa16~>;HCJ{m z`xc^$2(*^g{-k|>o$LT--Cvsi$A%6uwYdMvlm8+A{~ZJWaw&md5iUh}EEZsnZN0V* z$oU3el9Nj_w+6EOV1l6Zp?lawMXA2mEl!9JkpG4J$oZW6&8o-Fx0ChX$dm9T{k53}J#jfDs;`C}jO(v$@MZHZM!}7ySGo-(I_lH=FlD|GjY5{NIbg zKdb&HNq^Uhzi+qeSb`za78qJ$NBY$Xu{V^&rh6)dBUv5`apwho11yS>=%Yma8R-z) z=5NN%^s3pExAv=fIGy+v881)ww=z2hfcr=+Mgb_82U$ zrTeeubM&nP9lo{S_9h*@kD1TLzC@!4rf39TXbp#I9Xf&Yq2|oNjwpm%hux3rg`Q5y z{QG!7pYN2Kt<4la&nF!c9atF^LJbQ?W&(LR`;VG`{^Ka=j{nR+Lt9t>*f@zz zqipSd<8sJM){hkX@ciNs24xpPza)_|SaG zr2I+Apv>oG7sY^dAmYpC_;y6p`(Dwb^*eqBnWEf&_Y+)xKvsj}aDmwXOf-qmAIO{w zFvPj-_Z?OCUyn{Dzh_=GK9xK5ufqYEIGMOe2pTLJDv5|+${Ewm>!%z&XIlg~r4X~N z#TPakVL_fQ;nyJ|LK6K4O0u}D=z&*Ysf3XJ2$$ghvvBQp>u}yg{kL8G7p87DK;WB= zue!hL_$INwsQ6XA!x!m)v^w|?uCKkP-5;dSz<|nC>QH~)U#e(|{%sR~Ln>UAG`NM% zm|)z^0Nu`5hm?@2fBN@-p88i0viYag_&a}7cV7FK*ClQ%f4PG4X5?F) zWNCkUBmARsmr>J_F#v%x)J^kF(Qr{w^JXOPn5W(Anm@5={zCN(Z1b(-aoK$f{@QUc zl^TC|leWier>N#l^;e5X_Q!k4exg_*-Qhxw)B4Tr6VM6D<#q|sh-dl-IC{S1Db*co zTXA^3jI0}*Y^hB;NYovyQTRiCr&X{9S&2LSHX7-EHh9=n9mYC;KyfBJg)VWKi4O4dkHeNw-6pD zVnV8Y48b~ZbOJ(sE9ssUTo{TmN}^IAV?sT>(c!TWWPDgGM`#ptm+fjRro`Cgsks5) zWH?+w4pMSr(b?+K#uka*|0Qz=&Wo2cKjV;2tb096d5O|U{)3IHUOoU7d0h)^%=Qss zlCVFU*`T5T23y`jyndB@`(rJ1d0bnBv?5B5%{=B)-K3?8wGC!MT#Xnluztuv8bb_b z*m4W0n_tBzG&M0o7Oy{kh0q?fj3!I8U9j0nUy6DQYmfB(lYv`$?>_=u`_cPNt6uYHb||og$|5 z9;v#uUhjg`iaw#9Rf?g(N)}|)Lboh!&`n*%u}FWIM|?R+Q+XwK znghhb8gd_{B(%|$?D|yB~g{M_v2W_j#W~(%I1lafG;&pI3~Kp<*>RkU(EXo zbeh2NQxAcoW1nM5IAHZzZFdrxqLJ4x1w#wk?E5Z|L$SQ(Kf?#UhtHSDTdnE>{+jYA zx4lol)H3iIb7lFdc)46rSjW9m7kq^WjhO0LD^J=tjn^pNJ~$8q_o>G#hW&&2w;L4N zM-f?w4?>1XOF$U^y+Czn=}7i)PR~oy4dPD)@-^?lOTKl9-;M+*ydb{cn~(6bR>Wl8 z@VCh6<25<&5I&5;nC`sjoU#7!`9_0Jo?EyFnXy_Y@XP~Z&#@mmx(0uu`NO#i193G4 zLYAOd7Msa>{SE3arV4Em;($@`6 zlKV@os3Cq!iS$SO?#IN+B?Kb^AP%C~M_)z0ZdlRwPHOvARk4@W?!fobr|k=Y2(Q`+FOM287txu4B?Dr+<^ed@9);AlQPQ)y&AaD)9vW>= z^{-}{hES_vnKdRvmJXVS&EX@*8%(Q}57@s0e~gA!-;OYN+1*L#@_7`)t!P5E9*-q& zcCVkMg+Bd^Pr;fuG5TOIg9`HSak6}@$s3?xdfY6td(J-W>qR-{2GRe(a45v$%q5T7dW!WUQ^>M|JLRruzKU#P z(GsYBJ9(LVermDwGBRcF^hH5C0v<+_126Bz3wrIw>S0Gr^z4kwjBWH8c<$uMm6p@$ zuWmJIhcehgiT~TvuKJmW=%__fMoQ#MQDg5mZ_6(pSi-6x#^>%xmPPB+!u|H?Wn(qI zq|xQ0&+mTt#cD?`?q0SW8=%dl3~rw9axCb)>b{X9*`iUHW9WIxDfy_OCJIY~+s0O7E2x3wmDi!A51 z3He%J_CtiQQ7Ob!et!C%QFXqB#IYA^f(Km*PgSTv%C1YmGf5v8oulSl(YQOG<@HaV zHoi-{JdRT}?Yb1_U*FB=3{!zh)yoWuT#Xoa5g-#!$2){EZRO*r>HX^n22B|&Jn5>@ zWWT$jj=`x)d!?yb>3iogfwPy2+v%jXgcXj;(*U52lj~BI@Pt}dzb=-V*gWS>iR&Xh zG78*C=|+_KsMVxf=@YDO19ZQ~H8(TeCP#vR#3~#q^2qxUR0cc|B>l@Jh^pk?W=t1* zG$I8@0!DFOGO4xNHXU_Sc}=TeMms0{;^$`THK=8MtArgfB((X1FA6&aoF6Be+XEJo zxOVAl6W|I7?v7CBl64JHg;!3x=ac3KcI6a?htHD8K^eg z&EXde>jx?+RYj#gaQ-%4hG|@7e~k$>44V|32jqYBGU=9$E7h^)PzQh8w=8y{$-W zPfu#C;=!@OcI_Z_t(KwD(&SPf19uR9m)62!(}FIF*@FwucO&+6l>-X(2=syI=v}3c zH@A-j+xcIEbh$S={L1z3zom12X*sI9mqQmSd)F7Jv%|aI9Ib&%6Y&F#M3iuQF*b0> zvT|Gk(=8~BVg*E@`jHLPHQT0cK2KJRsj`XhoT{Z)67Z99ez*oS{X}|txVroFfEe~! zk1hy4c|E6xs;-b*Y*xEync>Wy-Z5Q-TZAhPbmdtTXyy=KCAH1|WQ`?2Px5a2h<&w2 zGin>Zx;()m-YS0Io#TO43tEkMtjuUlczulP9u)e$18mAN=5n6osEm9h`zq}#iv(HPf{97y;u)7-_7!$R@ogd70W=- zD!WhFGj%JbvSsvV**{u;v-G6@7&O7PY^u~LIbTh`xH#Gka8Y6Suo9RI+*M;*zmamq zmDFgwE5tQ>&=U2u5$I&IrL#iidAs zboE929ORZJZFZz#2BHg1f}4r66FM~Mqc<}tyy3^G6UU6KG7j$Cn_NaQZA$sEpSoJh zl^@;h=ylvhb|%1eC%GDAReF*i@uR!fI4ytiCaH~+ZgthUxbD~RdL>V26^HJ`0i_%H zmfn-E+uSEJw(oUVpQ~rZEqAi==u)L>3L`!kj6qW(LX5Aey%2W0$p(@H@_Oi$p9dqv2>9w))&y zvx>O3Fg|XM&=Fyx9c)eJuM;!XK}`jI_dNN_w1#k3HTWVfS*=4UC9711BpCgq<=_x^ z`ZB6}6O2b(fS?mzap2xl`yGKuDAW)5{_1+TCb$EC%wmhftq7_1s|1LIRT$&+C!;S$ zy2JQ6=TB-)dNQ=>Ez|Z%n&gySt1>~Uhka(RIv_G>-O1uS8jFpb@o4cnomp6c2?`lg zHMD+0gpbgV`IQp=1KTi~;4=NEidd^6j9 zho1um74(^8xFl4Ymw|@5F@t%+X?25NI1KedCprFsacqe{0C6UYH~vfjm?@boFQ$E7G9Q z)G5HC;K0dPyplh?MP&s_P;&=C_}z{Poi#gK@wM<>!!JMBUTo7;SY7iUrY8J4@dCtF zbQV8clpk;u$#X)_I3ah51PO`htE%=TI_>Tu+L6{v^BrchT%EHD&y|*zdc`*uR*nuN zA*%Dr~y5gW9G{@8%p=C7H1 znUavU-@C)ZP+5Tm%WyLIJiKE#*{bdGouw~xVxa4}WNWSTF5RGpruwIT>tILUyR0Go zN|i4>G@9sfIP6+R@SKy!i4B?ND_#qW)x~072xj!DzlQzbnQI7V*)z^3K?;`@R=VX* zBQ@(c~Y;rMb9%^qund|6Zeg4$sl0#eZfUnnQ{E?%f5MM*i*Tu-=9D)BkcV>#;fZ@?j zAOK2m4~XP3Sp0fFh{5H zZB*Gbjg34*G79jAbK;xE28|ln6uLKCp$K0Pb^%Fgp&R!+q@>@A1uU%f?GGXTK+u80~ z;VreQb2*1~v!7nju|-d{o@XHYCfQ%^s_)ntyOyAQCcnaAic9_|Bbib)ops52`0+;4 z5%eBJ`t5thWKPM2C+?`DPz6A{zS4sQ7p{pQmeEiX*EPol_&Usg#*8mbZYbe4H)(%-$4vX0Nl zK306@)TmhqM*s&U8wu~+{Q6k1$N6}be-udmqA{3WQPn)fp(Zf7b2(w-af2`h3tPbgdv!KN6CTAEeua z6Oi)|zPlN^BMHlenaJxn)bW@jHl^^bpg{G<3%#5Z^ziZvdf{}78r87sPG5qQ1I` z;vrM&(XV@)vm;05gq)|^WmdxamyI2JF`E2%BTM|rS~q?|h`j@rd>&ZW3+UUcUodPm zPeV@?%#=gBlnyd;FZheEz3`ghQ`NuL^2t>sHQyhD@w`5}Y1JvHzV%0Pjebvr?t#&d z=E|LKcZzbqrOlocjwKt|TRlBHhQ20EyUvX*8O1--v0RjcW(9EV*hQzlWtezRxba+H z+AprKS1ioApFTHUIo>zWf9?1@nfZ+R>nDECF43kcI+~l9c3u+)gLF@BZ()QDaG{2I zDYZI5g$McDPI&8T^mB>n%_?l&=vQV1B|b`;Uj>!mpZP2NIue(HWx9jufYh{PD*~8qFHygvD%IlJ{3Fnu*kQmC$VF#m02P!% zYctA2@;L&CXn}elgo2k+&-kY%EkF&v;O@OAdSdyD^KFzq!Yo>JW|wxPhkm^|J4(2V zTFCqCY7-?XdQLljXt9(q9qQq1=Ot$oCaMqeUBTu9zUb(4f)AA4yt%8 zVE3Z%hdD-b4&u6emCPkJHw;BTd&Uz38n~}0>3Da(vUY6w=JW;Z2)PVXz)3d*xEhT2 zg4ynFPQ3#!6bIf@CCn4fxk#R2^S%R$bjsGgQ=M+@n1Y2L@HyP8r*dS?j%ldVhj%l) z*WI3JlxB0rEgr(+a9n~U>+bOYO)>QU?DRw&?Cr5De(@mSyoYa9h4u0Oy)Pc+9~J{f z=0}RU^c7mD+llh52J+I*uyFVh|!jU6e<4vZ5?YVC5Q*N`6cDf{h^ZET2Od^V)#MpC$=>Q7D$ zw*5^Ewmz$ze`?pG?e*Xs{}FaD9KFbbn3?URD%eD;x=G}j;GDa9Vl9W0VJs}SwSIuO zB#Y+nP}^P?+<=@^w`iofgo|eADx4G)Q0IJ9q4I*Lx`l9-=_6S_YS>6N%#;syAsz_x z(txdn7*T_#lI`|+xX*lbo(tC3jHH$MEDE?IeHSY6Y01Gzlx82*M&y9eE$3EXj|%A< zqb@pEKq-s&L>{eW%C2S7aAyq{)v6cs5yOEmt{0BWy7fHB2dQFSAC43T!cF)*L?lm` z$#fwm>Y^@rj2y;$30I3PhVniiK`!_Qoj`_pXi*w_FCIOkK>B34J+20zy?m55;M~NF zDH4WY&D9>VoX;N9ZPH%LrIB6!BSaz^24k51R*DWpHmpUI>58sgrtXLFLqz5f-220n z<=bNj(m9!_mvlaLM7@Mj#B88=YBQen3~>VNBauE*I=ekw?OfMVlL>is+wQcA#W&0+ z4DCJaTh1SV99&K;R7-Wi(WrI31Vy*d>ps9UrAXT*LqtD2`8{dSr9Yt(?w8?0h{BQp zne}TOCIC@ZsopdNxWvUawW7M0aM2H+OHI~PKD>YcHL-wz=?bA z(IU9=r4P0#DtYRI0s&nYF^O`+MAuHtw^YBKJe<%GY^AWYp#qigMfN3F3~XGnfY$Hn z-eVOu3P$b_!qjIuu)q@gp~TB|E2@)K=965Y#C77q)E)@4#u3Y5njhHWzc?+_5P8gA zSNUTTM6(%(TvA7S_->4j-mq#0p`&fgSb{S@jOU`Qnyp)H zvyIDQ{RxdhION8SR(rXA2~u*W5im87U%*HlrJ$r{X=L@;0lj^NJ`*Ao?ze0BF>bhQ zp)$=#PT~4)9jceF$io+;HBx2#YxlybV2FF^DZPs+IyFU;$gxU%LD`33?%NR&uZ$m| z9tT)!C~YBTw|v?n$4FK9*CD8Ctfs}ORmTpyFnSnGH;be3L99WP;PHvDZDqTo^WYB* zn%P;(&(Y+CL*#H<&_qJ?`q)&E%6*t3i;q#-L{4QU-1Y5n}Z=?n5PD`RFXHJ3h!k(C6; z_YMZgDM9q&Fwa&He-4M`%D64`g0@FlV*S}VF zvlXXR z7~M*Occ#}(XV&)3Y3Wyt1g&^0)NHVGK*xYUvkED@ieYS%E7hy$FUtfx7{sQxxK8{Q zYg+Q$dqFY{pXYO??7>0J?5>U>{FH~|(*|3dIVb)6f}<}BnmZQo`m{$!$DO}d3Objo z-9s2TpD_bH)62TDRc&y&4Lro89sb%*vX($r4t;dH50~G&8m6cElt^`zk{0F+G6u0 z*dAv2N=i8cIr&6<%imGgl%FE^IqH5Q75Bgv=N>fY1Iz*bkS81{#F)Tyo5WEM4KzH5 zpv}r<07JI%K{yCMYkPPZ(2$ZMF8K+7uGlD}P!lJqCV4V?>_-jb-RN+tl|R*F`m;80tdx*AQ?WCZfs_uPn5(tEyzW$oyjngjaG z6srv>{JvGI6pu?%o$h*hKht8&!DjY2$+|;GBSJ7hwQCG>mqbxv5bs&D|k>9OncLC~!(dtxl}) zjxtl@HXT79H0{qTVNlulK7!-eB& z2>ot2R-b$+`s|~{w_1Vx@Kfg<8Hk7VU&r3RjdiG7l|e0C6$QVRfQdV`7zi7==R(`U zVAG|^P`m~Vd0eyr)ZD0`xAJhesMVX;A z9@S&f5;DlI=!q1a<>KFcqwQMO<{UVD*_={}DVa)9G?f>N*bTzE`51YQmL#%p`#usw zz;ab85zoYF@^URu?lAN{7%b&y_5FuHj^}NP(k-nSi-Xy^8>a&YX9;OxlBx|sh(~>G zIy{r+_o7Jpi&wSMomd;a_8ayhqkwX%IjD9g&*9ZxVsjLyF=09?oeEcySuwv zf#UA&?(XjH?%GTLe%^KNea~6z`$EW`OtO>7cp^AT4x^O>RU5#K?fE0d_291 zfGx=$YE)?Fc-pk!l;8NIKD1fsjrkC&1I*s!3I2o;m@beV-uFnC1R_+m3wRpoJs!$8 zuQe6(OgZ?7EI!lK;>lgN=dMO;`bzyV!q`fuf{0JDJXL>F>nckLi!9&~$UHh>OP>qh z2A8fu$k}0`o1hIPqRdrypM~h60Pu9ymjy!cV~v0D*Q+qIOzB}vb1C}J&nmxvR%Gv@a1IS zD7;LAlq>D%8_0aCW0#wq;Cm3cTtxg8l7IdF9x$VSG5(8`+vs(re15#9&HkZLIdwSM z?U+={md4<^B;I+XF>$O)ai3xDE63pfT10;K+CP*f=IcFtK=Z)CqW^?apOMye6cx%9{nf%h$>)))ciWQr6!G&xmxh1e(mU7Dao0YX zvz)be*O^us>EE|hlq+@iQdUj=F4)Vz3YJfBD* zV3B5p8x2xXLM^%X_r>l@Y0sb zCb5#ysWHA$d?C3-V`wG!MB+aXcH-u%hvR(y{?*luUP~*~h#0>^(c)_;#GkKa&r*0T7%DsA0%cb3lo zC-DCJwj*AS+o?+4@n4m=9<%p2JXpK-e*yJ>(KhbmuXS79bZz4PNIO+OrX_jKkvGz2 ziOy(SWcChFR*t;B|2^Y6T5?pUWck~Ey#9~P@jkN0CGv>7`=#CU>gUPN^=*jfH%Rb#K}`IMvO%-o1N~l`BAMEpTam4FFr)+hhv4X~cLu;I3_lZz8dea$;9wV&n)w zF`mp84##5bVltl05Dv%h0V!)bF7sD>cir}n@cwSVYsWwG+rJEtPX1!xwYuCMxOy-A z#ds&IkLSy^0^9CepMKdty}yz0yOmP07XSeAUefxHx*+SWYp<5B|KLy-W&9)ezma%F zt%|?8xc|ef@~C)L=3nnQejn7ow#e;rdprREaJ-is{Lc&LFFVSLzgl=VqWz2h4~SdE zqcYakbB}kO9RFsY<+}R2T*^h|ihTdBfj^}C<8u41xc6%R%KRhuOR%<%zuN%$)xqiS z&Hp`QknctHf7Ls!y~h3{LV{$vB*8-1Vd*ZVe? z|3O2vzXwhGdCkAdehuuHL>??v(rW%{?hfHGXH?=7ei+gB%F z^LdBN1NQ)S)~(!mS?(8l@NDWF+q>P~3mn5sby_=LM-#`{+Ho-$*!uQri_UDo$9B;l z$0brPcj$qMNC2RMQ1Irc=58!SftTs*%wukR-vA{Xvu0YR=rN6AQrpv4Mb}yhtup`s zx1<*U#0R=2urUibfB1OQmdMI7ztn$Bt+U0LIPo&J9XO>{fWNk^eo zbn9Oqw*TXR{-bnt)xNA;?$%$H_7iN3+)**A=28~rs+y=q5Zn}SCMb9!X&YLiT`r+5 zOtK9uWDz-{5NrunnZGQJtkQ`PO~MYC9FWFY6ngRG$-HOt6)y;_e9N1Y8$!lkVEG5} z_uBdg^BwHRP1jH5%7<&|uDt0pmrgA$%}Z`AXOo3x@%I$PYJNhRGa#Tzl#BSy7FAch z{Pv_NsGq@3KdI(A>7Gpth%b|R!^{e18usd<7OHC62Px$m*v}EF#mCR9`0FYwe$)gK zhZt310E?EDM{p0YL{xTfLPcfTgh6*w{|w?1lre8EypKUj6!Y=-NKiH5-vZ2Hq15dLvru zn*-wDGoFv}o)e|}huQ7xX}EhZb8FV2nFHY}y#m@Zy@pnf^wS$EOqjbP*>3@T@v<~ z4plG;Uk_32zmO{0wo$T%)Sq> zGKD~zL9Bq#O7Nd)8b`*9KDMhC(=w!DAz|6V zF-!-ZA+^_TXyV^NEkO12_B-g_u~3BuICRo8lp?lXAA4;7JeQujt9^Su;%q-Wdi}b~ z_Z#$pf4}@j|099=&CXtux1q_&{rdoP1k-RTs_MD8!9|_yjF~YV`*~9o5fRA&&fJzk zhZkrR9iA&%rTQ93?Fr&7Kv>{``}<-mLgwg}PGCMzfALorkCqZ5Q9g9KQAsi#w(T%M zYi}t3LY#pNbMc2v?+dOZphC}b*JKTreEnYc!qak--kT>QDe14`p+Xuef{LXqYK2f@ zQK)e43kU_76G3o#?k4ZfMxpQcbU4-BBUj7F!2>G-f+u#%XfLN zNESs~W~LafN5J3%&ZG%E`nelGBj_suATVw4Jn?yYMd#@g5p*OlLpBJ>!o*xukRTBv zq~B-44`s7XKHHe$$*NYA!Tn?x-xbEMSbzlS0!u>jHbViOaHlZuCksvJdxFnwf1)fj zX{U+)p7280@BK#nN@nh#%gcYO^D8-ePj`ImAuKYvy86b5`qne7F6GWU9L>6~S(lbv>%_r|YZ6lO@eGaE7Ed*21DgW) z@|NY`6X><2v9@(-qX50KnIRaN{6#@U@cqe0AO_Rz{=I`fpUop&zwse~5&+Dzk-xf| zQL02CSbn1++GxFie>RWzx|fDUqnX{H# zln;)MK-LS;0w8?C_-N!p&A7SO{Ylc~g_H@>$FbP4&VB0I@qAp03`ob2G%I?5m*BBX zNJ(7yd|K7qP3O837*tROC)47o6a+3PKdZVEw9+YkXJ1}r^zM}(Q`5@j$hyqMq1&vr zw=pJZ+r7TCL?d*o_kgafiJ1(TxV^etBy^X6rj<_>Mo_2taJzbUHbXqwOAZtwp3VW* zC?Q0492z4)Hq&=w8Lq#j6H=h);XaYNEjz@XYU5DsDA zjIM96$pvf|sdv{uhvZDERDY$Axv_6wm!lkB)$LEwAIO{`Gy@-J*et00N+Qa*zQM(Bm$`#AVFH z*nUWSO-7_Dj3*MMT3)y8lLkwq19~PsZsIq9E6GRU-NUT3BHZ2zhR{(!*>c#3cnQ10mJyVhQEL=OTiv`pg{v zeEO<%CUz$<(c*S%I2u!+4MF(~Itn#@Sw=J&ROnJBb=Ep#pvo(wmE(r>>beE4wlM#` z4a=*#a+)d)c(!asRiuxAyPb8AlnM8Yr&@5ONKny2`$c=;R_&wS*_eUo#CGQEc)qgKFd_!2o-|i|~)r<~H$N z)k7_RBj=sk{Y(3Hn#^;W=#;~M9#k~nkKa*g@W;KH=#ut{LPJ%5oMJSgc}>GvyQ=S! z$^9-E6cx~x`O+!gef|{)ajA!-bo*|N>osZHxtz|jH) zk3T~Q?M#S8Zq@O!x>@b-Q}>UC1JBIQ0W(`r`^YV= zo+Wtp$nlHL3Xm6^9y-13g30bdM_5Qwb{XkL>RwN(Ybj zJ|NuRF)7WfsYUayuz07xSKsBTQ`5!!irf5qx%S&{9d{ixD*OMXENR^N&~ljHwM*h7 z`dbu>$7Ub7=bfO-^{@QkKNvST7xkPQO1e2w5JC?v10Gi*#C8q~VpdXcUNQ; z3=w*u?4hfg_L|OMsGcboI}FFyc{&v^rTt8n%Yw6L)A+qlM2p~y?5<{xu$!wywU5Mo z7_8SLdKl2J(hGOLo*1?9pPtE6-u?5GSC_ZCdM=x=IJ*~E#)C6l7Zfmly)D^g=L}Y^hK@Zi82K;1@@26Fz<+bgCzV@ zbJB9h3uU44t{i`%Du3&&4fW4r&J(J4F#fS=l5SBxuGAfecCEdnbe_CkbgB+&UU>z$ zFQ^fJ4ylZ3F>Ww^p~8=do_}joc#uUn=`7T^d9s)|1O`fY-N);6du6S8@vM8&+B|(5 zcDmfUJoaGSZSTDP-&K9*f%IMe<2wNLzq_eh`bR5u zbN|fL{r-9{Nq%k3oS}7$h(4-d4WVapshY8?Ms0^?f5j5gL=ov!g%F_@@Gc_IacDN7 z8Fh~$2_aDd0|Cb=<3~ty;84VnYs8RK}WWD7Cc%93hsb= zzKU%5zPigp|6a-W>gDenY`lm4pMVpZto8>&nKecWRBY^bMYft5u+J3b&nvtP$z%B%xr z_3+(7szd+$=A^RCe9o^IiAAvK6|+jg3l&9+6%`diY88JY0148AK@Y&J z9_5OL4tV1GPSd;qYj~+CqB6;7&9d30obukeec5V45KkbQsfK3=T-~6C3PqJi zls<0is^J4Me0_QA&D!GP+1O@`jj4U9aXXZvTG@OQ_~4s`)2|^4`!U*2%ri6AEfo60 zhb+&fie1*>WkbKA5v?6V4mt|sD|2lxFs6bQ{%Y^sBs*6Ogkt@&XY(_1b&!D^8;*&e z#+Ba1*VOPluAy>2iMxiaj7f&gvy40<;KSZPQzOJKR4-bxe0AeNN2{`)4_V+bu#$g3 z`YrIabxh;B?To8}@BamuBnsPDFv%w3^P~fK`7_kR>AKo<-6n*tyz;3)$cc8m>DX(L zc37!)1qRyK7U4&>rX8PqCcSG6<11?EBLNzr5-e!0s^G56-Uq z&X!VK0mBAf{((mT_q~7aff_iqfP-y`?gft`>&)uo-VDq3va6GnDB);v>wJXKw(0)WIYG`ZKN!_FvYf_ zd2A_%<_B2`$CPU%v#;@uWCfOO`;b0k4Jb=WYSWc-Ylb5KcmEK15Fs zQEDB^BbrZAJn+MSZ1H4wt?YI9QbN>!Z>p(pH-yXhQJ`a1S}WHY2kmI?tt$PpegflS z(XW|9sg&sEz)+aPN5SsWk;>+>K?zbN`FI{gwX?(1$d6{-Eu|L2)Y&&10M4eEv2D?r z_Ao(?Eoz=T)jNbEOSGX!-=Td8=M-x@LS9S$!xz-$Lr|E$;b&nH@ANUbHJG4tlJ%8J zdtkdc8MsDgKC<@H9FVyg@l|^D>;9q-p@d$2MrzOyzPcbIt>d+kZqZHGKsw-aUR4PKIgLc5@) zwHQ&M9uu{{aqsFdgA)MT{XC)JWxT&vk;xHa7sIM2WQEvC?(vSH=ifhl5YGK^?WcOn zGIKYqW`|*~S*Q<-L~wnKRM9Pw5ZQzgsm!?E2u`|;5=_P!%i;dKSk-^9y`jP9h+F&> z-_mqyr`2Cvj2T)t>?z@qv)EXgDIXec2*u9d!e zF}hfQ&J0#C+8rbZp^Y75QfyHZS>(Lzb5auC@7N@= zE6fyr{K{4E=LMlZ{pJARTZa3w@Wt2yh-6@vVF&bZtj% zv&hOpnPpdPb&syA{GqZDkb6t6pFbJ_E74!+NWf(T(gS(BCtT*3)SM^9^E)xKTJ2%F z=q+@Tb*e$3vFN`qH%7gjh`8VfDFL(KtwV25zf3*>G-00(C$l#SQ;YDy=?OQ_>~1%V zRFC-Onl*=;Du{NT5a=Trd4zruZbqbYuGvjEo)CAp7!GIp+9v{t2ADyVWk z@3i{4>yhhT^qZMh(N8B7S{q$uTBo}wYfJfYG zAt9Sv-T0g{geraX(q@L1CE8HX<4bkb;ba?W?JOwEg&4w(gTwvyDnt2_D|r(Gf5>m^ z*^)w*N|oiY;D?_R;#E7!6cRNC)6rMFm35q14x%>1(;HPSZ#pMBGMqV?uFPv*{O#{ur&ZD8 zTV?KeuKXfsn=pD~kl6c)qpvO3Wu*9EAS7_cKKz)0N{1c4;t~fS- zrc%$`DE!=N=}BLlky#nqV|XMz1#Xlnc6vaZudCSAVpgxnj zQnpzymAO!*PtKEh7hmDt*I4iTBJp2N4TJ# z_azy~{BjBU6Tc#@?A03@%aeJ^-ckfSk?@t)wN=cw%g@QCX)bRw#dd|qs0FL4czTqN z*65~SUIl%27KF##B~G6D3Yfl{Iogj1o!F6Yly<@Gd1y!S`$>*g$j7W2oj7Ku!*ZqQ z7OOaCARAExh>(_xiUpy@)wqC^!;~kIyw1UVNCDbHJ^cq}94pR~EMVpYrxPui*_LAa ztK1}fuHNc0j2(tqxk#r@W~gQOk}s}8oAbcm;ENE5*Q-Vlr+-V(gV zJYtr%dzW&RIeG*sGuI@M7-+VXe<)ggd@aQ&QH%g*FIk#{FLh@S+>PQVz+h3X-QlZ# z^P|IX_Y&(ok{<1D^aKuQqQAsR>!Ce8)MQYSOKF&y17UtCmeei&s392Qg7q3-#=Qwh=LrMmlEP;e)Y1IFf-+>M zH4X!3crTT;3^uLYUEa;wM)D(ZiufhjJ&KO|yYB=QNRYq)-HRfg=X&^TM(Z93?zCQd zbn%2{x77?X!~(PR%&WtbJCzheu}w7U94BxJWZMUiR(+7b9jOQ4Zix*w#d>I;3_Ve4r|~aU|)uw;4uT()gce#)K7f!UV}>TxNJGMJ6bfTMYvL%Uv0ZD zKZoIAuAySQDg@t%i;&r-kgMEzIo4y^L%v2mA8WS>wq55Cam)wCqpNOyYX?Zs@YCBPKH?Kr|bee8L#{rS*{Ux68 zBvhZMjh@MEoc^OVrR*@MoS#bADN?#9n?KHig=KQvljCm{XRQ0qIfAS_L`~tX!)_R+ zU0&@$Yqyp5&IL@6vZdV9lK`SYdm=Jp{%^;Fq_ht?vZJgav_$`>FIWMU&`S zQmX;?lB0AyOIXE%jnFjPt5SFn}UA)O!n;tI@8U?ORV8M&k6@$M31Rp-t(t%qBj%+~KG`?VRxm4Gd?+Eb>L zMbkHk@0f-gQ=|8^pP$pp)v?p8KANVrY*&qmUY1&|#xsMJ29fm^+oRelawk!Tbdh>e zkldhki%>g#7vfJ@8$5OA0CU_rg!v$aM)z*mEK}M4B9cRqPZF!n1mCg|sbR@zg{KCV zNkD(3Xl)afPlJZU{>l9ptJttPEs^alfsrvAJ zW$Z)4qiY_0>G8shg$&23!EW5M#B3@M8kem`S{Q-#b_Mm8kAs`rXG6R2M^kQ|3v=AW zrV0Ztf1p$Ge?6jPl1Wp zMP&1IF?nP@XOBa3DTJX8>hPsDybc~B+B(dlYuY6!Tb04WKq|TWX0-9}f&uR@M=z}X z$@M!Ntuo(zR83xES11AIgZ@WXrB!f0*?v0}NbzF*kX_AeVhvzv%4>`^i;-5G(xKdoJ~vX)L;>Y`F~^F{|EXA%h_n zw9KLv>|{knc^ruF3^My^WtEv2WS=V(3Ozc-gINzLaLVapZeNe_IvpI9b{Jw9*aT>& zEE3#ZucIaLt+HXC; z!`awk7onJaFv1=8>P9#=U{lh*xVd`9)elM9d7MAD!gj}G-ttz2H;CygNw}dseBlZp zknJ;hhfq@Bx=*Eh_LwzNiVTz*uNw@L=c1Qa&oA(EW|%0SnOR403lwq%p^rqto0;u4 zRdlaGKi7N&on0IEPx1B$OBqz7o21FLkuZne9@$;^Qp`%^Xmuf;4!<)VPLBXVH3 z>zS0uJ-$1nTJch5-NXPaM%H}=_u~==thFZPwE1nK6eYQhXXM+xkvRXuXM$)>>E~u-C%QWinQ{ z#IX3u8XhOdq1=d+Py=6mI(g8Yb24q`VpXAci72sQ@9N!qk?WE>rN_&t?fK_RFXuZc zW%Gw=y}ah>;5Acumn_k34RE}H29ve>3(2ov6+T#XzVNW2x~@I_#CL8keXhRhSMB_? z>}5y_BR%HWkzAw~Cis0@(3O~P$jr&oxOOkJ7TpIm#*nx*8~nq|XLHf1S#oz1ddA`g zODsXTEWco15F2fu#b+}mhLc`r>HM&I)^#E#c?FjFOAgi7Rs#e8bWPKWw~gKFDxyL2 z9oh)#l#E7?PZZup3TY+$@uga)nF~AN_ko%YiHk4Von1iw=?ob`^STt3Hdd_bpJzpL zz2l4U$}?r#&EPIHOL}|J>Vx~QMB7j>P{2YrbG*9_ALf=m`uE;kpp`00wp1S9 z3gKNA^N?6FCG4no1K~UfIbRvU*=lqM$ht9?{4j!UM!`GQc;1FJ79H%47}o?rb>To= z1ka9-fowti0=2diqs3w&g5O0HjU=&Y6t!Q|K+vksMnT&h@P?Z`7n@hgp{e%CsSMX) z2=h&69j~TNI+;HhUVVvo9s6VPbD4r~N@#(U;}=F%MW~W9y%q-Wj|))NKBpz{?_L<- z9_L%}s6!+6klbueGxQpQbEQt%R7dMg3N1pbCpi500pZWYF2G7mc4+PPGZ|Z9-d4s6 zYk_oW@!w{)Y*B8zJ)aEe^iF@)s*t^q8RbiCvt~DRaN}`om z*BEFdw(kLhWQL};q^|E5a@q4$aKJmuAPNRcBSF%qp4*2n!#~>T3Y+>vCzvN8(CbJE zPd8l7FuDrQft2ZvzEDuK#AWR@CGcoa<9;TPYo22gB~|z_gf~x494c+^VUQBr70ZSk zcznrOU)*#{Tc^z)%ErQUSP%mt2QafI$vURic?wa2;hg$bKU=+uPbayQ6`8(eh zAQ+3xZnyoLF2Q@VD^{vE9(|v2BDS+;2U8irIGJ^NU^jnLG(fk`Wssq@Egy?U+h^h( zmO(x)A-~CPM&8{aB#IB+T|3AZS-t8>ywi8Yg1X~hF1XrgFZc*uW!hkXLfBH>6d)TB zzf=aS<)}<1k;h+blXO|FuA1^TotnB=V=<~9XQ_Q%MB7|OmIVdUUP(&ncgy`Wm9}te&k&Ha4j0wJ` z_79iKWULOzL~S0=dc$l zRtsut=WC{6baa!=cN`R&$z|<*BGx#+zo@b?Z}R}(0nAPuhNT5!YmT*!KJ89nv$=I8 zw(ah;fw--In@&Nvl^D-Q7#`+a=(h6o98NGBV%B;w=^-Czdv)(p(VfwX3z?XAKmKB- z=M<-7Ep22wCX6&E_Q6bG*N~?g=>Hb zjP}ElWYLwN{1>?!>*P2EFo=DhFw@54b;Cp8l2hzQ`-^Q0P6da4m?=L3ZNY80dL*-* zc?mv#@4L7uqr1gD8q_m?jijbEV=ugvbQ#W5jUmvhkLt5#f+->0oJ`=Oy4r{IIq?L9 z$lhxRl)|yCM|aLQ8`V1cp|wWRYnS4NL$ugdtcT%-=+7m&Eb^9~WkkciSr2oJ3ix?X z!8Gbx8>&0kBai!myVZ^S4F*K64C5E^STM=-&odB!V#MfW1LZt|SFpE0lM=nO)t$aJ z2oZXWofPv@v^Qqi3*TaccZaOzpxAJC+Ac+X(#(jjqIdPqpGmoPC;2yjKwWYUYNwcNpZO&Od7n?v4?bcso{(?-DK27eN&Hh_oWa=fopp6lHl`MLmhlo7oUqYE z_b3#^mDx!CSui7vlyAsf-s+DYvW`1WN6!ZIOT-`PM~p?fj3#N*JoyeVGdht+J?9H7 zLmP&bVaV`!UkrNb@><|JdzExj6>I`m3jbDybig&ThPLf#Euh#uy( zKl#GhvFaM-S+*6Ec{1<(w^@S zve!@}Ru2KP({B1S@5;|n7-JwYW_&K+KLl#l`r|Ps@1U3=W5dI)DS(xG=RXO#u|Xk! z4{wGK-kx0#AfA29flzRHx7f4cn*#~R8XEJAghmr_j5q8Tw^Q6`ns4ZjV?MMqdb8{^ zu~;ES{)(C%pa1DjI32;0LiPb4Y%T)gg%9V&4D``hxcYOyAw!G@)-z~tcpq6gdf zQDfRBxel$WpgXqQCORQ$xEH4BMg=1-jQk$%g$-?^ud$Td+fwT|ro5Da^_yS(4gNjc~&3HZk`6C#c92vwJ(H`;1vk0cDq zr!o&Iq?ODtO}5L^@Htp>4M2z$j*0tx?-%gY27nwT?GgpzOGd~Y#8@7d&s=s7fpKNq9DSkGhQkFNhIK{ zb^=3xo1$BnHY{kGSn?+yps#ZKe#Y{6QI!_X2SK&=b#x?hTfg3QZ5U zf}+kQo48`D&FmC2#)mMsy3konV=V3~?QatF$gMxE(H1;W7mp0!A*htK4E2P!1WYw< zxynC%m-9d*zYu5nCnW6l*5(-WQ#ohn$F5mGUmuTZq3Xc)q26e? zlT2!aUdw&!NokI?WWV7#M3`ahq ztuZi~+DWf%s0L&``HRP|c(6yR3B}&mNWg4$-|KtO4C40Q?DU8SC@JKB;8rYMFuiF- z$N*YRIFU_2_JD|55nTDw3VsH*71gN)xq(&Adig>#c-T+p@C_af`wP|zQgrdP7xBUS zL(_Lq=U9+r(ZT&iw_Y&|lDU zl_J962w)PHaMg@o%yLAbIfjXV=4~?ynJR7(UA?-D`y3H*Pe3x;&co_~IuG@1K920U ze%YsRs(2_Q>pyEqnl>qQ6iDQU^C043t`mFv1Of**DCq1KHeRmsE;FXpiJQLe*38){Iyy zbwk$ap_rVyos@};<0PSL*C10BzQsNLoF`?V?wfThLi0%yb_|Nm=MbPg)O*7$0lT8gE3StBL|bO-gVub^M$v%$t#^o*hAlZR0?CehF2gHxONk`kDD>S@sqy$0Tu@;{e^!; zIrB+A74Li~5G4^pwHhUH?ey*?)SOwYq6dX~VXD8U+iA8)>ZvyeP-CgD8&}W<5)~7D zh4giMTLXnvgN*L;T!kZEwt!?Pe_&qSnO)NYpil+S<6Lu2VU6QqKsdF|>o>p28ap!E z3A%}ZAX3``Bsna@dp@=L{+|IV+&0!lf4DisckJRy`JCB?wLj?2AescA$`HD~P2r%+ z9v+ja7Z1Eb4Yfk6HM!?rSbTGie8_}8BN*XRQYpg`e}j%WNUh=&!zN;;ncFt{rtG0G zgYWD+U|uyM!F29DG}RSZY9i6$6#L;*M}WWp!F{zo1HhFg03j8Lt$4kIRpngSi=t0> zG%Wn+0}41&DE$gpL+kjGl~?+AiIC|2aU5;$OzSsO#gS%k;{YP%pM_m#viU!}>&x;+ zY6_+WM?$bCuomZ`Qiq!{OP89dz6?ms?|ww8{t%8Z*93$TS*C*_$jTr0x(LXzve6Larw0IboDT9r zwBj`iA4H9v=9FBpL&vkl3D-lAWrz2>9oXd`*3V4~>p0k^3Oda1BFB~I#n2NU(q_z0 zaQFYFBcXR7 zBCcpZYUDhE0`TE@CHjvL3`zV>HZs4R3746d0!#lWV13dXaOa9IBqHvs(ps}{nfW1h;P-@DJT7IfdXDqL&be2Fzv#D*N^r?!o-oWE2jYjx2rt=)%eHfb=-HeP6t&ywl9xV+P z25e2q>7NilVtrLQaL^51dp+HtBnNY72s@R}&=k<7uTd0vnKGECSsOi@!i2%5)ej!l z9v==*@ImN2P$Y1(Cz3HiI(mCETl8@33BFyP@l5iA7n8^xI05G(3iIdz)0l0mvi6;S z;GKo8n;pjSd^9s+z^kPUqH!N~>Ls_3hsehffhfC4g#FA4W_Cv+@=97^DU=0^3B@yl z36_U5)sOaUB+83)y3tcbD|BFU>3eoj)cM9#QJln66+^iWcl^ep z6%<_Z&3jUgl`w#S7RHdXyEO!-{FsKjidrf^%N6p?dOH5B(1Z1;hI1R0fdhBlV#9z3 zhc1o`66h#|=+a8~!wPJ#>zw(DXc9Fxoz9fZ`p5I{txP$p9yjy~C!RW#mN~Bo_fA)} z-DK6D1Pb%R;2nxGWLgNGZe#tKgX!VQuyc!VRDaTTgpFK6CKNf)gN@Engf|R`B8saZ z8r;jk&}I+FvIkw&5(!!zng_nSLuauUhF}Cnu`lMXLGd1$~Z zlM{S)MA)D`h+gP|N0vV+rG4uW0vBn$i*Y+s-m!}XX^^}BaI+LQ8h~x)8Nz~o!Oz@G z+UXTs*jid+9EOwFeBucwLJpobl1l#-s-y<+rJ(C4YhAtIksqs|egeKWJ8Q7t2y#N? z#wVU`1urLHXGxMq^cIhki|Yn2)l565*3=fw__h_3Ypa5>H!(_bewp*a0?^H^tFw#0Uk04B&?0JUnAp?avLODq*YMwyPLb~QNJz`m! z5Di&E>k^boHKCX-<7OH8#kqkL-F6;9@=YLRJ4;a-$;b-*Jd9Np zY?ao*p|j7>=@j1wvV0_y123wyMa~jr@Zu|Q%=e+o&0dm`h#AHP&4`435M1b4X*i;o zu`1{8t*LEVW!O&ahIFg_viWyhFw-dCg7L)X8!LeuDSvz>!y3^$rF;;SI!pQkVt`>3jMX$k=81W75a%%*u;Q(-f2qSFs)s@&va zpa5}~)R5xLxD7h+G(h#b;>S|(p*7v_(L|QJ_#5mjH;;rRC1Mi%(`nCWnI=qNCfPcg zv`HOWXg;v(!hlhO4;aX*yl@yy5h525BU|&QT9)kpg83Vl zxDKp+!KiqzpX6HmEQ=>d@^I{|)~5#jmfkccVASd(<6BtDM`k`q9s(;VT1MOP95o77 zR);~0@aEC9Ich{kW}pj$_CZ2co&em~>53ae>sJO84^)^vynqLt`%4!wNPNA0Ri4yP z?Ca%&phOddR`c{KCCwB!&cC1+5x&wLVZB;$-kyGzpj~R{wp=|2he~xs88ta$T=UfK zp|M6OZ2;-9g}{ofP9bU8e11Cb&?%lVG}Bu#RanMDW{Po#Rtf5CXywkA;p;mia7$cA z1GdVRGOaoJvUhx?1DOzk!*l9AFY=YJL^#v+bw`xGl%y^Lu=FZ175xgaB>ja_OW&!b}Hjzi*pUeN|J6OYyJ?mW7zT zeit9)H`ACL{t8&YF@H%i{QP*xSreGNdsrzL0cQaNS&y}Cehwu>Y=7m}hY$hL0GpVt z2of|CbZa)cAG8;SoXIjL)C%eZCsZ>@*l&lS1%(M`-0kIkT-2O3)tStwa}rqoeF!w% zuQ?=R0#hAIuYygaBf}RW2%(i}dtA@fPS`Oe>ppFHgJUXoDbib7XUrD_V|^IWQFhf} z-=(1ole-~>Tm&xd*i)@sZ|~{S*l0{`V!JF7!ZsZW+mk?U^WfzN+Ex|Fzg181HtvO$ z;IfuofcXw;5|j|hN}2KfG*z;@>6lqF>6#4-aCBZdPsSSMm$?+=DNivz?dGwTJbVKRo;yTP0eBmojwraj;S*6>U(-6_Hqj8G|X z<+Ua+NLz$61Yk9(vfVr3Eq96)E{UXTLZ`%Oxo&oxk6~eCh9wBd505Gr-aDOfosK=M z`SCPkBE6kAq&O(w#}&G~itj$tbUfa7mu4QkEga+@(BUw4bSha&xNSBaMu68j+nJ5PhV7%Ls?^O63OoK!@`$p zfEpPeKh&-Y64WkR-XiDK3q%vIIv5xl6XcFC^n*94@H@*3lE>V~7%>RX!yx*GvnJA6 zo{+ey@$n#fcx*a71JmgVPl4jJat+eZwuYtbI|?K6{9J0Hi@HBnGm>U=g;k#GdyiAGtiNZSwq0J$j&Nxic!YKBWxgc zvwnF0p8(kfCi?z*oP8@iIn*WtlY z^0hNk!X;k;Mcbva7=?zCCs0Q%518)gXHNg`)m;4EpL16K?Co`OQ>8O;N(QfWPg-n| z_DFi0G&O3I(dg)9A-sR0j;68ppdZ_2elV%jAlyTUHO=0j*YZ+OZQ+_(UYQBSbEdk?Wnyu)vX^~ zhN?&9@(O><12}#yl>GHpV!pZ$$U(C|sf~vWC@~PucXMm;uyo@_q+LuyUHphV37C-l zcpvbMi#P-mUQ(vPqolrL)T}M$kXEML;!=EOKtO*D8^kObO!9aHE! z$J7qIHyMjkHF{U1RmS5w96Z3bM?ae)Yg9-M&!(Zv)(vbmGu$WvNkyLkprP8Uy4edFRA~PSip=dk4Zu zcr}>3N?6*{#|1A>#SI#!Ne=Tw zfEbzNH*W+^tjyXg|GT(HRf^-S2dd9bgS=3q;<-? zH$?I-IpOIFWI}cLb`;RLK*eP!DvC6Nr!PGzn$H77b)7meetw|(kw&p3y)dIQC|Qra z-ke*(rs=dZ{SyG=Yd8M1erMpIJ5WQV@MNtd6o?h<0LnW*^fPnHLgO5)s5CANuoW9h zpTc1lW;=PKceVuv`UKuptcf-4vEAGln?B4Tw}NJGlKNycl9Y2_Z22GN|ARlI$bQoY z2|32}i7;sYy+EcBQ&4=GC+l7AaHL7QDL1uyon|i72`t(#o#$Ld@q0d=$POMILFxY& zmrrwY-?Ee4Ry@PB)&p!63W%Cgr_UuWoQW{wPtk@v;p9!)JcG;w25Zx + dplyr::mutate(t = ww_vals$ww_sampled_times) + assert_equivalent_indexing( input_count_data, - input_ww_data, + input_ww_data_w_t, arg1 = "count data", arg2 = "ww data" ) + + # Warn if sum(site pops) are greater than total pop. + # The package can handle this, but warn users that they may have an input + # data error. + sum_site_pops <- input_ww_data |> + dplyr::distinct(.data$site_pop) |> + sum() + total_pop <- input_count_data |> + dplyr::distinct(.data$total_pop) + if (sum_site_pops > total_pop) { + cli::cli_warn(c( + "The sum of the populations in the wastewater catchment areas is ", + "larger than the total population. While the model supports this ", + "we advise checking your input data to ensure it is specified ", + "correctly and to make sure that populations represented by the ", + "wastewater catchment areas are not overlapping (e.g. if both ", + " the larger wastewater treatment plant and the upstream manhole ", + "are included)." + )) + } invisible() } diff --git a/R/wwinference.R b/R/wwinference.R index 385d5e39..202af91a 100644 --- a/R/wwinference.R +++ b/R/wwinference.R @@ -16,7 +16,7 @@ #' @param ww_data A dataframe containing the pre-processed, site-level #' wastewater concentration data for a model run. The dataframe must contain #' the following columns: `date`, `site`, `lab`, `log_genome_copies_per_ml`, -#' `lab_site_index`, `log_lod`, `below_lod`, `site_pop` `exclude` +#' `lab_site_index`, `log_lod`, `below_lod`, `site_pop` `exclude`. #' @param count_data A dataframe containing the pre-procssed, "global" (e.g. #' state) daily count data, pertaining to the number of events that are being #' counted on that day, e.g. number of daily cases or daily hospital admissions. @@ -159,12 +159,30 @@ wwinference <- function(ww_data, generate_initial_values = TRUE, initial_values_seed = NULL, compiled_model = compile_model()) { + include_ww <- as.integer(model_spec$include_ww) + if (is.null(forecast_date)) { cli::cli_abort( "The user must specify a forecast date" ) } + # If there is no wastewater data, set include_ww to 0 + if (is.null(ww_data) || nrow(ww_data) == 0) { + cli::cli_warn( + c( + "No wastewater data was passed to the model.", + "The model will default to fitting only to the count data" + ) + ) + include_ww <- 0 + } + # If include_ww == 0, we will specify an empty dataset + if (include_ww == 0) { + ww_data <- NULL + } + + fit_opts_use <- get_mcmc_options() # get defaults # this overwrites defaults with all and only the values the user sets in # `fit_opts` @@ -177,31 +195,72 @@ wwinference <- function(ww_data, ) - # Check that data is compatible with specifications - assert_no_dates_after_max(ww_data$date, forecast_date) + ## Check that data is compatible with specifications + if (!is.null(ww_data)) { + assert_no_dates_after_max(ww_data$date, forecast_date) + } assert_no_dates_after_max(count_data$date, forecast_date) + # Get the input count data that will get passed directly to stan input_count_data <- get_input_count_data_for_stan( count_data, calibration_time ) last_count_data_date <- max(input_count_data$date, na.rm = TRUE) first_count_data_date <- min(input_count_data$date, na.rm = TRUE) + + # Get the input wastewater data that will be passed directly to stan input_ww_data <- get_input_ww_data_for_stan( ww_data, first_count_data_date, last_count_data_date, calibration_time ) - raw_input_data <- list( + # Get the table that maps 1-indexed time to dates + date_time_spine <- get_date_time_spine( + forecast_date = forecast_date, input_count_data = input_count_data, + last_count_data_date = last_count_data_date, + forecast_horizon = forecast_horizon, + calibration_time = calibration_time + ) + + # Get lab_site_site_spine + lab_site_site_spine <- get_lab_site_site_spine( input_ww_data = input_ww_data ) + # Get site to subpop spine + site_subpop_spine <- get_site_subpop_spine( + input_ww_data = input_ww_data, + input_count_data = input_count_data + ) + + lab_site_subpop_spine <- get_lab_site_subpop_spine( + lab_site_site_spine = lab_site_site_spine, + site_subpop_spine = site_subpop_spine + ) + + + raw_input_data <- list( + input_count_data = input_count_data, + input_ww_data = input_ww_data, + date_time_spine = date_time_spine, + lab_site_site_spine = lab_site_site_spine, + site_subpop_spine = site_subpop_spine, + lab_site_subpop_spine = lab_site_subpop_spine + ) + # If checks pass, create stan data object stan_data_list <- get_stan_data( input_count_data = input_count_data, input_ww_data = input_ww_data, + date_time_spine = date_time_spine, + lab_site_site_spine = lab_site_site_spine, + site_subpop_spine = site_subpop_spine, + lab_site_subpop_spine = lab_site_subpop_spine, + last_count_data_date = last_count_data_date, + first_count_data_date = first_count_data_date, forecast_date = forecast_date, calibration_time = calibration_time, forecast_horizon = forecast_horizon, @@ -209,7 +268,7 @@ wwinference <- function(ww_data, inf_to_count_delay = model_spec$inf_to_count_delay, infection_feedback_pmf = model_spec$infection_feedback_pmf, params = model_spec$params, - include_ww = as.integer(model_spec$include_ww), + include_ww = include_ww, compute_likelihood = as.integer(model_spec$compute_likelihood) ) @@ -311,7 +370,7 @@ print.wwinference_fit <- function(x, ...) { cat("wwinference_fit object\n") cat("N of WW sites :", x$stan_data_list$n_ww_sites, "\n") cat("N of unique lab-site pairs :", x$stan_data_list$n_ww_lab_sites, "\n") - cat("State population :", formatC( + cat("Total population :", formatC( x$stan_data_list$state_pop, format = "d" ), "\n") diff --git a/data-raw/test_data.R b/data-raw/test_data.R deleted file mode 100644 index 15abb0e6..00000000 --- a/data-raw/test_data.R +++ /dev/null @@ -1,90 +0,0 @@ -############ -# Make entirely fake stan input data via prior-predictive generated quantities -############ - -hosp_data <- wwinference::hosp_data -ww_data <- wwinference::ww_data -params <- wwinference::get_params( - fs::path_package("extdata", "example_params.toml", - package = "wwinference" - ) -) - - -# Data pre-processing -------------------------------------------------------- -ww_data_preprocessed <- wwinference::preprocess_ww_data( - ww_data, - conc_col_name = "log_genome_copies_per_ml", - lod_col_name = "log_lod" -) - -hosp_data_preprocessed <- wwinference::preprocess_count_data( - hosp_data, - count_col_name = "daily_hosp_admits", - pop_size_col_name = "state_pop" -) - -ww_data_to_fit <- wwinference::indicate_ww_exclusions( - ww_data_preprocessed, - outlier_col_name = "flag_as_ww_outlier", - remove_outliers = TRUE -) - -forecast_date <- "2023-12-06" -calibration_time <- 90 -forecast_horizon <- 28 -generation_interval <- wwinference::default_covid_gi -inf_to_hosp <- wwinference::default_covid_inf_to_hosp - -# Assign infection feedback equal to the generation interval -infection_feedback_pmf <- generation_interval - -model_spec <- wwinference::get_model_spec( - generation_interval = generation_interval, - inf_to_count_delay = inf_to_hosp, - infection_feedback_pmf = infection_feedback_pmf, - params = params -) - -mcmc_options <- list( - seed = 5, - iter_warmup = 25, - iter_sampling = 25, - chains = 1, - show_messages = FALSE -) - -generate_initial_values <- TRUE - -model_test_data <- list( - ww_data = ww_data_to_fit, - count_data = hosp_data_preprocessed, - forecast_date = forecast_date, - calibration_time = calibration_time, - forecast_horizon = forecast_horizon, - model_spec = model_spec, - fit_opts = mcmc_options, - generate_initial_values = generate_initial_values -) - -withr::with_seed(55, { - fit <- do.call( - wwinference::wwinference, - model_test_data - ) -}) - - -# Generate the last draw of a very short run for testing -test_fit_last_draw <- posterior::subset_draws( - fit$fit$result$draws(), - draw = 25 -) -# Save the data as internal data. Every time the model changes, will need -# to regenerate this testing data. -usethis::use_data( - model_test_data, - test_fit_last_draw, - internal = TRUE, - overwrite = TRUE -) diff --git a/data/default_covid_inf_to_hosp.rda b/data/default_covid_inf_to_hosp.rda index 970ccee578fbfdfee9e24ecd2e204110de7f5073..235c1fb35c7b7a957fcab0518dcf96646a55e188 100644 GIT binary patch literal 637 zcmV-@0)qWQT4*^jL0KkKSXa<6*=t44S zlRz2)paGx&Xahq)00000000000B8UW4@k&p&;vjL%F&dG5d_g?K|nwXAPF#lphz#e ziYf5~0>LjqMhOTbRT~J1r7==2-^uA{Z4`r?VzDR+SkCLlXMn~7b@bMvVhU0Ps=6)- zt^`8t`$Qljbe$U9cb302pvz1>mYi$V$-o34(F+6gvwYHX1%1$p8cx|O zG3NU63P++f32)#k0Wszd&wxpB9+0$UVhy&n_B*ce21o$0li@#+FOp!e(OHU|yr#+J{!6Hm34)7!O%Ttd=AQ zOQzG|G4LL@|wT##Z36T!7$VGH9A zt!@F(fjusv)Suu12^7K#0_!rmC?Da{#FYy(o~Svg@V^5j2|sC{TXHA+nguEl6bdx@ zUPA%OIr%qY12U=`sl@LKNI(NKy$RV6<(ry9Ao=ICHjAzXqlF5y)TiwML1B9&)E9*dP@`) literal 640 zcmV-`0)PENT4*^jL0KkKS@*tIxBvia|NsB@+yDRfxw)^degFUW-{)`tes`C5`+p<< z{qNp}yZNvIT4vNiqfD6%G#UT^00w{&}asOA%xHxXlMf?A)qvArbB8B zCWsmu8VrDGpc)MWO)>z}AR2mr&;g@O0ig8&G6A4uG#EyPfN7x6WDI}+WEu*mp)!L^ zO&S0OfB*mkK+p{U0000000000000^ukTd{2KmgZNF@ej1T{zgFECjFwfPpY2mYjta z5J3QRci~0}Wn!syNiJ%bO@EsTgyRqU4{+1MWNB42pEcGRha@T?d-Q)tffEvevh2MQ zK0CfZ2Ad$SsjU6V9CNTntU%{Hf&E~QF=h8^fknPwXQmE(;7C8YJ`$>m5>)Oe$qU4@ zW{wgaHgAI*z5i{dbn_Omd49SjCCDJC8<=r8E6uGQyKh%>rXaGn5|NDRc{qX;1+~7a}0RTV%2mlBG z00F=Pa^SebA*rP`Jf?utLqUq$N(A`ngGZKh9QUmGzg-hwM|bH^q!#5Gy_58fIT%DdNn;w z00x>KkT%sb{=WbK00000002582u3iO2tp}|N-~sWLJ3}8-(TQl(WRA_Pct_=KSM`L zPg7S~h5UFr^Y0{U>KPNZBbN22%e5S$NVuen3Qh%9OwoSUQ+k`Zv-YwA!Gi`27%*VLg9Z#B;V3C6?(9hC5l98^LOAxOfwE%LhOrdVX#MHNRw9<{ zm#89>AJ{9$!E*;LaniU^OQIY%CIzaj8qGbyin)5oPqVw|LgyYb6CRv|NmFdA`tLD{mugi21W)41`Z%(U_8JS zc;LD-Ti0Y~UuIvEjEnoP23+j8!0aDT`D>N^RkvAe94zjy7D;8LBnQ4SG+>hEGBI#g zY+&#e_`st#mVd0OQoJpNEu1eWVj0`8ud7L=JvSIUqJ3T!;9Rdmt zjZ7>YP^xEIq>IRcJ@>5iIlBD)dVjS&+`c~RqR6$Zf7utJlxFBjyi%Gn|3&oT-`&Zp zeMPrvEHf0DV#yLLceP^uwY_Yy6GfhHTc@Ek^W*c=RezVAt?+5m+<0{U*0PdUslPdv zz7n4j+#lPta@r0yoY%CIzaj8qGbG{4@whkcHn7T?7*YIxPU>@B*~zG!DXsi@K=ruwuX}nC;PG~U*gH&Two;8 z)9_a_>+1&wtblJzvcxfMi5|yAS{p;VIGQdr$#j{lys~<7wAS8k%gUKMZ~l_93fuD4 zG&?){_QtfHTSZwHW^K4W-K%){nJHT|{gvN1G%YcbJ-Aiz!pHa9!rq?ki8A_Ix;Zv` z2JfxS>Dl?!vzK-C?ftMY6xGT)DZ|G3bJ^0!xDji~8-~UNMb23swlR zC^#{=ajXk*1;L_4TDuSKoH={r8q=_Bser4Sxs9E#i|$x-=IhJqy~gu*%)I<-^O{L4 z5=k>Ax;9Pa6jNbwP;zMG=m=<3ahb7UVq57!ub?SQHBpEq$6MAIp3dE|@m5EtlGfgR zUhcA?37s!GUe{>-e17p?*6o$8p}Cg!5#G9<`YK!d&Pi`x;;=ckGca()uiJ6uZXx?- z7@GF)?{{A;yO@<=qIAW`}M(l1^_{uAeR6D literal 615 zcmZ>Y%CIzaj8qGbTyk&W7Y5e#|BwGS_6Z694+Ja%4*%2dE_lG;z`y~742%buCe4u& zYcg56h{1%}ZI;>cf2(Gim|T3hDDy?b-&ZRbm@f&MuL}7e!0WhjL6SiOvjYPI1FsaH zk;%!<1t%wSE^|1M!OOVJmxo~%Ge^j>uFM4t%nrP~KqZU|G8n3Q}Gq>9XBgZg=Js+$dP_x}2GTzbjN;?p*Q7hdm$umON(vEvdA4%kQ(&mRxojjOCwK z@9f|Dw}qwL)=FuM*k|jNd~ZD+oID*1`BV+O=DnLH>mO%%c{XE*u!n$wzyU`_0pXhZ z88L@hS_HBZ3^sTI`7E+CZ_b^07YGkGTsm|{_mD??%Y|vz_Pb1&C7kg5XfxZrd)pVE z-+JN1bnr?NXXNx z3~{p*j4_#SjKRR@1Xs-11JVqc9K{F5*t70VoC@{kmRZ|5vXOCGE0f8|Zoz~xBz}^j zhQo+tB0wij8yQp54OQ3bDI7!v?--h0fkNejFhdey1oUpp7!3u$!C@!{#xMh5h#LZM zwW+zP3a6YxZ-*8N2UV$vs>1M$#GzCihBwBc@epKy2P&~8&=3j$nFnehFcctoHY~#x zMk8YoWJ=L3X-?_yG@dvB%g2G(00IGsBLD;j-~j-P1{`v@1R%CJ2#zccC?JuQD(vk_ z7@fw4WgNbsaPZeSGyui`5U`9nqeg&?Fh0D&02B@bgMbidkQg$E&6{b;d*4{>g#7<1 z`4cL(o7VmL{Hymn3rDB6Bn*iGCK;Jo6!D{RIsfW4?*jm1pVUseG@uf^z*_$>bumr5 z$tYaxlE$;9$HJpKS_5Of7zE7FhFkdEUr6@fDBa43!)7*j=-D~JA)&Cp%lrrE(4h%1 zg={1}0LW4MyvC8)sMFDBH0Q{a7}Ub^my1jDU$9vIxVd?s#dqb}H!30h1_^}&&6`W- z_Cb>{kt0&F2-SW`nc}?B^7IpL00}#1p}V;tx^un_UJbVD7*W?%Wab>%R&5T#*??(6 zG&MEQx(yEM<&jmC%>_Ug`~@@=#;7-UEz`y|AsFn+t`7}N8_pqLz3(Q_dfdFbWWN0* z&7bKAk781Wk~~lX2q$>8k+r&8icq6=9^O%Hqo8Ri~ z>(+$PMTL%c*4*j-a@Mj}t0)@dys4mF-IXLZHnQvxI>Ey$kuHCHm=91nI^l^a-hnyL ze5Hi#SK-SBxs&&3H3Hc|c|Y&T3s$&@MxA>)Q052(S=dY}B*4}eei2ocwO<<|Qj)Ap zKFfoXhAX&HqHBJmneS5I-LdL<1-5IkIP*>ujZMX9NC;O;E43jcVTl&2g6Ex5*6@K} zX>YE8jy#&nU+7-yHvU%Z4gRpkP`_0cT|azERPn;cp7jUS*S#kzgzrMR!IvVcGk*a~ zy3PCVi}KXGv+|L+^a0ll->xxy%4;t`HpQiWWMiInBL!_MaZ29(T$pT+4qg#;Z$(Td zCa^?see%v})|C4V)n0c)18i->R}p!6_e^Ca__X6j#lC4J5d^Ve&1r|5eby5B^4cL~ znbq}G!mg$Lt&!DP*@>U}$4+ge#x=@4b7|mD)$gxQ$R)-Zu0IT6+AcX+hnrx_hS>UF zeGQ;TL_BY|=+`OS^Z(8#-8vBv=*%xRfXZA*fC}b_jki(Nth+;ezT&C0bB#sDhB1(5>P+S1$=^sp}sp8tUv^>`kVL1 zIS>VFJ>HWP^lPM|wK6;VP#vwI2u|P-d`B}i)zq>%fbY#6A-@+6d3~kJprknwbO-AF z6KUx{j`b)z@km^~)Gki%h(9Fv8CuUTBt>y#km+)bKcj=QM}FP&_9_l5Y;^Boe|2c~ z0L%BPisc;pYxb0#+7y`6l(OZwD|*F7ag-iS z^q#cB$(uf&Pw+mp+-Ch8nYPL?_G05}>csVbE<);A7OY5F@z3%UIEZMMr{q|t%kol% zN(n<^^)?OQ`SGiB+FgD}oy_%SHuln38qd_+CcOsVDa?R9VZpMQ*&am|=T1I)(%UiE zV0JQSOU@cAaI^i!@tbA^^#;D+G27`-`YWtbGIzYP6+Ts5-JwJ9{K(QRU`phP>qIQ_anA=mgj`1Lp z*_j^`51wZSUv=@L*Y5_+y3;PQV3Lc&_84_5SM$BjP2{BqvA-5trEiu4YnG3G{fCpp zk$%6MmVPKUbS?4tcwEg;FX&-gbi4q5e058zyVqaCUogTJ$pX)6Ab_|vN10NAgz9k~ za`!b!8gM<3`}U)gL6Q0`wW#3Z{?q9LoLws=a^}9tZ|t(h+0hr_gg_|nysNgdJ~*1~ zWS_nQvDBj`1;#6{An$laR}p4RedF^6bWOICc_QDKK7f`Rgz`j&tRjK{pWsdO$Lh8Z%#m463QcXuwtTZD9@C;S&4#?IE^3WL)yCwA3jOc;QGZUPqzra z#4sQUoe|ra#V*r14qQcK)u;#sSBT z?0Y>JRgLem9OTJX&oxfV+oJ>nR{92eSDD}#crn1(H^7fv4&OPUzd(Zux=bz{MJ)iSDw!S!XL$uGq6F$nytBU~S z`rd!>Wp8J%>+f{uUlmtyck!4~htE*>4V_BXxvrN|)%o02WELZ<7>8$uY$8ES-bZK( z6=p=FB5@mudFpOR5p*Ff1+7_xT^!ee0$GJty3 zd<+C*Sq9SQ*m9CS!QjiFg?(3HfF0w^UW z0sxE-ys6ei0z4K9frBQY1k}}0yc{NA2ml~98Q_)C5g`B<{`Uf+b9-?B4uNL^@-7-O z@=jJNcxJCrqyx>(u}Z=NA>qtiJ8$JcwXz#mqK~0JDwVN|!$wuCP;0m8I4jhc17s74 z|M<(sA#g<63Dl-(I!k>V%2+R60RA^#HBkjFHA{k@^tlEe1bP#9RZ1_oe9FOrlTD=2 zTWb=2JsGazo#sFW^qU(@5=Bpax5FS^p_;4!po42~D&1t6Tw!a7F6<{%mz90u{oAI| z&jtlU4gTY*zhttiH~3nV!#pbI-@j zY*o2qT;kKw8q*k%;FTRnZh%)hnqwaKk93pD_!x$8b)7x?&;^)R#H{+G3xV|%;qW@! z2{D~;ylSziKLi~--EEywC~eY$&d#H>b_mzTWj%XkUl$6~o6*bQXD*8D&Rlq#;Fr;N z=7az19_R1ziJn?VudP~7ne8^&fpdAE+v8;{w=T-IJ%%m5HP#k{_Pu_QW2C4J?E(F? zz2>a~9aP)`J3~$Pb@Bv~v#*Nl;%D7Q;ach!kGP^m+JUx=>FJz?tBBN~;ohH#{a?`~ zDfg-oe}Ymgu(a_HnS=ot2b^zS2qUzVi$Zq@^c9a4du4j&D*%W+y21 zl{$CdMUhq;JwuOkn*BrEn}*pw^6kO-j{0Fbx?Lc*IxEfkjIv|2{dTeR`bz4tr779H zA8^6}7ArNR`(h5ZL8UQ^ny(9&ZB;54MS57kR(z5tbbrbl*Kp(8^@)>Jypy2 zz)rYSpJ4uu`CK_#$>M2C=Z(8NTJ5E2nSpKdIwg7d!INPUVtvT3eRhOUMi*)JlGO?v zG88u5SQn-D;>}eLc^b6mX~WiSN|B>wRsb1W<1G3h_gRvJz*yN zgA_Hy4+rqqw}Zf%hzaO^na{2>nmNl-6n@Eo@%->auCbh#n$#F1q2$7{C-+rSid3z4 z9h!(+qZEoc=iv%GRJ=CgZsOU+gan-^i?Mp=s1Y9f`(?N|H9}kgQ!D>}@%N|StDx;) zV~*d&!Td+Ne-9J%imI==%TW||?fIlqcSpQ;PA;L-j?{E)&q8F(GVJhsn?!&he-&wX zg!738?R9BoF+dvC@K4s1RZKpNJ|%-->fY zD{PULO%_=90av``FlpqBb~i?HHkx(iZLlfUXZq-2TiL;3%fj@Y5O?QTEfGUyAz#XY zy4M;v%8P*B+cqA?iZe^UsT-A2svR^>4;Np1Z`Td~M%0+{&6N!pX;gD`{gJ+>tkC-4 zOXbg8_oh$TkJ`-=$e=HVgxpIGtr+|9UZ~J1U9WqwVR{1stC9Kj-Abq9xo?6Cw48ED zn-Z_;3IK>v^R46xNyC&5>OfLT&2YT*siGvOx29+B;I!yiWp(&hLBSeQp(!?14|Iba zs}GhsJ*Eh985+mG{%44$Qy{==K5w7o@~+0lQbv|vSKbdKujeF2eBD2H&va* zf4ETtyI`V8)vb1ws6UA$CW?e39F44P`MpM+cM|HgPrhG- z*zq|sX3wxPY(j9XdF!~}>8mG!>Cwjd#yBjvCe_SkGP1P_x~soURLjW5M%x*cf=5_A zSU@APFCuXl96J}?zdJJ6M%f)Q?mY7c!`Q3ndH9Eibi#ls~w7Es7EGVW$M+s}BT z!p9f_rV#F2?@Ka{8)^W{nm6sdoItYHAgAU+-3O3 z2Iv$~E)+n|gx?8_HXrCyh$-gt8+j6Phrp-3mZH(<@&aG!tpXo}{#Pm6nN(`Fm+o%Q3@q8hs-{cb%$6rSaf1 zF+k0?ns}d}ydSk4D!E&8S!Gui0fQf|faWF7mxfHp^M>wwla+F8ghfRAJQk$6b07FJ zvrxU*)o-0)aOdZhn=e7PM)Au#ofqiOKbH!9Ar?`Y-(vhGJy&{2=tq0+Kw{VVbGa_t z+`3P)8i&5hnlTy5$bO+B@ge&hXs#c}L0s+uUo7k?8q%r8FsqiNL>l?q>!P+-Wr7;2 zYoCK|?LtO`KGPzkm<8)5L*C;cPH$p(6pb@rHynd+Gzr96q`jDe@7lhpD?CV}FE(maq#N-62006kAg z1JpG1ntGW4+6_VKXk^gZntFi32AVxXKpFv{0009)pn8A?K+pgH4Lv|KGy$eVOqvWz zQ~(c9&@?un4IZOF(0Yc{007VcX`lcA0MkZ;AO?T{F#|vu05Sof00006fDixx0iXte z0000D0000oXbgY=0MGyc00000000000004#Kq8V6Ae$8SsBI>L)Y0kUpm{(Cr~?qw zKn(x}gG_+*o})uR$N&RFO#^Bg13&-(4F{+IWXNa_Q$RgPo>CSdk|-d>1d2?_nSw=- zW+9U^CLtunGG;-UFlZWqc=8IU6;`na2KKjIYV;w*f&ea`{vd)P5Djhx2vn-BrhpWn z)d50#P>>4iFbD=Jc_0O`t4c`(Rh~n63Iq6m-jw(eMSv(%t~{AxQiT8u7_F3&fKrRj z>Od&(FoLz<6dE~ctR|6C@>zSiO+bL%-QdE;6}b>t1O^~)pao=*CmGpV_-pO zo9AB2teXs2S4;k1 zvx*ul^xFl*xp?uoiYCjbV`LW)j^Lm$bMT+M0j@^+t+a;^0GLQu*8zuBg8r1Em1&>;s+v#m$-MFc7|d}ozK|De&pN+{DFp!Vj@tSBh*91H)s?` zURj5c9ttr}V%#rd7+Vn0QmS~Odlb2Dzg)0uJOV5UH6oOrhx$YU1&eu1tY;<(q=cR^ zLnpIuof&Pw+ZmEGM_-!b^Cx4A$>FTB3K0UOc>sqoQb026g}}xLOT<*5S||XUp;V=N zYf9?FN2S7W`CII#qd4gOB&-poxgsN6R{j%OGo+ws*7H$TW^1I*<>kZPr)t_|{gTV3 zkm(AeGlH*xpmm92Rjk28Mm?<`<mN_IAnH!l6tX{p~X<_n$0j)zTE9pcny2zyk~< zf4$@BUPn&s-L$g_#rBm|i5o|zbL=!%^TK+I zCJpyWJUt#SH;MX;9t%Q!Y6CaAQl%&m9oG?{n8&T}$C2*lm2KKtH+8ADjSxUCi2xR7 z`DX_kAV>h}rf<^px82Cwd+?u4A6aD`T2()_Z~$*mHWd?3uUcqv9~EfM*0E3$%!JGJ7ORr=!atwC51zg6YAt23$p8RS4nP1~2sm%l3Ds2e-F^gE?MaZ;$^nKyYp z3j4Eid;Y0mr$|R}B!$^W-yEqsU3tUN+rE^G#j%)jh!$53mq$qQ*fRe3=(7`CKE~MD zJK|fkz#|H~r;_sU)9n8UfC{DY_o-m44HlPU0V2Ot&M%B008u7#WV&4HhR27~7>Bv- z-l9YyKH+!EPkLQ5pnPuI0OBf>HUXMo0#UtSw|2#~&-0`}+`iY>>D}4vAQ65S_<5<1 zm;`+*3tmoVI{X4q;TtlgcX&WLaTYhoIm7}cXTVsMA*+gxtVFmBf5qI9P81{;g%vo! DlbG>! literal 1663 zcmV-_27viOT4*^jL0KkKS;LSC_y7p@fB*mg|NsC0|NsC0|J(on|NHy@|NsBr|L^~u z`+xs`|M$=Y+2C|q&i9$`D*({ckeXKY8x4K!%c zgbgvGXxf@RO&dfWrXa}LCV{3#(llt$&>04sNv6>;F%MG-ng}w8lSz@LL9|0g2pJkQ z(@hyM05ml8nWXgwKxvT1rkZ&`H1t4Z0MGycVFN=T20#XyGzNn}115kCJxZtm&;g(t z000^^(?_Ui0000000Te`4FCWD000000009(00000fB@4*fHY_T003kF01W^Q0002c z13&-(0000000000000002&9u!RM|(9Ddb0#(=uv$5PD328Z-bj9-~0@8f0K-hBTg_ zdQAWar~t{J0BN8era%K~G|8Z7XaK}yXaLbsQDB5O9Sk5HIPRSS1czr6xH@zW;&)-t zoJa?915hX`heo56h*)Z5LZ^@~Ns>)4_##9?t%L}WgJgkIR07gLSgI4>LP(3Xz$g{; zB!b_{=}91qDiRxrP#uq-b3^`#_C-*mgC1nPSWcq0Fp3543>H>GEf~1(q$+?-n8Hz- zMP0v>H$fZN;Bg*+=zAh1w`0DrX~8c1m25pS9LDKMxQm@iNY;~=n}LJL(3&B4Ik z;rOZs!W^_3_$ib_Y{r00U|czzEW~PK)x={kJ}b-Lv26fE;yvlpUu? zXjL|D*>Rx@Ob1U2>?PrO43#GyfcSz2w;Yz8gpRrc6gs04+>$2q(u-9AWj{(v-U%?c zK0mTRytowYI(^>gvAR1_td6he-lB{OTrWazWitCY%D2 zky+^g1<|=Sw&WRg<~<&?Y{Jm=nN&0y zD<%+GI0z9CF#%dlTIAV4OXs^+>`z9bg~*_l4$#NIJBsM=C^$30r9ORE<%iP%5OMpI z8IWNN41t&#FfaokNdiE?lLG=kgfqHilSWm4+FIUwn-i~s>))AhI&bFC|yyYq%va!}43sJpa8N!5fH# zKsyK;hN@tcw_%g#k0cuY1q2Wa{6#!&{^zu+TM@AjMbfDfZpqBaTyd1U-@fJ?tt2YKnF<&j9EPCba}<` zT$#TC3vpcO4B=x#u^=VWya>g#q;iB`syP@o1yzd0)(n zVMG8yI-DT@1VtJ3e>WPI`C^$=3K~isaq0yX;8gJVRXJH6n3#nf`xyver|#PUZ~bIJGW%Q`v!Wf@!NLXWyg`VO(mG>Fh3D%0eNkPKmv;EY!0pY zXgLVI6!bh_mBom>NkD*L)2!ZjrKO6N+7wklwP|@y6T%o=o!F=m1|O*Fujpy<8^8jM zDfU>eqYXdWy%iM;b5tc8T-(!K>O2h|9I1_pk`Mq#Y$E&U^3t2!9Qp^&@c*$ z3bS@zJxjC`9s@2Uoz5%+C$kl3ARO=jWXKzDAOO+p=o%m5N}9=+zRR JNMXnX`~Wh{[if_l] infection_feedback_pmf; // infection feedback pmf int ot; // maximum time index for the hospital admissions (max number of days we could have observations) int oht; // number of days that we have hospital admissions observations - int n_subpops; // number of WW sites + int n_subpops; // number of modeled subpopulations int n_ww_lab_sites; // number of unique ww-lab combos int n_censored; // numer of observed WW data points that are below the LOD int n_uncensored; //number not below LOD @@ -35,15 +35,14 @@ data { vector[n_subpops] subpop_size; // the population sizes for each subpopulation real norm_pop; array[owt] int ww_sampled_times; // a list of all of the days on which WW is sampled - // will be mapped to the corresponding sites (ww_sampled_sites) + // will be mapped to the corresponding subpops (ww_sampled_subpops) array[oht] int hosp_times; // the days on which hospital admissions are observed - array[owt] int ww_sampled_sites; // vector of unique sites in order of the sampled times - array[owt] int ww_sampled_lab_sites; // vector of unique lab-site combos i - // n order of the sampled times + array[owt] int ww_sampled_subpops; // vector of unique subpops in order of the sampled times + array[owt] int ww_sampled_lab_sites; // vector mapping the subpops to lab-site combos array[n_censored] int ww_censored; // times that the WW data is below the LOD array[n_uncensored] int ww_uncensored; // time that WW data is above LOD vector[owt] ww_log_lod; // The limit of detection in that site at that time point - array[n_ww_lab_sites] int lab_site_to_site_map; // which lab sites correspond to which sites + array[n_ww_lab_sites] int lab_site_to_subpop_map; // which lab sites correspond to which subpops array[oht] int hosp; // observed hospital admissions array[ot + ht] int day_of_week; // integer vector with 1-7 corresponding to the weekday vector[owt] log_conc; // observed concentration of viral genomes in WW @@ -53,10 +52,17 @@ data { // Priors vector[6] viral_shedding_pars;// tpeak, viral peak, shedding duration mean and sd + real offset_ref_log_r_t_prior_mean; + real offset_ref_log_r_t_prior_sd; + real offset_ref_logit_i_first_obs_prior_mean; + real offset_ref_logit_i_first_obs_prior_sd; + real offset_ref_initial_exp_growth_rate_prior_mean; + real offset_ref_initial_exp_growth_rate_prior_sd; + real autoreg_rt_a; real autoreg_rt_b; - real autoreg_rt_site_a; - real autoreg_rt_site_b; + real autoreg_rt_subpop_a; + real autoreg_rt_subpop_b; real autoreg_p_hosp_a; real autoreg_p_hosp_b; real inv_sqrt_phi_prior_mean; @@ -111,30 +117,52 @@ transformed data { // The parameters accepted by the model. parameters { - vector[n_weeks-1] w; // weekly random walk of state-level mean baseline R(t) (log scale) + vector[n_weeks-1] w; // Normal(0,1) noise for the weekly random + // walk on reference subpopulation log R(t) real eta_sd; - real autoreg_rt;// coefficient on AR process in R(t) - real log_r_mu_intercept; // state-level mean baseline reproduction number estimate (log) at t=0 - real sigma_rt; // magnitude of site level variation from state level - real autoreg_rt_site; + vector[n_subpops > 1 ? 1 : 0] offset_ref_log_r_t; + // offset of reference population log R(t) from central dynamic + vector[n_subpops > 1 ? 1 : 0] offset_ref_logit_i_first_obs; + // offset of reference population per capita infections + // at the time of first observation from central value + vector[n_subpops > 1 ? 1 : 0] offset_ref_initial_exp_growth_rate; + // offset of reference population initial exponential growth rate + // from central value + real autoreg_rt; // autoregressive coefficient for + // AR process on first differences in log R(t) + real log_r_t_first_obs; // central log R(t) at the time of + // the first observation + real sigma_rt; // magnitude of subpopulation level + // R(t) heterogeneity + real autoreg_rt_subpop; real autoreg_p_hosp; - matrix[n_subpops, n_weeks] error_site; // matrix of subpopulations - real i_first_obs_over_n; // per capita - // infection incidence on the day of the first observed infection - vector[n_subpops] eta_i_first_obs; // z-score on logit scale of site - // initial per capita infection incidence relative to state value - real sigma_i_first_obs; // stdev between logit state and site initial - // per capita infection incidence - vector[n_subpops] eta_initial_exp_growth_rate; // z scores of individual site level initial exponential growth rates - real sigma_initial_exp_growth_rate; // sd of distribution of site level initial exp growth rates - real mean_initial_exp_growth_rate; // mean of distribution of site level initial exp growth rates + matrix[n_subpops-1, n_subpops > 1 ? n_weeks : 0] error_rt_subpop; + real i_first_obs_over_n; // mean per capita + // infection incidence on the day of the first observation + vector[n_subpops - 1] eta_i_first_obs; // z-score on logit scale + // of subpopulation per capita infection incidences + // on the day of the first observation + real sigma_i_first_obs; // logit scale variability + // in per capita incidence at time of first observation + real mean_initial_exp_growth_rate; // central initial exponential growth + // rate across all subpopulations + real sigma_initial_exp_growth_rate; // variability of + // subpopulation level initial exponential growth rates + vector[n_subpops - 1] eta_initial_exp_growth_rate; // z scores of + // individual subpopulation-level initial exponential growth rates + real inv_sqrt_phi_h; - real mode_sigma_ww_site; //mode of site level stdev - real sd_log_sigma_ww_site; // stdev of the log site level stdev - vector[n_ww_lab_sites] eta_log_sigma_ww_site; // let each lab-site combo have its own observation error + real mode_sigma_ww_site; // mode of site level wastewater + // observation error standard deviations + real sd_log_sigma_ww_site; // sd of the log site level + // wastewater observation error standard deviations + vector[n_ww_lab_sites] eta_log_sigma_ww_site; // z-scores + // of the log site level wastewater observation error standard + // deviations real p_hosp_mean; // Estimated mean IHR - vector[tot_weeks] p_hosp_w; // weekly random walk for IHR - real p_hosp_w_sd; // Estimated IHR sd + vector[tot_weeks] p_hosp_w; // weekly Normal(0, 1) + // stochastic process noise for IHR + real p_hosp_w_sd; // Estimated IHR stochasti cprocess sd real t_peak; // time to viral load peak in shedding real viral_peak; // log10 peak viral load shed /mL real dur_shed; // duration of detectable viral shedding @@ -160,76 +188,86 @@ transformed parameters { row_vector [ot + uot + ht] model_net_i; // number of net infected individuals shedding on each day (sum of individuals in dift stages of infection) real phi_h = inv_square(inv_sqrt_phi_h); vector[n_ww_lab_sites] sigma_ww_site; - vector[n_weeks] log_r_mu_t_in_weeks; // log of state level mean R(t) in weeks - vector[ot + ht] unadj_r; // state level R(t) before damping - matrix[n_subpops, ot+ht] r_site_t; // site_level R(t) - row_vector[ot + ht] unadj_r_site_t; // site_level R(t) before damping - row_vector[ot + uot + ht] new_i_site; // site level incident infections per capita + vector[n_weeks] log_r_t_in_weeks; // global unadjusted weekly log R(t) + matrix[n_subpops, ot+ht] r_subpop_t; // matrix of subpopulation level R(t) + row_vector[ot + ht] unadj_r_subpop_t; // subpopulation level R(t) before damping -- temp vector + vector[n_weeks] log_r_subpop_t_in_weeks; // subpop level R(t) in weeks-- temp vector + real log_i0_subpop; // subpop level log i0/n -- temp var + row_vector[ot + uot + ht] new_i_subpop; // subpopulation level incident infections per capita -- temp vector real pop_fraction; // proportion of state population that the subpopulation represents vector[ot + uot + ht] state_inf_per_capita = rep_vector(0, uot + ot + ht); // state level incident infections per capita matrix[n_subpops, ot + ht] model_log_v_ot; // expected observed viral genomes/mL at all observed and forecasted times real g = pow(log10_g, 10); // Estimated genomes shed per infected individual - vector[n_subpops] i_first_obs_over_n_site; + vector[n_subpops] i_first_obs_over_n_subpop; // per capita infection incidence at the first observed time - vector[n_subpops] initial_exp_growth_rate_site; + vector[n_subpops] initial_exp_growth_rate_subpop; // site level unobserved period growth rate - - // State-leve R(t) AR + RW implementation: - log_r_mu_t_in_weeks = diff_ar1(log_r_mu_intercept, - autoreg_rt, - eta_sd, - w, - 0); - unadj_r = ind_m*log_r_mu_t_in_weeks; - unadj_r = exp(unadj_r); + // AR(1) process on first differences in "global" + // (central) R(t) + log_r_t_in_weeks = diff_ar1(log_r_t_first_obs, + autoreg_rt, eta_sd, w, 0); // Shedding kinetics trajectory s = get_vl_trajectory(t_peak, viral_peak, dur_shed, gt_max); // Site level disease dynamics - i_first_obs_over_n_site = inv_logit(logit(i_first_obs_over_n) + + + // initial conditions + i_first_obs_over_n_subpop[1] = inv_logit(logit(i_first_obs_over_n) + + (n_subpops > 1 ? offset_ref_logit_i_first_obs[1] : 0)); + initial_exp_growth_rate_subpop[1] = mean_initial_exp_growth_rate + + (n_subpops > 1 ? offset_ref_initial_exp_growth_rate[1] : 0); + i_first_obs_over_n_subpop[2:n_subpops] = inv_logit(logit(i_first_obs_over_n) + sigma_i_first_obs * eta_i_first_obs); - initial_exp_growth_rate_site = mean_initial_exp_growth_rate + + initial_exp_growth_rate_subpop[2:n_subpops] = mean_initial_exp_growth_rate + sigma_initial_exp_growth_rate * eta_initial_exp_growth_rate; + // Loop over n_subpops to estimate deviations from reference subpop and + // generate infections and wastewater concentrations for (i in 1:n_subpops) { - vector[n_weeks] log_r_site_t_in_weeks; - real log_i0_site = log(i_first_obs_over_n_site[i]) - uot * initial_exp_growth_rate_site[i]; - // Let site-level R(t) vary around the hierarchical mean R(t) - // log(R(t)site) ~ log(R(t)state) + log(R(t)state-log(R(t)site)) + eta_site - log_r_site_t_in_weeks = ar1(log_r_mu_t_in_weeks, - autoreg_rt_site, sigma_rt, - to_vector(error_site[i]), - 1); + + log_i0_subpop = log(i_first_obs_over_n_subpop[i]) - uot * initial_exp_growth_rate_subpop[i]; + + // Let site-level R(t) vary around the reference subpopulation R(t) + // log(R(t)subpop) ~ log(R(t)sref) + autoreg*(log(R(t)ref-log(R(t)subpop)) + eta_subpop + if(i == 1) { + log_r_subpop_t_in_weeks = log_r_t_in_weeks + + (n_subpops > 1 ? offset_ref_log_r_t[1] : 0); + } else { + log_r_subpop_t_in_weeks = ar1(log_r_t_in_weeks, + autoreg_rt_subpop, + sigma_rt, + to_vector(error_rt_subpop[i - 1]), + 1); + } //convert from weekly to daily - unadj_r_site_t = exp(to_row_vector(ind_m*(log_r_site_t_in_weeks))); + unadj_r_subpop_t = exp(to_row_vector(ind_m*(log_r_subpop_t_in_weeks))); { - tuple(vector[num_elements(state_inf_per_capita)], vector[num_elements(unadj_r)]) output; + tuple(vector[num_elements(state_inf_per_capita)], vector[num_elements(unadj_r_subpop_t)]) output; output = generate_infections( - to_vector(unadj_r_site_t), + to_vector(unadj_r_subpop_t), uot, gt_rev_pmf, - log_i0_site , - initial_exp_growth_rate_site[i], + log_i0_subpop , + initial_exp_growth_rate_subpop[i], ht, infection_feedback, infection_feedback_rev_pmf ); - new_i_site = to_row_vector(output.1); - r_site_t[i] = to_row_vector(output.2); + new_i_subpop = to_row_vector(output.1); + r_subpop_t[i] = to_row_vector(output.2); } - // For each site, tack on number of state infections - // site level infection dynamics sum to the total state infections: - pop_fraction = subpop_size[i] / norm_pop; - state_inf_per_capita += pop_fraction * to_vector(new_i_site); + // For each subpopulation, tack on number of infections + // subpopulation level infection dynamics sum to the total infections: + pop_fraction = subpop_size[i] / norm_pop; // first subpop is ref subpop + state_inf_per_capita += pop_fraction * to_vector(new_i_subpop); - model_net_i = to_row_vector(convolve_dot_product(to_vector(new_i_site), + model_net_i = to_row_vector( + convolve_dot_product(to_vector(new_i_subpop), reverse(s), (uot + ot + ht))); - - model_log_v_ot[i] = log(10) * log10_g + log(model_net_i[(uot+1):(uot + ot + ht) ] + 1e-8) - log(mwpd); @@ -261,7 +299,7 @@ transformed parameters { // These are the true expected genomes at the site level before observation error // (which is at the lab-site level) for (i in 1:owt) { - exp_obs_log_v_true[i] = model_log_v_ot[ww_sampled_sites[i], ww_sampled_times[i]]; + exp_obs_log_v_true[i] = model_log_v_ot[ww_sampled_subpops[i], ww_sampled_times[i]]; } // modify by lab-site specific variation (multiplier!) @@ -282,13 +320,18 @@ transformed parameters { model { // priors w ~ std_normal(); + offset_ref_log_r_t ~ normal(offset_ref_log_r_t_prior_mean, offset_ref_log_r_t_prior_sd); + offset_ref_logit_i_first_obs ~ normal(offset_ref_logit_i_first_obs_prior_mean, + offset_ref_logit_i_first_obs_prior_sd); + offset_ref_initial_exp_growth_rate ~ normal(offset_ref_initial_exp_growth_rate_prior_mean, + offset_ref_initial_exp_growth_rate_prior_sd); eta_sd ~ normal(0, eta_sd_sd); - autoreg_rt_site ~ beta(autoreg_rt_site_a, autoreg_rt_site_b); + autoreg_rt_subpop ~ beta(autoreg_rt_subpop_a, autoreg_rt_subpop_b); autoreg_rt ~ beta(autoreg_rt_a, autoreg_rt_b); autoreg_p_hosp ~ beta(autoreg_p_hosp_a, autoreg_p_hosp_b); - log_r_mu_intercept ~ normal(r_logmean, r_logsd); - to_vector(error_site) ~ std_normal(); + log_r_t_first_obs ~ normal(r_logmean, r_logsd); + to_vector(error_rt_subpop) ~ std_normal(); sigma_rt ~ normal(0, sigma_rt_prior); i_first_obs_over_n ~ beta(i_first_obs_over_n_prior_a, i_first_obs_over_n_prior_b); @@ -355,7 +398,7 @@ generated quantities { // Here need to iterate through each lab-site, find the corresponding site // and apply the expected lab-site error for(i in 1:n_ww_lab_sites) { - pred_ww[i] = normal_rng(model_log_v_ot[lab_site_to_site_map[i], 1 : ot + ht] + ww_site_mod[i], + pred_ww[i] = normal_rng(model_log_v_ot[lab_site_to_subpop_map[i], 1 : ot + ht] + ww_site_mod[i], sigma_ww_site[i]); } diff --git a/man/figures/.DS_Store b/man/figures/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..5008ddfcf53c02e82d7eee2e57c38e5672ef89f6 GIT binary patch literal 6148 zcmeH~Jr2S!425mzP>H1@V-^m;4Wg<&0T*E43hX&L&p$$qDprKhvt+--jT7}7np#A3 zem<@ulZcFPQ@L2!n>{z**++&mCkOWA81W14cNZlEfg7;MkzE(HCqgga^y>{tEnwC%0;vJ&^%eQ zLs35+`xjp>T0 n$. @@ -76,21 +77,26 @@ This amounts to making two key additional modeling assumptions: - Any individuals who contribute to wastewaster measurements but are not part of the total population are distributed among the catchment populations approximately proportional to catchment population size. - Whenever $\sum n_k \ge n$, the fraction of individuals in the jurisdiction not covered by wastewater is small enough to have minimal impact on the jurisdiction-wide per capita infection dynamics. +The hierarchical subpopulation structure linking infection dynamics in each subpopulation to a central or "global" dynamic is implemented using a reference subpopulation. +The reference subpopulation is by default the subpopulation not covered by wastewater, or in the case where the sum of the wastewater site catchment populations meet or exceed the total population ($\sum\nolimits_{k=1}^{K_\mathrm{sites}} n_k \ge n$), the reference subpopulation is by default the wastewater catchment area with the largest population size. + #### Subpopulation-level infections -We couple the subpopulation and total population infection dynamics at the level of the un-damped instantaneous reproduction number $\mathcal{R}^\mathrm{u}(t)$. +We couple the subpopulation and total population infection dynamics at the level of the un-damped instantaneous reproduction number in the reference subpopulation, $\mathcal{R}^\mathrm{u}_ {0}(t)$. -We model the subpopulations as having infection dynamics that are _similar_ to one another but can differ from the overall "global" dynamic. +We model the subpopulations as having infection dynamics that are _similar_ to one another but can differ from the reference subpopulation dynamic. -We represent this with a hierarchical model where we first model a "global" un-damped effective reproductive number $\mathcal{R}^\mathrm{u}(t)$, but then allow individual subpopulations $k$ to have individual subpopulation values of $\mathcal{R}^\mathrm{u}_{k}(t)$ +We represent this with a hierarchical model where we estimate the reference subpopulation's un-damped effective reproductive number $\mathcal{R}^\mathrm{u}_ {0}(t)$ and then estimate the individual subpopulations $k$ deviations from the reference value, $\mathcal{R}^\mathrm{u}_{k}(t)$ -The "global" model for the undamped instantaneous reproductive number $\mathcal{R}^\mathrm{u}(t)$ follows the time-evolution described above. -Subpopulation deviations from the "global" reproduction number are modeled via a log-scale AR(1) process. Specifically, for subpopulation $k$: +The refrence value for the undamped instantaneous reproductive number $\mathcal{R}^\mathrm{u}(t)$ follows the time-evolution described above. +Subpopulation deviations from the reference reproduction number are modeled via a log-scale AR(1) process. Specifically, for subpopulation $k$: $$ -\log[\mathcal{R}^\mathrm{u}_{k}(t)] = \log[\mathcal{R}^\mathrm{u}(t)] + \delta_k(t) +\log[\mathcal{R}^\mathrm{u}_{k}(t)] = \log[\mathcal{R}^\mathrm{u}_0(t)] + m +\delta_k(t) $$ -where $\delta_k(t)$ is the time-varying subpopulation effect on $\mathcal{R}(t)$, modeled as, +where $m$ is an "intercept" for the reference subpopulation, which is a fixed parameter and allows for the fact that $\log[\mathcal{R}^\mathrm{u}_ {0}(t)]$ may differ from the central dynamic by $m$. + +The time-varying subpopulation effect on $log[\mathcal{R}_ {0}(t)]$, $\delta_k(t)$ is modeled as: $$\delta_k(t) = \varphi_{R(t)} \delta_k(t-1) + \epsilon_{kt}$$ diff --git a/tests/testthat/test_get_stan_data.R b/tests/testthat/test_get_stan_data.R index 3bd2f886..cab6ecb3 100644 --- a/tests/testthat/test_get_stan_data.R +++ b/tests/testthat/test_get_stan_data.R @@ -64,6 +64,175 @@ input_ww_data <- get_input_ww_data_for_stan( last_count_data_date, calibration_time ) +date_time_spine <- get_date_time_spine( + forecast_date = forecast_date, + input_count_data = input_count_data, + last_count_data_date = last_count_data_date, + forecast_horizon = forecast_horizon, + calibration_time = calibration_time +) + +lab_site_site_spine <- get_lab_site_site_spine( + input_ww_data = input_ww_data +) + +site_subpop_spine <- get_site_subpop_spine( + input_ww_data = input_ww_data, + input_count_data = input_count_data +) + +lab_site_subpop_spine <- get_lab_site_subpop_spine( + lab_site_site_spine = lab_site_site_spine, + site_subpop_spine = site_subpop_spine +) + + +test_that(paste0( + "Test that the number of subpopulations is correct for the", + "standard case where sum(site_pops) < total_pop" +), { + stan_data <- get_stan_data( + input_count_data, + input_ww_data, + date_time_spine, + lab_site_site_spine, + site_subpop_spine, + lab_site_subpop_spine, + last_count_data_date, + first_count_data_date, + forecast_date, + forecast_horizon, + calibration_time, + generation_interval, + inf_to_count_delay, + infection_feedback_pmf, + params, + include_ww + ) + + expect_equal(stan_data$n_subpop, (stan_data$n_ww_sites + 1)) + expect_equal(length(stan_data$subpop_size), stan_data$n_subpops) +}) + +test_that(paste0( + "Test that the number of subpopulations is correct for the ", + "standard case where sum(site_pops) > total_pop" +), { + input_count_data_mod <- input_count_data + input_count_data_mod$total_pop <- sum(unique(input_ww_data$site_pop) - 100) + site_subpop_spine_mod <- get_site_subpop_spine( + input_ww_data = input_ww_data, + input_count_data = input_count_data_mod + ) + + lab_site_subpop_spine_mod <- get_lab_site_subpop_spine( + lab_site_site_spine = lab_site_site_spine, + site_subpop_spine = site_subpop_spine_mod + ) + + expect_warning({ + stan_data_mod <- get_stan_data( + input_count_data_mod, + input_ww_data, + date_time_spine, + lab_site_site_spine, + site_subpop_spine_mod, + lab_site_subpop_spine_mod, + last_count_data_date, + first_count_data_date, + forecast_date, + forecast_horizon, + calibration_time, + generation_interval, + inf_to_count_delay, + infection_feedback_pmf, + params, + include_ww + ) + }) + + expect_equal(stan_data_mod$n_subpop, (stan_data_mod$n_ww_sites)) + expect_equal(length(stan_data_mod$subpop_size), stan_data_mod$n_subpops) + expect_equal(stan_data_mod$norm_pop, sum(stan_data_mod$subpop_size)) +}) + +test_that(paste0( + "Test that the model handles include_ww = 0 ", + "appropriately by only estimating one subpopulation" +), { + # This happens upstream in wwinference + input_ww_data_mod <- NULL + site_subpop_spine_mod <- get_site_subpop_spine( + input_ww_data = input_ww_data_mod, + input_count_data = input_count_data + ) + + lab_site_subpop_spine_mod <- get_lab_site_subpop_spine( + lab_site_site_spine = lab_site_site_spine, + site_subpop_spine = site_subpop_spine_mod + ) + + stan_data_ho <- get_stan_data( + input_count_data, + input_ww_data_mod, + date_time_spine, + lab_site_site_spine, + site_subpop_spine_mod, + lab_site_subpop_spine_mod, + last_count_data_date, + first_count_data_date, + forecast_date, + forecast_horizon, + calibration_time, + generation_interval, + inf_to_count_delay, + infection_feedback_pmf, + params, + include_ww = 0 + ) + + expect_equal(stan_data_ho$n_subpops, 1) + expect_equal(length(stan_data_ho$subpop_size), 1) +}) + +test_that(paste0( + "Test that the model handles include_ww = 0 ", + "and no data appropriately" +), { + null_ww_data <- NULL + + site_subpop_spine_mod <- get_site_subpop_spine( + input_ww_data = null_ww_data, + input_count_data = input_count_data + ) + + lab_site_subpop_spine_mod <- get_lab_site_subpop_spine( + lab_site_site_spine = lab_site_site_spine, + site_subpop_spine = site_subpop_spine_mod + ) + + stan_data_ho <- get_stan_data( + input_count_data, + input_ww_data = null_ww_data, + date_time_spine, + lab_site_site_spine, + site_subpop_spine_mod, + lab_site_subpop_spine_mod, + last_count_data_date, + first_count_data_date, + forecast_date, + forecast_horizon, + calibration_time, + generation_interval, + inf_to_count_delay, + infection_feedback_pmf, + params, + include_ww = 0 + ) + + expect_equal(stan_data_ho$n_subpops, 1) + expect_equal(length(stan_data_ho$subpop_size), 1) +}) @@ -107,26 +276,6 @@ test_that(paste0( }) -test_that(paste0( - "Test that passing input wastewater and admissions data and ", - "parameters works as expected" -), { - expect_no_error( - get_stan_data( - input_count_data, - input_ww_data, - forecast_date, - forecast_horizon, - calibration_time, - generation_interval, - inf_to_count_delay, - infection_feedback_pmf, - params, - include_ww - ) - ) -}) - test_that(paste0( "Test that passing out of window wastewater data behaves as", @@ -160,10 +309,38 @@ test_that(paste0( last_count_data_date, calibration_time ) + date_time_spine <- get_date_time_spine( + forecast_date = forecast_date, + input_count_data = input_count_data, + last_count_data_date = last_count_data_date, + forecast_horizon = forecast_horizon, + calibration_time = calibration_time + ) + + lab_site_site_spine_od <- get_lab_site_site_spine( + input_ww_data = recent_input_ww_data_for_stan + ) + + site_subpop_spine_od <- get_site_subpop_spine( + input_ww_data = recent_input_ww_data_for_stan, + input_count_data = input_count_data + ) + + lab_site_subpop_spine_od <- get_lab_site_subpop_spine( + lab_site_site_spine = lab_site_site_spine, + site_subpop_spine = site_subpop_spine_od + ) + expect_error(get_stan_data( input_count_data, recent_input_ww_data_for_stan, + date_time_spine, + lab_site_site_spine_od, + site_subpop_spine_od, + lab_site_subpop_spine_od, + last_count_data_date, + first_count_data_date, forecast_date, forecast_horizon, calibration_time, @@ -202,11 +379,37 @@ test_that(paste0( last_count_data_date, calibration_time ) + date_time_spine <- get_date_time_spine( + forecast_date = forecast_date, + input_count_data = input_count_data, + last_count_data_date = last_count_data_date, + forecast_horizon = forecast_horizon, + calibration_time = calibration_time + ) + lab_site_site_spine_old <- get_lab_site_site_spine( + input_ww_data = old_input_ww_data_for_stan + ) + + site_subpop_spine_old <- get_site_subpop_spine( + input_ww_data = old_input_ww_data_for_stan, + input_count_data = input_count_data + ) + + lab_site_subpop_spine_old <- get_lab_site_subpop_spine( + lab_site_site_spine = lab_site_site_spine_old, + site_subpop_spine = site_subpop_spine_old + ) expect_error(get_stan_data( input_count_data, old_input_ww_data, + date_time_spine, + lab_site_site_spine_od, + site_subpop_spine_od, + lab_site_subpop_spine_od, + last_count_data_date, + first_count_data_date, forecast_date, forecast_horizon, calibration_time, @@ -222,6 +425,12 @@ test_that("Test that pmf check works as expected", { expect_warning(get_stan_data( input_count_data, input_ww_data, + date_time_spine, + lab_site_site_spine, + site_subpop_spine, + lab_site_subpop_spine, + last_count_data_date, + first_count_data_date, forecast_date, forecast_horizon, calibration_time, @@ -235,6 +444,12 @@ test_that("Test that pmf check works as expected", { expect_warning(get_stan_data( input_count_data, input_ww_data, + date_time_spine, + lab_site_site_spine, + site_subpop_spine, + lab_site_subpop_spine, + last_count_data_date, + first_count_data_date, forecast_date, forecast_horizon, calibration_time, @@ -248,6 +463,12 @@ test_that("Test that pmf check works as expected", { expect_warning(get_stan_data( input_count_data, input_ww_data, + date_time_spine, + lab_site_site_spine, + site_subpop_spine, + lab_site_subpop_spine, + last_count_data_date, + first_count_data_date, forecast_date, forecast_horizon, calibration_time, @@ -261,6 +482,12 @@ test_that("Test that pmf check works as expected", { expect_error(get_stan_data( input_count_data, input_ww_data, + date_time_spine, + lab_site_site_spine, + site_subpop_spine, + lab_site_subpop_spine, + last_count_data_date, + first_count_data_date, forecast_date, forecast_horizon, calibration_time, diff --git a/tests/testthat/test_helper.R b/tests/testthat/test_helper.R index 8b6b9480..84673e18 100644 --- a/tests/testthat/test_helper.R +++ b/tests/testthat/test_helper.R @@ -1,13 +1,4 @@ test_that("Make sure we can find and load files we need for other tests.", { - testthat::expect_true( - exists("model_test_data") - ) - - testthat::expect_true( - exists("test_fit_last_draw") - ) - - # Compiled model object should exist in the workspace, with functions exposed testthat::expect_true( exists("compiled_site_inf_model") diff --git a/tests/testthat/test_models_run_without_ww.R b/tests/testthat/test_models_run_without_ww.R new file mode 100644 index 00000000..50cdd5de --- /dev/null +++ b/tests/testthat/test_models_run_without_ww.R @@ -0,0 +1,122 @@ +options(cmdstanr_warn_inits = FALSE) + +hosp_data <- wwinference::hosp_data +ww_data <- wwinference::ww_data +params <- wwinference::get_params( + fs::path_package("extdata", "example_params.toml", + package = "wwinference" + ) +) + + +# Data pre-processing -------------------------------------------------------- +ww_data_preprocessed <- wwinference::preprocess_ww_data( + ww_data, + conc_col_name = "log_genome_copies_per_ml", + lod_col_name = "log_lod" +) + +hosp_data_preprocessed <- wwinference::preprocess_count_data( + hosp_data, + count_col_name = "daily_hosp_admits", + pop_size_col_name = "state_pop" +) + +ww_data_to_fit <- wwinference::indicate_ww_exclusions( + ww_data_preprocessed, + outlier_col_name = "flag_as_ww_outlier", + remove_outliers = TRUE +) + +forecast_date <- "2023-12-06" +calibration_time <- 90 +forecast_horizon <- 28 +generation_interval <- wwinference::default_covid_gi +inf_to_hosp <- wwinference::default_covid_inf_to_hosp + +# Assign infection feedback equal to the generation interval +infection_feedback_pmf <- generation_interval + +model_spec <- wwinference::get_model_spec( + generation_interval = generation_interval, + inf_to_count_delay = inf_to_hosp, + infection_feedback_pmf = infection_feedback_pmf, + params = params +) + +mcmc_options <- list( + seed = 5, + iter_warmup = 500, + iter_sampling = 250, + chains = 2, + show_messages = FALSE, + show_exceptions = FALSE +) + +generate_initial_values <- TRUE + +model_test_data <- list( + ww_data = ww_data_to_fit, + count_data = hosp_data_preprocessed, + forecast_date = forecast_date, + calibration_time = calibration_time, + forecast_horizon = forecast_horizon, + model_spec = model_spec, + fit_opts = mcmc_options, + generate_initial_values = generate_initial_values, + compiled_model = compiled_site_inf_model +) + + +test_that("Test that the model runs on simulated data when include_ww=0.", { + ####### + # run model briefly on the simulated data + ####### + model_test_data_no_ww <- model_test_data + model_test_data_no_ww$model_spec$include_ww <- 0 + + expect_no_error(withr::with_seed(55, { + fit <- do.call( + wwinference::wwinference, + model_test_data_no_ww + ) + })) +}) + +test_that("Test that the model runs without wastewater, include_ww=0.", { + ####### + # run model briefly on the simulated data + ####### + model_test_data_no_ww <- model_test_data + model_test_data_no_ww$model_spec$include_ww <- 0 + model_test_data_no_ww$ww_data <- tibble::tibble() + + expect_warning( + withr::with_seed(55, { + fit <- do.call( + wwinference::wwinference, + model_test_data_no_ww + ) + }), + regex = "No wastewater data was passed to the model." + ) +}) + +test_that("Test that the model runs without wastewater, include_ww=1.", { + ####### + # run model briefly on the simulated data + ####### + model_test_data_no_ww <- model_test_data + model_test_data_no_ww$model_spec$include_ww <- 1 + model_test_data_no_ww$ww_data <- tibble::tibble() + + expect_warning( + withr::with_seed(55, { + fit <- do.call( + wwinference::wwinference, + model_test_data_no_ww + ) + }), + regex = "No wastewater data was passed to the model." + ) +}) diff --git a/tests/testthat/test_preprocess_ww_data.R b/tests/testthat/test_preprocess_ww_data.R index 71a19ace..39d47c44 100644 --- a/tests/testthat/test_preprocess_ww_data.R +++ b/tests/testthat/test_preprocess_ww_data.R @@ -5,10 +5,25 @@ ww_data <- tibble::tibble( lab = c(1, 1, 1, 1), conc = log(c(345.2, 784.1, 401.5, 681.8)), lod = log(c(20, 20, 15, 15)), - site_pop = c(rep(1e6, 2), rep(3e5, 2)), + site_pop = c(rep(3e5, 2), rep(1e6, 2)), location = c(rep("MA", 4)) ) +# Test that function returns a dataframe with site indices ordered by +# population size (with first index at highest pop) +test_that("Function returns site indices in order of largest site pop", { + processed <- preprocess_ww_data(ww_data, + conc_col_name = "conc", + lod_col_name = "lod" + ) + + spine <- processed |> distinct(site_pop, site_index) + + + expect_true(spine$site_pop[spine$site_index == 1] == max(spine$site_pop)) +}) + + # Test that function returns a dataframe with correct columns test_that("Function returns dataframe with correct columns", { processed <- preprocess_ww_data(ww_data, @@ -274,8 +289,8 @@ test_that("lab_site_name is constructed properly", { ) expected_lab_site_names <- c( - "Site: 1, Lab: 1", "Site: 1, Lab: 1", - "Site: 2, Lab: 1", "Site: 2, Lab: 1" + "Site: 2, Lab: 1", "Site: 2, Lab: 1", + "Site: 1, Lab: 1", "Site: 1, Lab: 1" ) expect_equal(processed$lab_site_name, expected_lab_site_names) diff --git a/tests/testthat/test_ww_model.R b/tests/testthat/test_ww_model.R deleted file mode 100644 index 697d201e..00000000 --- a/tests/testthat/test_ww_model.R +++ /dev/null @@ -1,133 +0,0 @@ -test_that("Test the wastewater inference model on simulated data.", { - ####### - # run model briefly on the simulated data - ####### - - # This seed sets the initial values seed. Must be the same as the one used - # in generating the test data. - # model_test_data contains the seed that gets passed to stan - withr::with_seed(55, { - fit <- do.call( - silent_wwinference, - model_test_data - ) - }) - - - params <- model_test_data$model_spec$params - obs_last_draw <- posterior::subset_draws(fit$fit$result$draws(), - draw = 25 - ) - - # Check all parameters (ignoring their dimensions) are in both fits - # But in a way that makes error messages easy to understand - obs_par_names <- get_nonmatrix_names_from_draws(obs_last_draw) - exp_par_names <- get_nonmatrix_names_from_draws(test_fit_last_draw) - - expect_true( - all(!!obs_par_names %in% !!exp_par_names) - ) - - expect_true( - all(!!exp_par_names %in% !!obs_par_names) - ) - - # Check dims - obs_par_lens <- get_par_dims_flat(obs_last_draw) - exp_par_lens <- get_par_dims_flat(test_fit_last_draw) - - agg_names <- c(names(obs_par_lens), names(exp_par_lens)) |> unique() - for (param in agg_names) { - expect_equal( - obs_par_lens[!!param], - exp_par_lens[!!param] - ) - } - expect_mapequal( - obs_par_lens, - exp_par_lens - ) - - # Check the parameters we care most about - model_params <- c( - "eta_sd", "autoreg_rt", "log_r_mu_intercept", "sigma_rt", - "autoreg_rt_site", "i0_over_n", "sigma_i0", "sigma_growth", - "initial_growth", "inv_sqrt_phi_h", "sigma_ww_site_mean", - "sigma_ww_site_sd", - "p_hosp_w_sd", "t_peak", "dur_shed", "ww_site_mod_sd", "rt", "rt_site_t", - "p_hosp", "w", "hosp_wday_effect", "eta_i0", "eta_growth", - "infection_feedback", "p_hosp_mean" - ) - - for (param in model_params) { - # Compare everything, with numerical tolerance - testthat::expect_equal( - obs_last_draw, - test_fit_last_draw, - tolerance = 0.0001 - ) - } - - # Testing draws - model_draws <- get_draws(fit) - expect_length(model_draws, 4) - - expect_error(get_draws(fit, what = "something else")) - - # Getting a forecast date - forecast_date <- model_draws$predicted_counts$date - forecast_date <- min(forecast_date) + floor(diff(range(forecast_date)) * .75) - - # Extracting the observed data for the plots - count_data_eval <- model_draws$predicted_counts |> - dplyr::select(observed_value, date) - - expect_true( - inherits( - plot( - model_draws, - what = "predicted_counts", - forecast_date = forecast_date, - n_draws_to_plot = model_test_data$fit_opts$iter_sampling, - count_data_eval = count_data_eval, - count_data_eval_col_name = "observed_value" - ), - "ggplot" - ) - ) - expect_true( - inherits( - plot( - model_draws, - what = "predicted_ww", - forecast_date = forecast_date, - n_draws_to_plot = model_test_data$fit_opts$iter_sampling - ), - "ggplot" - ) - ) - expect_true( - inherits( - plot( - model_draws, - what = "global_rt", - forecast_date = forecast_date, - n_draws_to_plot = model_test_data$fit_opts$iter_sampling - ), - "ggplot" - ) - ) - expect_true( - inherits( - plot( - model_draws, - what = "subpop_rt", - forecast_date = forecast_date, - n_draws_to_plot = model_test_data$fit_opts$iter_sampling - ), - "ggplot" - ) - ) - - expect_error(plot(model_draws, what = "something else")) -}) diff --git a/tests/testthat/test_wwinference.R b/tests/testthat/test_wwinference.R index aa7f904d..bcd266ae 100644 --- a/tests/testthat/test_wwinference.R +++ b/tests/testthat/test_wwinference.R @@ -81,7 +81,7 @@ test_that("Passing invalid args to fit_opts throws an error ", { ww_data = input_ww_data, count_data = input_count_data, forecast_date = forecast_date, - model_spec = get_model_spec, + model_spec = get_model_spec(), fit_opts = list(not_an_arg = 4) ), regexp = c("Names must be a subset of ") diff --git a/vignettes/wwinference.Rmd b/vignettes/wwinference.Rmd index 9e5b81e6..8ad6033c 100644 --- a/vignettes/wwinference.Rmd +++ b/vignettes/wwinference.Rmd @@ -410,21 +410,32 @@ Working with the posterior predictions alongside the input data can be useful to check that your model is fitting the data well and that the nowcasted/forecast quantities look reasonable. -We will generate a dataframe that we'll call `draws_df`, that contains -the posterior draws of the estimated, nowcasted, and forecasted expected -observed hospital admissions and wastewater concentrations, as well as the -latent variables of interest including the site-level $\mathcal{R}(t)$ estimates and the -state-level $\mathcal{R}(t)$ estimate. +We can use the `get_draws()` function to generate dataframes that contain +the posterior draws of the estimated, nowcasted, and forecasted quantities, +joined to the relevant data. We can generate this directly on the output of `wwinference()` using: ```{r extracting-draws} -draws_df <- get_draws(ww_fit) +draws <- get_draws(ww_fit) -print(draws_df) +print(draws) +``` + +Note that by default the `get_draws()` function will return a list of class `wwinference_fit_draws` +which contains separate dataframes of the posterior draws for predicted counts (`"predicted_counts"`), +wastewater concentrations (`"predicted_ww"`), global $\mathcal{R}(t)$ (`"global_rt"`) estimates, and +subpopulation-level $\mathcal{R}(t)$ estimates ("`subpop_rt"`). +To examine a particular variable (e.g. `"predicted_counts"` for posterior +predicted hospital admissions in this case), access the corresponding tibble using the `$` operator. + + +You can also specify which outputs to return using the `what` argument. +```{r example subset draws} +hosp_draws <- get_draws(ww_fit, what = "predicted_counts") +hosp_draws_df <- hosp_draws$predicted_counts +head(hosp_draws_df) ``` -Note that by default the `get_draws()` function will return a list of class `wwinference_fit_draws` all of the posterior draws for predicted hospitalizations, wastewater concentration, global, and site $\mathcal{R}(t)$ estimates. To examine a particular variable (e.g. `"predicted counts"` for posterior -predicted hospital admissions), access the corresponding tibble using the `$` operator. ### Using explicit passed arguments rather than S3 methods @@ -434,9 +445,12 @@ Rather than using S3 methods supplied for `wwinference()`, the elements in the This is demonstrated below: ```{r extracting-draws-explicit, eval = FALSE} -draws_df_explicit <- get_draws( +draws_explicit <- get_draws( x = ww_fit$raw_input_data$input_ww_data, count_data = ww_fit$raw_input_data$input_count_data, + date_time_spine = ww_fit$raw_input_data$date_time_spine, + site_subpop_spine = ww_fit$raw_input_data$site_subpop_spine, + lab_site_subpop_spine = ww_fit$raw_input_data$lab_site_subpop_spine, stan_data_list = ww_fit$stan_data_list, fit_obj = ww_fit$fit ) @@ -445,28 +459,27 @@ draws_df_explicit <- get_draws( ## Plotting the outputs -We can create plots of the outputs using `draws_df` and -the fitting wrapper functions. Note that by default, these plots will not -visualize data that was below the LOD (even though the fit incorporated -them via the censored observation process.) - +We can create plots of the outputs using corresponding dataframes in the `draws` +object and the fitting wrapper functions. Note that by default, these plots +will not include outliers that were flagged for exclusion. Data points +that are below the LOD will be plotted in blue. ```{r generating-figures, out.width='100%'} plot_hosp <- get_plot_forecasted_counts( - draws = draws_df$predicted_counts, + draws = draws$predicted_counts, count_data_eval = hosp_data_eval, count_data_eval_col_name = "daily_hosp_admits_for_eval", forecast_date = forecast_date ) plot_hosp -plot_ww <- get_plot_ww_conc(draws_df$predicted_ww, forecast_date) +plot_ww <- get_plot_ww_conc(draws$predicted_ww, forecast_date) plot_ww -plot_state_rt <- get_plot_global_rt(draws_df$global_rt, forecast_date) +plot_state_rt <- get_plot_global_rt(draws$global_rt, forecast_date) plot_state_rt -plot_subpop_rt <- get_plot_subpop_rt(draws_df$subpop_rt, forecast_date) +plot_subpop_rt <- get_plot_subpop_rt(draws$subpop_rt, forecast_date) plot_subpop_rt ``` @@ -474,15 +487,15 @@ The previous three are equivalent to calling the `plot` method of `wwinference_f ```{r, out.width='100%'} plot( - x = draws_df, + x = draws, what = "predicted_counts", count_data_eval = hosp_data_eval, count_data_eval_col_name = "daily_hosp_admits_for_eval", forecast_date = forecast_date ) -plot(draws_df, what = "predicted_ww", forecast_date = forecast_date) -plot(draws_df, what = "global_rt", forecast_date = forecast_date) -plot(draws_df, what = "subpop_rt", forecast_date = forecast_date) +plot(draws, what = "predicted_ww", forecast_date = forecast_date) +plot(draws, what = "global_rt", forecast_date = forecast_date) +plot(draws, what = "subpop_rt", forecast_date = forecast_date) ``` ## Diagnostics @@ -491,7 +504,8 @@ We strongly recommend running diagnostics as a post-processing step on the model outputs. This can be done by passing the output of -`wwinference()` into the `get_model_diagnostic_flags()`, + +`wwinference()` into the `get_model_diagnostic_flags()`, `summary_diagnostics()` and `parameter_diagnostics()` functions. `get_model_diagnostic_flags()` will print out a table of any flags, if any of @@ -500,13 +514,21 @@ We have set default thresholds on the model diagnostics for production-level runs, we recommend adjusting as needed (see below) To further troubleshoot, you can look at -the diagnostic summary and the diagnostics of the individual parameters using +the summary diagnostics using the `summary_diagnostics()` function +and the diagnostics of the individual parameters using the `parameter_diagnostics()` function. +For further information on troubleshooting the model diagnostics, +we recommend the (bayesplot tutorial)[https://mc-stan.org/bayesplot/articles/visual-mcmc-diagnostics.html]. + +You can access the CmdStan object directly using `ww_fit$fit$result` + ```{r diagnostics-using-S3-methods} convergence_flag_df <- get_model_diagnostic_flags(ww_fit) print(convergence_flag_df) -parameter_diagnostics(ww_fit) +summary_diagnostics(ww_fit) +param_diagnostics <- parameter_diagnostics(ww_fit) +head(param_diagnostics) ``` This can also be done explicitly by parsing the elements of the @@ -568,12 +590,12 @@ fit_hosp_only <- wwinference( ``` ```{r plot-hosp-only, out.width='100%'} -draws_df_hosp_only <- get_draws(fit_hosp_only) -plot_hosp_hosp_only <- get_plot_forecasted_counts( - draws = draws_df_hosp_only$predicted_counts, +draws_hosp_only <- get_draws(fit_hosp_only) +plot(draws_hosp_only, + what = "predicted_counts", count_data_eval = hosp_data_eval, count_data_eval_col_name = "daily_hosp_admits_for_eval", forecast_date = forecast_date ) -plot_hosp_hosp_only +plot(draws_hosp_only, what = "global_rt", forecast_date = forecast_date) ``` From 1a600363dcc93c3ab9e0179550d436887e2048ed Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Tue, 1 Oct 2024 18:06:04 -0400 Subject: [PATCH 28/46] init had wrong name... (#199) --- R/initialization.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/initialization.R b/R/initialization.R index 18a3ca93..c7a8a364 100644 --- a/R/initialization.R +++ b/R/initialization.R @@ -105,7 +105,7 @@ get_inits_for_one_chain <- function(stan_data, stdev = 0.01) { ) if (stan_data$n_subpops > 1) { - init_list$error_subpop <- matrix( + init_list$error_rt_subpop <- matrix( stats::rnorm((n_subpops - 1) * n_weeks, mean = 0, sd = stdev From 452c9f7600f1ce6b063098602b2adb7552153aec Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Wed, 2 Oct 2024 11:48:14 -0400 Subject: [PATCH 29/46] add multiple os to matrix strategy (#190) --- .github/workflows/r-cmd-check.yaml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/r-cmd-check.yaml b/.github/workflows/r-cmd-check.yaml index 3ebfae2d..c35d2481 100644 --- a/.github/workflows/r-cmd-check.yaml +++ b/.github/workflows/r-cmd-check.yaml @@ -10,7 +10,8 @@ jobs: strategy: matrix: r-version: ["4.1.0", "release"] - runs-on: ubuntu-latest + os: [windows-latest, ubuntu-latest] + runs-on: ${{matrix.os}} steps: - uses: actions/checkout@v4 - uses: r-lib/actions/setup-r@v2 @@ -26,6 +27,7 @@ jobs: uses: epinowcast/actions/install-cmdstan@v1 with: cmdstan-version: "latest" + num-cores: 2 - name: "Check wwinference package" uses: r-lib/actions/check-r-package@v2 with: From 5a52e59472f09a800b2d0eb1bbe9f6f4a53ee59e Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Wed, 2 Oct 2024 14:10:57 -0400 Subject: [PATCH 30/46] Update NEWS.md (#205) --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 3cb700f2..49dcb767 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# wwinference 0.0.1 (dev) +# wwinference 0.1.0 This is the first major release, focused on providing an initial version of the package. Note the package is still flagged as in development, though the authors plan on using it for production work in the coming weeks. From d6d31923b154dfe28bb9005937d9df3669044216 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Wed, 2 Oct 2024 14:16:23 -0400 Subject: [PATCH 31/46] Update README.md (#207) --- README.md | 46 +++++++++++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 19 deletions(-) diff --git a/README.md b/README.md index 7f49053c..6ce78bb5 100644 --- a/README.md +++ b/README.md @@ -1,17 +1,20 @@ -# `wwinference`: joint inference and forecasting
from wastewater and epidemiological indicators wwinference website +# `wwinference`: joint inference and forecasting
from wastewater and epidemiological count data wwinference website > [!CAUTION] -> This project is a work-in-progress. Despite this project's early stage, all development is in public as part of the Center for Forecasting and Outbreak Analytics' goals around open development. Questions and suggestions are welcome through GitHub issues or a PR. +> This package is still in development. +> Note the package is still flagged as in development, though the authors plan on using it for production work in the coming weeks. +> All development is in public as part of the Center for Forecasting and Outbreak Analytics' goals around open development. +> Questions and suggestions are welcome through GitHub issues or a PR. > ## Overview -This project is an in-development R package, `{wwinference}` that estimates latent incident infections from wastewater concentration data and data on epidemiological indicators, with an initial assumed structure that the wastewater concentration data comes from subsets of the population contributing to the "global" epidemiological indicator data, such as hospital admissions. +This project is an in-development R package, `{wwinference}` that estimates latent incident infections from wastewater concentration data and data on epidemiological count data, with an initial assumed structure that the wastewater concentration data comes from subsets of the population contributing to the "global" epidemiological count data, such as hospital admissions. In brief, our model builds upon [EpiNow2](https://github.com/epiforecasts/EpiNow2/tree/main), a widely used [R](https://www.r-project.org/) and [Stan](https://mc-stan.org/) package for Bayesian epidemiological inference. -We modify EpiNow2 to add model for the observed viral RNA concentration in wastewater, adding hierarchical structure to link the subpopulations represented by the osberved wastewater concentrations in each wastewater catchment area. -See our Model Definition page for a mathematical description of the generative model, and the Getting Stated vignette to see an example of how to run the inference model on simulated data. +We modify EpiNow2 to add a model for the observed viral RNA concentration in wastewater, adding hierarchical structure to link the subpopulations represented by the observed wastewater concentrations in each wastewater catchment area. -The intention is for {wwinference} to provide a user-friendly R-package interface for running forecasting models that use wastewater concentrations combined with other more traditional epidemiological signals such as cases or hospital admissions. It aims to be a re-implementation of the modeling components contained in the [wastewater-informed-covid-forecasting](https://github.com/CDCgov/wastewater-informed-covid-forecasting) project repository, with +The intention is for {wwinference} to provide a user-friendly R-package interface for running forecasting models that use wastewater concentrations combined with other more traditional epidemiological signals such as cases or hospital admissions. +It aims to be a re-implementation of the modeling components contained in the [wastewater-informed-covid-forecasting](https://github.com/CDCgov/wastewater-informed-covid-forecasting) project repository, with an emphasis here on making it easier for users to supply their own data. We recommend reading the [model definition](model_definition.md) to learn more about how the model is structured and running the ["Getting Started" vignette](vignettes/wwinference.Rmd) for an example of how to fit the model to simulated data of COVID-19 hospital admissions and wastewater concentrations. @@ -20,13 +23,14 @@ This will help make clear the data requirements and how to structure this data t ## Project Admins - Kaitlyn Johnson (kaitejohnson) - Dylan Morris (dylanhmorris) +- George Vega Yon (gvegayon) - Sam Abbott (seabbs) - Damon Bayer (damonbayer) # Installing and running code ## Install R -To run our code, you will need a working installation of [R](https://www.r-project.org/) (version `4.3.0` or later). You can find instructions for installing R on the official [R project website](https://www.r-project.org/). +To run our code, you will need a working installation of [R](https://www.r-project.org/) (version `4.1.0` or later). You can find instructions for installing R on the official [R project website](https://www.r-project.org/). ## Install `cmdstanr` and `CmdStan` We do inference from our models using [`CmdStan`](https://mc-stan.org/users/interfaces/cmdstan) (version `2.35.0` or later) via its R interface [`cmdstanr`](https://mc-stan.org/cmdstanr/) (version `0.8.0` or later). @@ -74,6 +78,10 @@ Confirm that package installation has succeeded by running the following within library(wwinference) ``` +## Contributing to this package +We welcome and encourage contributions. Open an issue in the repository to request changes. +To contribute, fork the repository locally and open a pull request into the `main` branch. + ## Public Domain Standard Notice This repository constitutes a work of the United States Government and is not subject to domestic copyright protection under 17 USC § 105. This repository is in @@ -83,6 +91,18 @@ All contributions to this repository will be released under the CC0 dedication. submitting a pull request you are agreeing to comply with this waiver of copyright interest. +## Contributing Standard Notice +Anyone is encouraged to contribute to the repository by [forking](https://help.github.com/articles/fork-a-repo) +and submitting a pull request. (If you are new to GitHub, you might start with a +[basic tutorial](https://help.github.com/articles/set-up-git).) By contributing +to this project, you grant a world-wide, royalty-free, perpetual, irrevocable, +non-exclusive, transferable license to all users under the terms of the +[Apache Software License v2](http://www.apache.org/licenses/LICENSE-2.0.html) or +later. + +All comments, messages, pull requests, and other submissions received through +CDC including this GitHub page may be subject to applicable federal law, including but not limited to the Federal Records Act, and may be archived. Learn more at [http://www.cdc.gov/other/privacy.html](http://www.cdc.gov/other/privacy.html). + ## License Standard Notice The repository utilizes code licensed under the terms of the Apache Software License and therefore is licensed under ASL v2 or later. @@ -107,18 +127,6 @@ information. All material and community participation is covered by the and [Code of Conduct](code-of-conduct.md). For more information about CDC's privacy policy, please visit [http://www.cdc.gov/other/privacy.html](https://www.cdc.gov/other/privacy.html). -## Contributing Standard Notice -Anyone is encouraged to contribute to the repository by [forking](https://help.github.com/articles/fork-a-repo) -and submitting a pull request. (If you are new to GitHub, you might start with a -[basic tutorial](https://help.github.com/articles/set-up-git).) By contributing -to this project, you grant a world-wide, royalty-free, perpetual, irrevocable, -non-exclusive, transferable license to all users under the terms of the -[Apache Software License v2](http://www.apache.org/licenses/LICENSE-2.0.html) or -later. - -All comments, messages, pull requests, and other submissions received through -CDC including this GitHub page may be subject to applicable federal law, including but not limited to the Federal Records Act, and may be archived. Learn more at [http://www.cdc.gov/other/privacy.html](http://www.cdc.gov/other/privacy.html). - ## Records Management Standard Notice This repository is not a source of government records, but is a copy to increase collaboration and collaborative potential. All government records will be From bf2ce80cac8b4a421b126a42b0705cc818b8d907 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Wed, 2 Oct 2024 14:32:42 -0400 Subject: [PATCH 32/46] Update DESCRIPTION (#203) --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3b4b35ff..ce0e2206 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: wwinference Title: Jointly infers infection dynamics from wastewater data and epidemiological indicators -Version: 0.0.0.9000 +Version: 0.1.0 Authors@R: c( person(given = "Kaitlyn", family = "Johnson", From 49b6c0fc87e1f69adf8d526be9a47ca7f52089d2 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Wed, 2 Oct 2024 14:43:33 -0400 Subject: [PATCH 33/46] Fix error messaging when data extends beyond forecast date (#208) --- R/checkers.R | 24 +++++++++++------ R/get_stan_data.R | 15 +++++++++++ man/assert_no_dates_after_max.Rd | 14 +++++++++- tests/testthat/test_checkers.R | 45 ++++++++++++-------------------- 4 files changed, 61 insertions(+), 37 deletions(-) diff --git a/R/checkers.R b/R/checkers.R index 3011baa8..79a43f94 100644 --- a/R/checkers.R +++ b/R/checkers.R @@ -13,19 +13,26 @@ #' @param date_vector vector of dates #' @param max_date string indicating the maximum date in ISO8601 convention #' e.g. YYYY-MM-DD +#' @param arg_dates string to print the name of the data you are checking the +#' dates for +#' @param arg_max_date string to print the name of the maximum date you are +#' checkign the data for #' @param call Calling environment to be passed to [cli::cli_abort()] for #' traceback. #' #' @return NULL, invisibly assert_no_dates_after_max <- function(date_vector, - max_date, call = rlang::caller_env()) { + max_date, + arg_dates = "y", + arg_max_date = "x", + call = rlang::caller_env()) { if (max(date_vector) > max_date) { cli::cli_abort( c( - "The data passed in has observations beyond the specified", - "maximum date. Either this is the incorrect vintaged", - "data, or the data needs to be filtered to only contain", - "observations before the maximum date" + "The {.arg_dates {arg_dates}} passed in has observations after the ", + "specified {.arg_max_date {arg_max_date}}. Check that this is the ", + "dataset you intended to use with the given ", + "{.arg_max_date {arg_max_date}}." ), call = call, class = "wwinference_input_data_error" @@ -581,9 +588,8 @@ assert_dates_within_frame <- function(dates1, checkmate::assert_date(dates1) checkmate::assert_date(dates2) check_dates2_win_frame <- min(dates1) <= max(dates2) & - min(dates2) >= min(dates1) & - max(dates2) <= max_date & - max(dates1) <= max_date + min(dates2) <= max(dates1) + if (!check_dates2_win_frame) { cli::cli_abort( c( @@ -597,6 +603,8 @@ assert_dates_within_frame <- function(dates1, invisible() } + + #' Assert that two tibbles of date and time mapping align #' #' @param first_data a tibble containing the columns `date` (with IS08601 diff --git a/R/get_stan_data.R b/R/get_stan_data.R index 515e44a4..797209e3 100644 --- a/R/get_stan_data.R +++ b/R/get_stan_data.R @@ -423,6 +423,14 @@ get_stan_data <- function(input_count_data, arg = "infection to count delay" ) + # Check that count data doesn't extend beyond forecast date + assert_no_dates_after_max( + date_vector = input_count_data$date, + max_date = forecast_date, + arg_dates = "wastewater data", + arg_max_date = "forecast date" + ) + # Validate both datasets if both are used---------------------------------- if (include_ww == 1) { validate_both_datasets( @@ -435,6 +443,13 @@ get_stan_data <- function(input_count_data, calibration_time = calibration_time, forecast_date = forecast_date ) + # Check that ww data doesn't extend beyond forecast date + assert_no_dates_after_max( + date_vector = input_ww_data$date, + max_date = forecast_date, + arg_dates = "wastewater data", + arg_max_date = "forecast date" + ) } # Define some global variables from the input data----------------------- diff --git a/man/assert_no_dates_after_max.Rd b/man/assert_no_dates_after_max.Rd index a59a791c..7dc13a02 100644 --- a/man/assert_no_dates_after_max.Rd +++ b/man/assert_no_dates_after_max.Rd @@ -4,7 +4,13 @@ \alias{assert_no_dates_after_max} \title{Check that all dates in dataframe passed in are before a specified date} \usage{ -assert_no_dates_after_max(date_vector, max_date, call = rlang::caller_env()) +assert_no_dates_after_max( + date_vector, + max_date, + arg_dates = "y", + arg_max_date = "x", + call = rlang::caller_env() +) } \arguments{ \item{date_vector}{vector of dates} @@ -12,6 +18,12 @@ assert_no_dates_after_max(date_vector, max_date, call = rlang::caller_env()) \item{max_date}{string indicating the maximum date in ISO8601 convention e.g. YYYY-MM-DD} +\item{arg_dates}{string to print the name of the data you are checking the +dates for} + +\item{arg_max_date}{string to print the name of the maximum date you are +checkign the data for} + \item{call}{Calling environment to be passed to \code{\link[cli:cli_abort]{cli::cli_abort()}} for traceback.} } diff --git a/tests/testthat/test_checkers.R b/tests/testthat/test_checkers.R index 139bd22f..f4960309 100644 --- a/tests/testthat/test_checkers.R +++ b/tests/testthat/test_checkers.R @@ -12,11 +12,23 @@ test_that( max_date <- lubridate::ymd("2024-01-02") - expect_error(assert_no_dates_after_max(date_vector, max_date)) + expect_error( + assert_no_dates_after_max(date_vector, max_date, + arg_dates = "example data", + arg_max_date = "maximum date" + ), + regexp = "The example data passed in has observations" + ) - max_date <- "character" + max_date <- as.character("2024-01-02") - expect_error(assert_no_dates_after_max(date_vector, max_date)) + expect_error( + assert_no_dates_after_max(date_vector, max_date, + arg_dates = "example data", + arg_max_date = "maximum date" + ), + regexp = "The example data passed in has observations" + ) } ) @@ -284,39 +296,16 @@ test_that( { dates1 <- lubridate::ymd(c("2023-01-01", "2023-01-02")) dates2 <- lubridate::ymd(c("2023-01-01", "2023-01-04")) - max_date <- "2023-01-05" expect_no_error(assert_dates_within_frame( dates1, - dates2, - max_date - )) - - - dates1 <- lubridate::ymd(c("2023-01-01", "2023-01-02")) - dates2 <- lubridate::ymd(c("2023-01-03", "2023-01-04")) - max_date <- "2023-01-05" - expect_no_error(assert_dates_within_frame( - dates1, - dates2, - max_date + dates2 )) dates1 <- lubridate::ymd(c("2023-01-01", "2023-01-02")) dates2 <- lubridate::ymd(c("2024-01-03", "2024-01-04")) - max_date <- "2023-01-05" - expect_error(assert_dates_within_frame( - dates1, - dates2, - max_date - )) - - dates1 <- lubridate::ymd(c("2023-01-01", "2023-01-02")) - dates2 <- lubridate::ymd(c("2023-01-03", "2023-01-04")) - max_date <- "2022-01-05" expect_error(assert_dates_within_frame( dates1, - dates2, - max_date + dates2 )) } ) From 9dd766b8da3cd661f7daeb5f6f6127786e4db5ec Mon Sep 17 00:00:00 2001 From: "Dylan H. Morris" Date: Fri, 4 Oct 2024 11:53:52 -0400 Subject: [PATCH 34/46] Positive constrain mode_sigma_ww_site (#210) --- inst/stan/wwinference.stan | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/stan/wwinference.stan b/inst/stan/wwinference.stan index 702f2e79..ba6f0cad 100644 --- a/inst/stan/wwinference.stan +++ b/inst/stan/wwinference.stan @@ -152,7 +152,7 @@ parameters { // individual subpopulation-level initial exponential growth rates real inv_sqrt_phi_h; - real mode_sigma_ww_site; // mode of site level wastewater + real mode_sigma_ww_site; // mode of site level wastewater // observation error standard deviations real sd_log_sigma_ww_site; // sd of the log site level // wastewater observation error standard deviations From 629a9c0fe6c46f5b71fede329278cf55fcc55d99 Mon Sep 17 00:00:00 2001 From: "George G. Vega Yon" Date: Tue, 15 Oct 2024 16:10:56 +0100 Subject: [PATCH 35/46] Setup pkgdown so it hosts release and dev sites (#212) * Adding the developer mode (see if it works) * Updating action to build twice with caching * Fixing concurrency and workflow graph * Fixing action * Wrong option passed to gh release list * Adding missing token * Debugging * Debugging gh release list * Debugging gh release list v2 * Trying a different strategu * Trying a different strategy v2 * Using jq to extract the tag info * Another try * Printing releases * Trying a different strategy * Was using the wrong pipe * Properly using the caching * Switching the version * Adding person in construction icon * Adding minor tweaks: auto dev mode and rename cache key * Adding more links to the site and enforcing buit on new _pkgdown config * Fixing hashing step * Was pointing to the wrong yml * Ensuring hashing and usage of _pkgdown.yml * Leveraging sparse checkout * Ensuring where the pkg is thrown * Correcting sed * Fixing my bash * Devel is main and adding toggle button --- .github/workflows/pkgdown.yaml | 129 +++++++++++++++++++++++++++++++-- DESCRIPTION | 2 +- _pkgdown.yml | 19 +++++ 3 files changed, 141 insertions(+), 9 deletions(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 80f23082..5c532a5c 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -13,32 +13,90 @@ name: pkgdown jobs: build: + + strategy: + matrix: + version: + - 'release' + - 'devel' + + name: pkgdown site build (${{ matrix.version }}) + runs-on: ubuntu-latest # Only restrict concurrency for non-PR jobs concurrency: - group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} + group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}-${{ matrix.version }} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} permissions: contents: write id-token: write pages: write - outputs: - page_artifact_id: ${{ steps.upload-artifact.outputs.artifact_id }} steps: + + ########################################################################## + # Identifying the latest and corresponding tag/sha to download + ######################################################################### + - name: Check the repo to download + id: commit + run: | + + gh api \ + -H "Accept: application/vnd.github+json" \ + -H "X-GitHub-Api-Version: 2022-11-28" \ + /repos/CDCgov/ww-inference-model/releases/latest > \ + latest_release + + echo -n "This job is running on tag/sha: " + if [ "${{ matrix.version }}" = "release" ]; then + echo $(jq -r '.tag_name' latest_release) + echo "tag=$(jq -r '.tag_name' latest_release)" >> $GITHUB_OUTPUT + else + echo "tag=${{ github.sha }}" >> $GITHUB_OUTPUT + echo ${{ github.sha }} + fi + - uses: actions/checkout@v4 + with: + ref: ${{ steps.commit.outputs.tag }} + - name: Checkout the sha-associated repo + if: ${{ matrix.version == 'release' }} + uses: actions/checkout@v4 + with: + sparse-checkout: './_pkgdown.yml' + path: pkgdown-${{ github.sha}} + + - name: Overwriting the _pkgdown.yml + if: ${{ matrix.version == 'release' }} + run: | + cp pkgdown-${{ github.sha }}/_pkgdown.yml ./ + rm -rf pkgdown-${{ github.sha }} + + - name: Checking if the release is cached + if: ${{ matrix.version == 'release' }} + id: cache-hit + uses: actions/cache@v3 + with: + key: pkgdown_site-${{ matrix.version }}-${{ steps.commit.outputs.tag }}-${{ hashFiles( './_pkgdown.yml' ) }} + path: './docs/' + + # These steps only happen if the cache is not hit - uses: r-lib/actions/setup-pandoc@v2 + if: ${{ matrix.version != 'release' || steps.cache-hit.outputs.cache-hit != 'true' }} with: pandoc-version: "2.19.2" - uses: r-lib/actions/setup-r@v2 + if: ${{ matrix.version != 'release' || steps.cache-hit.outputs.cache-hit != 'true' }} with: r-version: "release" use-public-rspm: true install-r: false extra-repositories: "https://mc-stan.org/r-packages/" - uses: r-lib/actions/setup-r-dependencies@v2 + if: ${{ matrix.version != 'release' || steps.cache-hit.outputs.cache-hit != 'true' }} with: pak-version: rc extra-packages: any::pkgdown local::. @@ -46,23 +104,78 @@ jobs: - name: "Install cmdstan via cmdstanr" uses: epinowcast/actions/install-cmdstan@v1 + if: ${{ matrix.version != 'release' || steps.cache-hit.outputs.cache-hit != 'true' }} with: cmdstan-version: "latest" - name: Build site - run: "pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)" - shell: Rscript {0} + if: ${{ matrix.version != 'release' || steps.cache-hit.outputs.cache-hit != 'true' }} + run: | + # Changing the URL if it is a development build + if [ "${{ matrix.version }}" = "devel" ]; then + # Forcing the development mode + export PKGDOWN_DEV_MODE="devel" + else + + # Setting the url + sed -i'' 's|url: https://cdcgov.github.io/ww-inference-model/|url: https://cdcgov.github.io/ww-inference-model/release/|' _pkgdown.yml + + # Changing the navbar + sed -i'' 's|href: https://cdcgov.github.io/ww-inference-model/release|href: https://cdcgov.github.io/ww-inference-model/|' _pkgdown.yml + + sed -i'' 's|text: (switch to release)|text: (switch to dev)|' _pkgdown.yml + + sed -i'' 's|icon: fa-toggle-on|icon: fa-toggle-off|' _pkgdown.yml + + # Forcing the release mode + export PKGDOWN_DEV_MODE="release" + fi + Rscript --vanilla -e \ + "pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)" + + if [ "${{ matrix.version }}" = "devel" ]; then + mv docs docs-tmp + mkdir docs + mv docs-tmp/dev/* docs + fi - name: Upload artifact for GH pages deployment + id: upload-artifact + uses: actions/upload-artifact@v4 + with: + path: "./docs/" + name: pkgdown-site-${{ matrix.version }} + + combine: + outputs: + page_artifact_id: ${{ steps.upload-artifact.outputs.artifact_id }} + + runs-on: ubuntu-latest + needs: build + steps: + + - name: Download dev artifact + uses: actions/download-artifact@v4 + with: + name: pkgdown-site-devel + path: ./docs/ + + - name: Download release artifacts + uses: actions/download-artifact@v4 + with: + name: pkgdown-site-release + path: ./docs/release + + - name: Upload pages artifact id: upload-artifact uses: actions/upload-pages-artifact@v3 with: - path: "docs/" + path: ./docs/ deploy: # check builds on PRs but only deploy when main changes if: ${{ github.event_name != 'pull_request' }} - needs: build + needs: combine runs-on: ubuntu-latest permissions: pages: write @@ -79,7 +192,7 @@ jobs: post-page-artifact: # only comment on PRs if: ${{ github.event_name == 'pull_request' }} - needs: build + needs: combine runs-on: ubuntu-latest permissions: contents: read diff --git a/DESCRIPTION b/DESCRIPTION index ce0e2206..63bf41a3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: wwinference Title: Jointly infers infection dynamics from wastewater data and epidemiological indicators -Version: 0.1.0 +Version: 0.1.0.99 Authors@R: c( person(given = "Kaitlyn", family = "Johnson", diff --git a/_pkgdown.yml b/_pkgdown.yml index cbc2ae70..0c4027ac 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -2,3 +2,22 @@ url: https://cdcgov.github.io/ww-inference-model/ template: bootstrap: 5 math-rendering: mathjax + +development: + mode: auto + +navbar: + structure: + right: [search, github, lightswitch, ver] + components: + ver: + href: https://cdcgov.github.io/ww-inference-model/release + icon: fa-toggle-on + text: (switch to release) + +home: + links: + - text: Release site + href: https://cdcgov.github.io/ww-inference-model/release/ + - text: Dev site + href: https://cdcgov.github.io/ww-inference-model/ From c89b13f0d3de935463d78cef848691b0e4217a70 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Wed, 23 Oct 2024 14:36:56 -0400 Subject: [PATCH 36/46] Issue 200: Modify plot methods (#218) --- NEWS.md | 4 +++ R/figures.R | 26 +++++++++------ man/get_plot_forecasted_counts.Rd | 16 ++++++---- tests/testthat/test_plots.R | 53 +++++++++++++++++++++++++++++++ vignettes/wwinference.Rmd | 19 ++++++++--- 5 files changed, 97 insertions(+), 21 deletions(-) create mode 100644 tests/testthat/test_plots.R diff --git a/NEWS.md b/NEWS.md index 49dcb767..cb75d824 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# wwinference dev + +- Modify `plot_forecasted_counts()` so that it does not require an evaluation dataset ([#218](https://github.com/CDCgov/ww-inference-model/pull/218)) + # wwinference 0.1.0 This is the first major release, focused on providing an initial version of the package. diff --git a/R/figures.R b/R/figures.R index 475fd7c7..ce40b45e 100644 --- a/R/figures.R +++ b/R/figures.R @@ -7,9 +7,11 @@ #' @param count_data_eval A dataframe containing the count data we will #' evaluate the forecasts against. Must contain the columns `date` and #' a column indicating the count data to evaluate against, with the name -#' of that column specified as the `count_data_eval_col_name` +#' of that column specified as the `count_data_eval_col_name`. Default is +#' NULL, which will result in no evaluation data being plotted. #' @param count_data_eval_col_name string indicating the name of the count -#' data to evaluate against the forecasted count data +#' data to evaluate against the forecasted count data. Default is NULL, +#' corresponding to no evaluation data being plotted. #' @param forecast_date A string indicating the date we made the forecast, for #' plotting, in ISO8601 format YYYY-MM-DD #' @param count_type A string indicating what data the counts refer to, @@ -25,9 +27,9 @@ #' @export #' get_plot_forecasted_counts <- function(draws, - count_data_eval, - count_data_eval_col_name, forecast_date, + count_data_eval = NULL, + count_data_eval_col_name = NULL, count_type = "hospital admissions", n_draws_to_plot = 100) { n_draws_available <- max(draws$draw) @@ -55,11 +57,6 @@ get_plot_forecasted_counts <- function(draws, aes(x = .data$date, y = .data$pred_value, group = .data$draw), color = "red4", alpha = 0.1, linewidth = 0.2 ) + - geom_point( - data = count_data_eval, - aes(x = .data$date, y = .data[[count_data_eval_col_name]]), - shape = 21, color = "black", fill = "white" - ) + geom_point(aes(x = .data$date, y = .data$observed_value)) + geom_vline( xintercept = lubridate::ymd(forecast_date), @@ -85,6 +82,15 @@ get_plot_forecasted_counts <- function(draws, vjust = 0.5, hjust = 0.5 ) ) + + if (!is.null(count_data_eval)) { + p <- p + + geom_point( + data = count_data_eval, + aes(x = .data$date, y = .data[[count_data_eval_col_name]]), + shape = 21, color = "black", fill = "white" + ) + } return(p) } @@ -132,7 +138,7 @@ get_plot_ww_conc <- function(draws, aes(x = .data$date, y = .data$observed_value), color = "blue", show.legend = FALSE, size = 0.5 ) + - facet_wrap(~lab_site_name, scales = "free") + + facet_wrap(~lab_site_name, scales = "free_y") + geom_vline( xintercept = lubridate::ymd(forecast_date), linetype = "dashed" diff --git a/man/get_plot_forecasted_counts.Rd b/man/get_plot_forecasted_counts.Rd index 0309682f..122482a2 100644 --- a/man/get_plot_forecasted_counts.Rd +++ b/man/get_plot_forecasted_counts.Rd @@ -6,9 +6,9 @@ \usage{ get_plot_forecasted_counts( draws, - count_data_eval, - count_data_eval_col_name, forecast_date, + count_data_eval = NULL, + count_data_eval_col_name = NULL, count_type = "hospital admissions", n_draws_to_plot = 100 ) @@ -19,16 +19,18 @@ to it. This is the \code{draws_df} output of a call to \code{\link[=wwinference] expects the following column names: \code{date}, \code{pred_value}, \code{draw}, and \code{name}} +\item{forecast_date}{A string indicating the date we made the forecast, for +plotting, in ISO8601 format YYYY-MM-DD} + \item{count_data_eval}{A dataframe containing the count data we will evaluate the forecasts against. Must contain the columns \code{date} and a column indicating the count data to evaluate against, with the name -of that column specified as the \code{count_data_eval_col_name}} +of that column specified as the \code{count_data_eval_col_name}. Default is +NULL, which will result in no evaluation data being plotted.} \item{count_data_eval_col_name}{string indicating the name of the count -data to evaluate against the forecasted count data} - -\item{forecast_date}{A string indicating the date we made the forecast, for -plotting, in ISO8601 format YYYY-MM-DD} +data to evaluate against the forecasted count data. Default is NULL, +corresponding to no evaluation data being plotted.} \item{count_type}{A string indicating what data the counts refer to, default is \verb{hospital admissions}} diff --git a/tests/testthat/test_plots.R b/tests/testthat/test_plots.R new file mode 100644 index 00000000..e84a8569 --- /dev/null +++ b/tests/testthat/test_plots.R @@ -0,0 +1,53 @@ +t_length <- 127 +forecast_date <- "2024-01-01" +data <- tibble::tibble( + date = seq( + from = lubridate::ymd("2023-10-01"), + to = lubridate::ymd("2023-10-01") + lubridate::days(t_length - 1), + by = "days" + ), + observed_value = sample(10:25, t_length, replace = TRUE) +) + +draws <- tibble::tibble() +for (i in 1:100) { + draws_i <- data |> + dplyr::mutate( + pred_value = observed_value + + runif(t_length, min = -10, max = 10), + draw = i + ) + draws <- dplyr::bind_rows(draws, draws_i) +} + +test_draws <- draws |> + dplyr::mutate( + observed_value = ifelse(date < forecast_date, observed_value, NA) + ) + +test_eval_data <- data |> + dplyr::rename("daily_hosp_admits_eval" = observed_value) + + + + +test_that("Test there is no error with eval data", { + expect_no_error( + get_plot_forecasted_counts( + draws = test_draws, + forecast_date = forecast_date, + count_data_eval = test_eval_data, + count_data_eval_col_name = "daily_hosp_admits_eval" + ) + ) +}) + + +test_that("Test there is no error without eval data", { + expect_no_error( + get_plot_forecasted_counts( + draws = test_draws, + forecast_date = forecast_date + ) + ) +}) diff --git a/vignettes/wwinference.Rmd b/vignettes/wwinference.Rmd index 8ad6033c..c6847fe8 100644 --- a/vignettes/wwinference.Rmd +++ b/vignettes/wwinference.Rmd @@ -465,13 +465,14 @@ will not include outliers that were flagged for exclusion. Data points that are below the LOD will be plotted in blue. ```{r generating-figures, out.width='100%'} -plot_hosp <- get_plot_forecasted_counts( +plot_hosp_with_eval <- get_plot_forecasted_counts( draws = draws$predicted_counts, + forecast_date = forecast_date, count_data_eval = hosp_data_eval, - count_data_eval_col_name = "daily_hosp_admits_for_eval", - forecast_date = forecast_date + count_data_eval_col_name = "daily_hosp_admits_for_eval" ) -plot_hosp +plot_hosp_with_eval + plot_ww <- get_plot_ww_conc(draws$predicted_ww, forecast_date) plot_ww @@ -483,6 +484,16 @@ plot_subpop_rt <- get_plot_subpop_rt(draws$subpop_rt, forecast_date) plot_subpop_rt ``` +To plot the forecasts without the retrospectively observed hospital admissions, +simply don't pass them to the plotting function. +```{r plot-only-count-forecasts, out.width='100%'} +plot_hosp <- get_plot_forecasted_counts( + draws = draws$predicted_counts, + forecast_date = forecast_date +) +plot_hosp +``` + The previous three are equivalent to calling the `plot` method of `wwinference_fit_draws` using the `what` argument: ```{r, out.width='100%'} From 951a9e496e9b5eda8f0e6d63cc6185a3b19f8a71 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Wed, 23 Oct 2024 14:44:35 -0400 Subject: [PATCH 37/46] fix link (#231) --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index cb75d824..c4128d94 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,4 +14,4 @@ As it's written, the package is intended to allow users to do the following: - Validate input data validation with informative error messaging ([#37](https://github.com/CDCgov/ww-inference-model/issues/37), [#54](https://github.com/CDCgov/ww-inference-model/issues/54)) - Provide a wrapper function to generate forward simulated data with user-specified variables. It calls a number of functions to perform specific model components ([#27](https://github.com/CDCgov/ww-inference-model/issues/27)) - Contains S3 class methods applied to the output of the main model wrapper function, the `wwinference_fit` class object ([#58](https://github.com/CDCgov/ww-inference-model/issues/58)). -- Wastewater concentration data is expected to be in log scale ([#122](https://onetakeda.box.com/s/pju273g5khx3y3cwoae2zwv3e7vu03x3)). +- Wastewater concentration data is expected to be in log scale ([#122](https://github.com/CDCgov/ww-inference-model/pull/122)). From e2e4fa18352bbd3b6ca4255cb0589c3114fa701d Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Wed, 23 Oct 2024 15:13:43 -0400 Subject: [PATCH 38/46] Issue 197: rename `validate_both_datasets` function (#219) --- R/get_stan_data.R | 5 +++-- R/validate.R | 16 ++++++++-------- ...both_datasets.Rd => validate_data_jointly.Rd} | 6 +++--- 3 files changed, 14 insertions(+), 13 deletions(-) rename man/{validate_both_datasets.Rd => validate_data_jointly.Rd} (93%) diff --git a/R/get_stan_data.R b/R/get_stan_data.R index 797209e3..ce9ae67b 100644 --- a/R/get_stan_data.R +++ b/R/get_stan_data.R @@ -431,9 +431,10 @@ get_stan_data <- function(input_count_data, arg_max_date = "forecast date" ) - # Validate both datasets if both are used---------------------------------- + # if both datasets are used, validate that that they are + # compatible and consistent with each other if (include_ww == 1) { - validate_both_datasets( + validate_data_jointly( input_count_data = input_count_data, input_ww_data = input_ww_data, date_time_spine = date_time_spine, diff --git a/R/validate.R b/R/validate.R index b9b5633b..7962d52b 100644 --- a/R/validate.R +++ b/R/validate.R @@ -167,14 +167,14 @@ validate_count_data <- function(count_data, #' @param forecast_date IS08 formatted date indicating the forecast date #' #' @return NULL, invisibly -validate_both_datasets <- function(input_count_data, - input_ww_data, - date_time_spine, - lab_site_site_spine, - site_subpop_spine, - lab_site_subpop_spine, - calibration_time, - forecast_date) { +validate_data_jointly <- function(input_count_data, + input_ww_data, + date_time_spine, + lab_site_site_spine, + site_subpop_spine, + lab_site_subpop_spine, + calibration_time, + forecast_date) { # check that you have sufficient count data for the calibration time assert_sufficient_days_of_data( input_count_data$date, diff --git a/man/validate_both_datasets.Rd b/man/validate_data_jointly.Rd similarity index 93% rename from man/validate_both_datasets.Rd rename to man/validate_data_jointly.Rd index 8224586b..fe79a687 100644 --- a/man/validate_both_datasets.Rd +++ b/man/validate_data_jointly.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/validate.R -\name{validate_both_datasets} -\alias{validate_both_datasets} +\name{validate_data_jointly} +\alias{validate_data_jointly} \title{Validate that both count data and wastewater data are coherent and compatible with one another and the the user-specified parameters} \usage{ -validate_both_datasets( +validate_data_jointly( input_count_data, input_ww_data, date_time_spine, From ea857731dea5e47f99227bc101ed2cbb1e1ebb74 Mon Sep 17 00:00:00 2001 From: "George G. Vega Yon" Date: Wed, 23 Oct 2024 14:53:28 -0600 Subject: [PATCH 39/46] Replacing artifact and setting retention days to 7 (#230) --- .github/workflows/pkgdown.yaml | 40 +++++++++++++++------------------- NEWS.md | 5 ++++- 2 files changed, 21 insertions(+), 24 deletions(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 5c532a5c..862f3750 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -171,6 +171,8 @@ jobs: uses: actions/upload-pages-artifact@v3 with: path: ./docs/ + name: github-pages + retention-days: 7 deploy: # check builds on PRs but only deploy when main changes @@ -190,31 +192,23 @@ jobs: uses: actions/deploy-pages@v4 post-page-artifact: - # only comment on PRs + runs-on: ubuntu-latest + if: ${{ github.event_name == 'pull_request' }} + + # This job depends on the `build` job needs: combine - runs-on: ubuntu-latest + + # Required permissions permissions: - contents: read - pull-requests: write - env: - GH_TOKEN: ${{ github.token }} - steps: - - name: Checkout - uses: actions/checkout@v4 - - name: Find Comment - uses: peter-evans/find-comment@v3 - id: fc - with: - issue-number: ${{ github.event.pull_request.number }} - comment-author: 'github-actions[bot]' - body-includes: Your page is ready to preview + contents: read + pull-requests: write - - name: Create or update comment - uses: peter-evans/create-or-update-comment@v4 + steps: + # Post the artifact pulling the id from the `readme` step. + # The msg will refer to the arfitact as 'README file'. + - name: Post the artifact + uses: CDCgov/cfa-actions/post-artifact@v1.0.0 with: - comment-id: ${{ steps.fc.outputs.comment-id }} - issue-number: ${{ github.event.pull_request.number }} - body: | - Thank you for your contribution, @${{ github.triggering_actor }} :rocket:! Your page is ready to preview [here](https://github.com/${{github.repository}}/actions/runs/${{ github.run_id }}/artifacts/${{ needs.build.outputs.page_artifact_id }}) - edit-mode: replace + artifact-name: github-pages + gh-token: ${{ secrets.GITHUB_TOKEN }} diff --git a/NEWS.md b/NEWS.md index c4128d94..4f1c70fc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ -# wwinference dev +# wwinference 0.1.0.99 (dev) +## Internal changes + +- Updated the workflow for posting the pages artifact to PRs (issue [#229](https://github.com/CDCgov/ww-inference-model/issues/229)). - Modify `plot_forecasted_counts()` so that it does not require an evaluation dataset ([#218](https://github.com/CDCgov/ww-inference-model/pull/218)) # wwinference 0.1.0 From 51b34408b72a62c0e1a679b621c24059c2317b28 Mon Sep 17 00:00:00 2001 From: "George G. Vega Yon" Date: Fri, 25 Oct 2024 11:11:21 -0600 Subject: [PATCH 40/46] Check unique values of site_pop per site (#232) * Adding validation of records per site * Updated news * Addressing co-pilot hallucination * Explicit call to dplyr::n() * testing data had multiple site pops per site! * Better error and adding a test to catch the error. --------- Co-authored-by: Kaitlyn Johnson --- NEWS.md | 4 ++++ R/preprocessing.R | 2 +- R/validate.R | 22 ++++++++++++++++++++++ tests/testthat/test_preprocess_ww_data.R | 18 ++++++++++++++++-- 4 files changed, 43 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4f1c70fc..c0ebcea6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # wwinference 0.1.0.99 (dev) +## User-visible changes + +- `wwinference` now checks whether `site_pop` is unique per site (see issue [#223](https://github.com/CDCgov/ww-inference-model/issues/226) and reported by [@akeyel](https://github.com/akeyel)). + ## Internal changes - Updated the workflow for posting the pages artifact to PRs (issue [#229](https://github.com/CDCgov/ww-inference-model/issues/229)). diff --git a/R/preprocessing.R b/R/preprocessing.R index 29cbbcc6..7c88b05f 100644 --- a/R/preprocessing.R +++ b/R/preprocessing.R @@ -200,7 +200,7 @@ flag_ww_outliers <- function(ww_data, # Combine stats with ww data ww_rho <- ww_data |> - left_join(ww_stats, by = c("lab_site_index", "date")) + dplyr::left_join(ww_stats, by = c("lab_site_index", "date")) # compute z scores and flag ww_z_scored <- ww_rho |> diff --git a/R/validate.R b/R/validate.R index 7962d52b..660abb98 100644 --- a/R/validate.R +++ b/R/validate.R @@ -80,6 +80,28 @@ validate_ww_conc_data <- function(ww_data, assert_non_missingness(site_pops, arg, call) assert_elements_non_neg(site_pops, arg, call) + # Check that there are no repeated site populations + records_per_site_per_pop <- ww_data |> + dplyr::select("site", "site_pop") |> + unique() |> + dplyr::group_by(.data$site) |> + dplyr::summarize(n = dplyr::n()) + + if (any(records_per_site_per_pop$n != 1)) { + stop( + "The package expects constant population size per site.", + "The data contains at least one site with varying population size: ", + paste0( + records_per_site_per_pop$site[records_per_site_per_pop$n > 1], + " (", + records_per_site_per_pop$n[records_per_site_per_pop$n > 1], + " records)", + collapse = ", " + ) + ) + } + + invisible() } diff --git a/tests/testthat/test_preprocess_ww_data.R b/tests/testthat/test_preprocess_ww_data.R index 39d47c44..4c7ea160 100644 --- a/tests/testthat/test_preprocess_ww_data.R +++ b/tests/testthat/test_preprocess_ww_data.R @@ -17,7 +17,7 @@ test_that("Function returns site indices in order of largest site pop", { lod_col_name = "lod" ) - spine <- processed |> distinct(site_pop, site_index) + spine <- processed |> dplyr::distinct(site_pop, site_index) expect_true(spine$site_pop[spine$site_index == 1] == max(spine$site_pop)) @@ -174,7 +174,7 @@ test_that("lab_site_index and site_index are created correctly", { lab = c(1, 2, 3, 4), conc = c(345.2, 784.1, 401.5, 681.8), lod = c(20, 20, 15, 15), - site_pop = c(rep(1e6, 2), rep(3e5, 2)) + site_pop = c(rep(1e6, 2), 3e5, 1e6) ) processed <- preprocess_ww_data(test_ww_data, @@ -379,3 +379,17 @@ test_that("Function handles LOD values equal to concentration values", { # Check if below_lod is set to 1 when concentration equals LOD expect_equal(processed_edge_case$below_lod, rep(1, nrow(edge_case_ww_data))) }) + +test_that("Constant population per site", { + wrong_pop <- ww_data + ww_data$site_pop <- sample(ww_data$site_pop) + + expect_error( + preprocess_ww_data( + ww_data, + conc_col_name = "conc", + lod_col_name = "lod" + ), + regexp = "constant population size per site" + ) +}) From 3e58bec25154f6c564c6148e06477f2b8fa1b3a6 Mon Sep 17 00:00:00 2001 From: "George G. Vega Yon" Date: Wed, 30 Oct 2024 14:42:57 -0600 Subject: [PATCH 41/46] [Hot fix] test when pop size is not constant was failing (#235) * Hot fix! * There was probably a single site! * Correcting site name * fix cbind, dont want duplicat column names, use seq_len but differently * Update NEWS.md Co-authored-by: Dylan H. Morris --------- Co-authored-by: Kaitlyn Johnson Co-authored-by: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Co-authored-by: Dylan H. Morris --- NEWS.md | 2 +- tests/testthat/test_preprocess_ww_data.R | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index c0ebcea6..5adf1ca4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ ## User-visible changes -- `wwinference` now checks whether `site_pop` is unique per site (see issue [#223](https://github.com/CDCgov/ww-inference-model/issues/226) and reported by [@akeyel](https://github.com/akeyel)). +- `wwinference` now checks whether `site_pop` is fixed per site (see issue [#223](https://github.com/CDCgov/ww-inference-model/issues/226) reported by [@akeyel](https://github.com/akeyel)). ## Internal changes diff --git a/tests/testthat/test_preprocess_ww_data.R b/tests/testthat/test_preprocess_ww_data.R index 4c7ea160..6b4e668e 100644 --- a/tests/testthat/test_preprocess_ww_data.R +++ b/tests/testthat/test_preprocess_ww_data.R @@ -382,11 +382,12 @@ test_that("Function handles LOD values equal to concentration values", { test_that("Constant population per site", { wrong_pop <- ww_data - ww_data$site_pop <- sample(ww_data$site_pop) + + wrong_pop$site_pop <- 1e6 + seq_len(nrow(ww_data)) expect_error( preprocess_ww_data( - ww_data, + wrong_pop, conc_col_name = "conc", lod_col_name = "lod" ), From 3ff2d1ea7ef84264a6cb1075c2b17d67998c65c1 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Thu, 31 Oct 2024 09:38:35 -0400 Subject: [PATCH 42/46] Issue 184: Add outputs to `generate_simulated_data()` fxn and package data (#220) --- NEWS.md | 4 +- R/data.R | 116 ++++++++++++++++++++++++++++- R/generate_simulated_data.R | 131 +++++++++++++++++++++++++++++++-- R/model_component_fwd_sim.R | 46 ++++++++++++ data-raw/vignette_data.R | 17 ++--- data/hosp_data.rda | Bin 607 -> 612 bytes data/hosp_data_eval.rda | Bin 655 -> 644 bytes data/subpop_hosp_data.rda | Bin 0 -> 1122 bytes data/subpop_hosp_data_eval.rda | Bin 0 -> 1349 bytes data/true_global_rt.rda | Bin 2169 -> 2182 bytes data/ww_data.rda | Bin 1657 -> 1577 bytes data/ww_data_eval.rda | Bin 0 -> 1925 bytes man/format_subpop_hosp_data.Rd | 31 ++++++++ man/generate_simulated_data.Rd | 5 ++ man/hosp_data.Rd | 4 +- man/subpop_hosp_data.Rd | 46 ++++++++++++ man/subpop_hosp_data_eval.Rd | 48 ++++++++++++ man/ww_data_eval.Rd | 55 ++++++++++++++ scratch/sim_data_script.R | 1 + 19 files changed, 482 insertions(+), 22 deletions(-) create mode 100644 data/subpop_hosp_data.rda create mode 100644 data/subpop_hosp_data_eval.rda create mode 100644 data/ww_data_eval.rda create mode 100644 man/format_subpop_hosp_data.Rd create mode 100644 man/subpop_hosp_data.Rd create mode 100644 man/subpop_hosp_data_eval.Rd create mode 100644 man/ww_data_eval.Rd diff --git a/NEWS.md b/NEWS.md index 5adf1ca4..eec35d5c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,11 @@ # wwinference 0.1.0.99 (dev) ## User-visible changes - +- Add wastewater data into the forecast period to output in `generate_simulated_data()` function and as package data. Also adds subpopulation-level +hospital admissions to output of function and package data. ([#184](https://github.com/CDCgov/ww-inference-model/issues/184)) - `wwinference` now checks whether `site_pop` is fixed per site (see issue [#223](https://github.com/CDCgov/ww-inference-model/issues/226) reported by [@akeyel](https://github.com/akeyel)). ## Internal changes - - Updated the workflow for posting the pages artifact to PRs (issue [#229](https://github.com/CDCgov/ww-inference-model/issues/229)). - Modify `plot_forecasted_counts()` so that it does not require an evaluation dataset ([#218](https://github.com/CDCgov/ww-inference-model/pull/218)) diff --git a/R/data.R b/R/data.R index b196dcf6..3baeeff7 100644 --- a/R/data.R +++ b/R/data.R @@ -39,6 +39,47 @@ #' @source vignette_data.R "ww_data" +#' Example evaluation wastewater dataset. +#' +#' A dataset containing the simulated retrospective wastewater concentrations +#' (labeled here as `log_genome_copies_per_ml_eval`) by sample collection date +#' (`date`), the site where the sample was collected (`site`) and the lab +#' where the samples were processed (`lab`). Additional columns that are +#' required attributes needed for the model are the limit of detection for +#' that lab on each day (labeled here as `log_lod`) and the population size of +#' the wastewater catchment area represented by the wastewater concentrations +#' in each `site`. +#' +#' This data is generated via the default values in the +#' `generate_simulated_data()` function. They represent the bare minumum +#' required fields needed to pass to the model, and we recommend that users +#' try to format their own data to match this format. +#' +#' The variables are as follows: +#' +#' @format ## ww_data_eval +#' A tibble with 126 rows and 6 columns +#' \describe{ +#' \item{date}{Sample collection date, formatted in ISO8601 standards as +#' YYYY-MM-DD} +#' \item{site}{The wastewater treatment plant where the sample was collected} +#' \item{lab}{The lab where the sample was processed} +#' \item{log_genome_copies_per_ml_eval}{The natural log of the wastewater +#' concentration measured on the date specified, collected in the site +#' specified, and processed in the lab specified. The package expects +#' this quantity in units of log estimated genome copies per mL.} +#' \item{log_lod}{The log of the limit of detection in the site and lab on a +#' particular day of the quantification device (e.g. PCR). This should be in +#' units of log estimated genome copies per mL.} +#' \item{site_pop}{The population size of the wastewater catchment area +#' represented by the site variable} +#' \item{location}{ A string indicating the location that all of the +#' data is coming from. This is not a necessary column, but instead is +#' included to more realistically mirror a typical workflow} +#' } +#' @source vignette_data.R +"ww_data_eval" + @@ -57,9 +98,9 @@ #' to match this format. #' #' This data is generated via the default values in the -#' `generate_simulated_data()` function. They represent the bare minumum +#' `generate_simulated_data()` function. They represent the bare minimum #' required fields needed to pass to the model, and we recommend that users -#' try to format their own data to match this formate. +#' try to format their own data to match this format. #' #' The variables are as follows: #' \describe{ @@ -132,6 +173,77 @@ #' @source vignette_data.R "hosp_data_eval" + + + +#' Example subpopulation level hospital admissions dataset +#' +#' A dataset containing the simulated daily hospital admissions +#' (labeled here as `daily_hosp_admits`) by date of admission (`date`) in +#' each subpopulation. +#' Additional columns that are the population size of the +#' population contributing to the hospital admissions. In this instance, +#' the subpopulations here are each of the wastewater catchment areas plus +#' an additional subpopulation for the portion of the population not captured +#' by wastewater surveillance. The data generated are daily hospital +#' admissions but they could be any other epidemiological count dataset e.g. +#' cases. This data should only contain hospital admissions that would have +#' been available as of the date that the forecast was made. +#' +#' This data is generated via the default values in the +#' `generate_simulated_data()` function. +#' +#' The variables are as follows: +#' \describe{ +#' \item{date}{Date the hospital admissions occurred, formatted in ISO8601 +#' standards as YYYY-MM-DD} +#' \item{subpop_name}{A string indicating the subpopulation the hospital +#' admissiosn corresponds to. This is either a wastewater site, or the +#' remainder of the population} +#' \item{daily_hosp_admits}{The number of individuals admitted to the +#' hospital on that date, available as of the forecast date} +#' \item{subpop_pop}{The number of people contributing to the daily hospital +#' admissions in each subpopulation} +#' } +#' @source vignette_data.R +"subpop_hosp_data" + + +#' Example subpopulation level retrospective hospital admissions dataset +#' +#' A dataset containing the simulated daily hospital admissions +#' (labeled here as `daily_hosp_admits`) by date of admission (`date`) in +#' each subpopulation observed retrospectively. +#' Additional columns that are required are the population size of the +#' population contributing to the hospital admissions. In this instance, +#' the subpopulations here are each of the wastewater catchment areas plus +#' an additional subpopulation for the portion of the population not captured +#' by wastewater surveillance. The data generated are daily hospital +#' admissions but they could be any other epidemiological count dataset e.g. +#' cases.This data should contain hospital admissions retrospectively beyond +#' the forecast date in order to evaluate the forecasts. +#' +#' This data is generated via the default values in the +#' `generate_simulated_data()` function. They represent the bare minimumum +#' required fields needed to pass to the model, and we recommend that users +#' try to format their own data to match this format. +#' +#' The variables are as follows: +#' \describe{ +#' \item{date}{Date the hospital admissions occurred, formatted in ISO8601 +#' standards as YYYY-MM-DD} +#' \item{subpop_name}{A string indicating the subpopulation the hospital +#' admissions corresponds to. This is either a wastewater site, or the +#' remainder of the population} +#' \item{daily_hosp_admits_for_eval}{The number of individuals admitted to the +#' hospital on that date, available as of the forecast date} +#' \item{subpop_pop}{The number of people contributing to the daily hospital +#' admissions in each subpopulation} +#' } +#' @source vignette_data.R +"subpop_hosp_data_eval" + + #' COVID-19 post-Omicron generation interval probability mass function #' #' \describe{ diff --git a/R/generate_simulated_data.R b/R/generate_simulated_data.R index c3582bd5..df74cfd5 100644 --- a/R/generate_simulated_data.R +++ b/R/generate_simulated_data.R @@ -59,6 +59,9 @@ #' infection feedback into the infection process, default is `FALSE`, which #' sets the strength of the infection feedback to 0. #' If `TRUE`, this will apply an infection feedback drawn from the prior. +#' @param subpop_phi Vector of numeric values indicating the overdispersion +#' parameter phi in the hospital admissions observation process in each +#' subpopulation #' @param input_params_path path to the toml file with the parameters to use #' to generate the simulated data #' @@ -121,6 +124,7 @@ generate_simulated_data <- function(r_in_weeks = # nolint sigma_eps = 0.05, sd_i0_over_n = 0.5, if_feedback = FALSE, + subpop_phi = c(25, 50, 70, 40, 100), input_params_path = fs::path_package("extdata", "example_params.toml", @@ -322,12 +326,35 @@ generate_simulated_data <- function(r_in_weeks = # nolint ) ## Latent per capita admissions-------------------------------------------- + # This won't be used other than for the unit test model_hosp_over_n <- model$functions$convolve_dot_product( p_hosp_days * new_i_over_n, # individuals who will be hospitalized rev(inf_to_hosp), uot + ot + ht )[(uot + 1):(uot + ot + ht)] + # Also compute per capita hosps for each subpopulation + model_hosp_subpop_over_n <- matrix( + nrow = n_subpops, + ncol = (ot + ht) + ) + for (i in 1:n_subpops) { + model_hosp_subpop_over_n[i, ] <- model$functions$convolve_dot_product( + p_hosp_days * new_i_over_n_site[i, ], + rev(inf_to_hosp), + uot + ot + ht + )[(uot + 1):(uot + ot + ht)] + } + + # unit test to make sure these are equivalent + if (!all.equal( + colSums(model_hosp_subpop_over_n * pop_fraction), + model_hosp_over_n, + tolerance = 1e-8 + )) { + cli::cli_abort("Sum of convolutions not equal to convolution of sums") + } + ## Add weekday effect on hospital admissions------------------------------- pred_hosp <- pop_size * model$functions$day_of_week_effect( @@ -335,12 +362,36 @@ generate_simulated_data <- function(r_in_weeks = # nolint day_of_week_vector, hosp_wday_effect ) + + pred_hosp_subpop <- matrix( + nrow = n_subpops, + ncol = (ot + ht) + ) + for (i in 1:n_subpops) { + pred_hosp_subpop[i, ] <- pop_fraction[i] * pop_size * + model$functions$day_of_week_effect( + model_hosp_subpop_over_n[i, ], + day_of_week_vector, + hosp_wday_effect + ) + } + + ## Add observation error--------------------------------------------------- - # This is negative binomial but could swap out for a different obs error - pred_obs_hosp <- rnbinom( - n = length(pred_hosp), mu = pred_hosp, - size = 1 / ((params$inv_sqrt_phi_prior_mean)^2) + # Use negative binomial but could swap out for a different obs error. + # Each subpopulation has its own dispersion parameter, then we sum + # the observations to get the population total + pred_obs_hosp_subpop <- matrix( + nrow = n_subpops, + ncol = (ot + ht) ) + for (i in 1:n_subpops) { + pred_obs_hosp_subpop[i, ] <- rnbinom( + n = length(pred_hosp_subpop[i, ]), mu = pred_hosp_subpop[i, ], + size = subpop_phi[i] + ) + } + pred_obs_hosp <- colSums(pred_obs_hosp_subpop) @@ -381,6 +432,18 @@ generate_simulated_data <- function(r_in_weeks = # nolint lab_site_reporting_latency = lab_site_reporting_latency ) + # Create evaluation data with same reporting freq but go through the entire + # time period + log_obs_conc_lab_site_eval <- downsample_ww_obs( + log_conc_lab_site = log_conc_lab_site, + n_lab_sites = n_lab_sites, + ot = ot + ht, + ht = 0, + nt = 0, + lab_site_reporting_freq = lab_site_reporting_freq, + lab_site_reporting_latency = rep(0, n_lab_sites) + ) + # Global adjusted R(t) -------------------------------------------------- @@ -406,6 +469,18 @@ generate_simulated_data <- function(r_in_weeks = # nolint lod_lab_site = lod_lab_site ) + ww_data_eval <- format_ww_data( + log_obs_conc_lab_site = log_obs_conc_lab_site_eval, + ot = ot + ht, + ht = 0, + date_df = date_df, + site_lab_map = site_lab_map, + lod_lab_site = lod_lab_site + ) |> + dplyr::rename( + "log_genome_copies_per_ml_eval" = "log_genome_copies_per_ml" + ) + # Artificially add values below the LOD---------------------------------- # Replace it with an NA, will be used as an example of how to format data # properly. @@ -419,16 +494,27 @@ generate_simulated_data <- function(r_in_weeks = # nolint TRUE ~ .data$log_genome_copies_per_ml ) ) + ww_data_eval <- ww_data_eval |> + dplyr::mutate( + "log_genome_copies_per_ml_eval" = + dplyr::case_when( + .data$log_genome_copies_per_ml_eval == + !!min_ww_val ~ 0.5 * .data$log_lod, + TRUE ~ .data$log_genome_copies_per_ml_eval + ) + ) # Make a hospital admissions dataframe for model calibration - hosp_data <- format_hosp_data(pred_obs_hosp, + hosp_data <- format_hosp_data( + pred_obs_hosp = pred_obs_hosp, dur_obs = ot, pop_size = pop_size, date_df = date_df ) - hosp_data_eval <- format_hosp_data(pred_obs_hosp, + hosp_data_eval <- format_hosp_data( + pred_obs_hosp = pred_obs_hosp, dur_obs = (ot + ht), pop_size = pop_size, date_df = date_df @@ -437,6 +523,36 @@ generate_simulated_data <- function(r_in_weeks = # nolint "daily_hosp_admits_for_eval" = "daily_hosp_admits" ) + # 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 + subpop_map <- tibble::tibble( + subpop_index = as.character(1:n_subpops), + subpop_pop = pop_size * pop_fraction, + subpop_name = c(1:n_sites, NA) + ) |> + dplyr::mutate(subpop_name = ifelse(!is.na(subpop_name), + glue::glue("Site: {subpop_name}"), + "remainder of population" + )) + + subpop_hosp_data <- format_subpop_hosp_data( + pred_obs_hosp_subpop = pred_obs_hosp_subpop, + dur_obs = ot, + subpop_map = subpop_map, + date_df = date_df + ) + + subpop_hosp_data_eval <- format_subpop_hosp_data( + pred_obs_hosp_subpop = pred_obs_hosp_subpop, + dur_obs = (ot + ht), + subpop_map = subpop_map, + date_df = date_df + ) |> + dplyr::rename( + "daily_hosp_admits_for_eval" = "daily_hosp_admits" + ) + # Global R(t) true_rt <- tibble::tibble( unadj_rt_daily = as.numeric(unadj_r_daily), @@ -453,8 +569,11 @@ generate_simulated_data <- function(r_in_weeks = # nolint example_data <- list( ww_data = ww_data, + ww_data_eval = ww_data_eval, hosp_data = hosp_data, hosp_data_eval = 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/model_component_fwd_sim.R b/R/model_component_fwd_sim.R index b5449646..956e574d 100644 --- a/R/model_component_fwd_sim.R +++ b/R/model_component_fwd_sim.R @@ -422,6 +422,52 @@ format_hosp_data <- function(pred_obs_hosp, return(hosp_data) } + +#' Format the subpopulation-level hospital admissions data into a tidy +#' dataframe +#' +#' @param pred_obs_hosp_subpop matrix of non-negative integers indicating the +#' number of hospital admissions on each day in each subpopulation. Rows are +#' subpopulations, columns are time points +#' @param dur_obs integer indicating the number of days we want the +#' observations for +#' @param subpop_map tibble mapping the numbered subpopulations to the +#' wastewater sites, must contain columns "subpop_index" and "subpop_name" +#' @param date_df tibble of columns `date` and `t` that map time in days to +#' dates +#' +#' @return a tidy dataframe containing counts of admissions by date alongside +#' population size for each subpopulation +format_subpop_hosp_data <- function(pred_obs_hosp_subpop, + dur_obs, + subpop_map, + date_df) { + subpop_hosp_data <- as.data.frame(t(pred_obs_hosp_subpop)) |> + dplyr::mutate(t = seq_len(ncol(pred_obs_hosp_subpop))) |> + dplyr::filter(t <= dur_obs) |> + tidyr::pivot_longer(!t, + names_to = "subpop_index", + names_prefix = "V", + values_to = "daily_hosp_admits" + ) |> + dplyr::left_join( + date_df, + by = "t" + ) |> + dplyr::left_join( + subpop_map, + by = "subpop_index" + ) |> + dplyr::select( + "date", + "subpop_name", + "daily_hosp_admits", + "subpop_pop" + ) + return(subpop_hosp_data) +} + + #' Back- calculate R(t) from incident infections and the generation interval #' #' @description diff --git a/data-raw/vignette_data.R b/data-raw/vignette_data.R index 38c61081..8f4c2dbd 100644 --- a/data-raw/vignette_data.R +++ b/data-raw/vignette_data.R @@ -1,22 +1,19 @@ set.seed(1) simulated_data <- wwinference::generate_simulated_data() hosp_data_from_sim <- simulated_data$hosp_data -ww_data_from_sim <- simulated_data$ww_data -# Add some columns and reorder sites to ensure package works as expected -# even if sites are not in order -ww_data <- ww_data_from_sim |> - dplyr::mutate( - "location" = "example state", - "site" = .data$site + 1 - ) |> - dplyr::ungroup() |> - dplyr::arrange(desc(.data$site)) +ww_data <- simulated_data$ww_data +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 +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(ww_data, overwrite = TRUE) +usethis::use_data(ww_data_eval, overwrite = TRUE) +usethis::use_data(subpop_hosp_data, overwrite = TRUE) +usethis::use_data(subpop_hosp_data_eval, overwrite = TRUE) usethis::use_data(true_global_rt, overwrite = TRUE) diff --git a/data/hosp_data.rda b/data/hosp_data.rda index 7595c3bb63da37ec0c78e995b9ea137bb3e08967..83e0eeb833d8928bc8825143775be9bd48780ed4 100644 GIT binary patch delta 601 zcmcc5@`OdsDJsL#&@oaiIC5`Y&2I+Qef8J>7iTcI{|AGKauW56R=!HsxGW%La)GV? zZ>Wjf0+S5pzai`)M)$ax*^d{WcJyJK z#1d?>wo8-MX}$AT^{z*Yp1WE6bPlQ8v1Aozh}ItI@PzXZC(fVrsh+EL(T2xP*E9@P zaB{}9L@9N!N;)Zh{=Lc7d-kSOK|_%2H6Qre}6CMJbm%vv4>wFgP(TaA@q17HDHo;bLd2Zb&%T%*G>O zfJBMZi+HlCu(M}5?opb+knLoa=aqQhv^Z&ttFfg0%r&}#UN4Q8DNX9x5S`|Iqta+o z*`cm@L63>Ml%{|5&wKOyNWvvSKk2l4jUtEZ`MB2I%JjcdcqG_4pWo_9#+idtT(u?! zb>*cl2yrwEab!}Ma|Q^`y3PcFRov6|=M`M}XVm=Ym2}X;?YV2#&e*LWlv7$Y$x{W4 dOmy^16&eMCIhJp{az*vOc#*3`zywe#0svwC2Ppsm delta 596 zcmV-a0;~Px1m6T6LRx4!F+o`-Q(1%es|^4Jy#Lq#b7%lZ|Nr}c|NW637=NjyH9V$( z(?da#paK7?p!EiTZ}n7Yey9xqWYE!}NBXLhKmY(VXaF(*0MVcT00E{Ms;T;+p@asS zWXJ#-7@7dc28JPs05k}qp|wp<6!e~;&@=-<Bnp1y)Sae%4cZo4K?4@a5SBL(AU@KnGFhCPc085~Fb0Sb zO*33rvI>P+U#U!1l@|1E$I2R`^Ti^Fn~(zVO(50%Nvorbf}8PdFMmSY6c_;jh!hA& zP-YQEW>FV^yC|u1dRd5|ifIF403ra00tmtWl`KFSYruN|7%&VN02#~~!@dAJ{9$!E*;L zaniU^OQIY%CIzaj8qGbJhO3=Dg*24`s4qNJp|bQgTaIU>30`AU~pjI073@F15BI!_?nXx zmFBOwB*nnXz-uD^YgGobLgtIFzVAa7Y!#$D<)7z`)C_>^6(dfkDdT z;wz4s0U5juj0+ebfX$I>iV~P9WpV;&^a94kL2n;GCDACpDXN-=Ee9B!m}WE_QgCq4 zmD-l~@bvP0xdlJ}a2PB+(k*4vX|(jr?Cy=5gVpscMNNv_{ggPTYDaz9wDa_|(4#yd z&t#sS=zhBO#r?Llb=@29FF6r$)UrbG#3|p^(QKRjxV~nDKXlq9^%>_Z*ShIbIX$~?mW+ks9y4Ez3Sf1S^n9A+x9Pv@tBmCw`r26%H%noDnM#df2LNRG3w!_o literal 655 zcmZ>Y%CIzaj8qGbG{4@whkcHn7T?7*YIxPU>@B*~zG!DXsi@K=ruwuX}nC;PG~U*gH&Two;8 z)9_a_>+1&wtblJzvcxfMi5|yAS{p;VIGQdr$#j{lys~<7wAS8k%gUKMZ~l_93fuD4 zG&?){_QtfHTSZwHW^K4W-K%){nJHT|{gvN1G%YcbJ-Aiz!pHa9!rq?ki8A_Ix;Zv` z2JfxS>Dl?!vzK-C?ftMY6xGT)DZ|G3bJ^0!xDji~8-~UNMb23swlR zC^#{=ajXk*1;L_4TDuSKoH={r8q=_Bser4Sxs9E#i|$x-=IhJqy~gu*%)I<-^O{L4 z5=k>Ax;9Pa6jNbwP;zMG=m=<3ahb7UVq57!ub?SQHBpEq$6MAIp3dE|@m5EtlGfgR zUhcA?37s!GUe{>-e17p?*6o$8p}Cg!5#G9<`YK!d&Pi`x;;=ckGca()uiJ6uZXx?- z7@GF)?{{A;yO@<=qIAW`}M(l1^_{uAeR6D diff --git a/data/subpop_hosp_data.rda b/data/subpop_hosp_data.rda new file mode 100644 index 0000000000000000000000000000000000000000..29de916840b52c20232fad3acc5bd125460e1fad GIT binary patch literal 1122 zcmZ>Y%CIzaj8qGb6f`V7#~`g+fBgUNnk(V|f#CcfhyCUE7C1NrFmNz1I5;?7VBKT$ z@STO$SvCW?+{0SSS8j2eG0Wsc=464(3~fHMQZ6o=$^SRhkeP!=z(i@DbFf43SC+ql zvlJIQFi7&+Dm%Vn00O4qOPwB74g3Le8YYYjfC9D-KtfQ|6-@sRWnj1f0|zhb#HtI~n3;o_@|zrj}+j7&1l`UlUNpYli5YpPbr%AlpBQfvBI zg2jB4ZG3lLoHympT+NqfgO^)PUTt-Gy{+es*_*G5!$ zuU{wfz5ml{j;?mn>CH1%AW$9Bfy4-rzEzjC!bHjnY#XLoa@xwMuVM+1{z4|2FP#)%2GZSiJj7#^LNN%|~~=N-oVUS$4dB z;ra8@oxbK1TfH(v!n6dAT%MwJUh>fjNrSGrBC}umtm^u^!EFw&eAuBir)?x%Tb7A# zm~!gGydP6Os9L`Cd9KW-ppwAJ!Q{p{!&PBzlIEs=VUiDK?B?|8oODuixly{YSAe%m zP*Vh_f{F*%*$9rM8jUk~3)cj@x+!V6D4Vxz>P(xW;_2=5*fY^X;Kjvxy;{Z>uPwHf z=`uavl|Ad(&b?NXi%Qj29<)$DZF;tNwe=mz-UF#Vy;>$qGCpsSoE^tp8CtfcUrsRS zh1--hQXEQs0y^hiWvewO_S!`-((!y0MCPokmIfQ0zm~!4?*{fia<%-t3e=@J_ zKjD@5_`~n@`Q6$_-v6-C^snBU^GRk-%9IO_cE`R8o4YP3*zVf7Imt}HUcu9*ob6Lt zp6=|bxlr>Tr>{(=FA(~fEblye-mCD>Nx#Um&z4%wxv%XMylu*%;B%oCcX{VM7FVB{ zv((rt)2ke4_;%YlmAiS@$-dold!Njlhng+REW<4|Prg(VY%CIzaj8qGboWI{!ok5MG{`mjjaaY3s1Ht(}4*SdRuW)j3VBlb2aBy&bz%C(v z?}P6L#(540URWrKddw77Yi2aLxO}nV{!k7R6Qc|h>0th#`d2F#vq&Pz!Dnr|8Hmj<6;M?Bwhw1HZ>-o90NlJo8*#?B}ohnJPiyc zyhaQR7o>oqzFw19X1jb^?91>KD010Bis51huT(}=xhxfEXD@ zm*33lRGH*SIbvI|>fDxV9H9%XH7CtovSFs@v}r+?($uojRkyU9_bEByGv$=emNPzA z&iQ<~;OVJr67*0_ZIatsli9g@-=*vKu08QLLU(@fl8kt_^^524ycRlZx1qp>35WbS zB+n+OcB&uoaQqaawmvMBDPVz7TUN@1B|fdCYI}W}>zx*yvk?&1+%c>ZX-$(UH>ID#5o!YZIe@Zc6epfs`*QeiOwPYX$^HMFdF; zCt67<3aopYS;@hDGEi3C!9`51bm5^@(;b%Y_bzMX3RFomT(hlnn;w%V+u78e!Kyzt z$lG1m!_dgUC_ZnB;{xRlvp`|hWtVQfG5R+9teb|B>dR;O>pi2M>fQ@o_e5D>MhoAS zo@FQ2rm;>o*!S3S*^O3_1s#GeSDG|bUK%R3+^rNmp>lv>)sbxJKlQoq@{8xKp0{ev zEzY>Br#}{nhL+p9%l`dYV-u?Xc~2EX@rxxNe$BOd`?m4%7lxk)Y89-kukU&Mxbb-O z-ld_jNh_0>POop7^mJ#cU}46p^{iT793Cz8zICMZRmrctEIZwGE!tMC_IknG^&q~j z;oE`l3yLhaK3SQ%DsolSTD=Ani>Rfm_4)go)&&Qh`jt@V-CDq2JykDwf=tlE12RF6 zu54YIx-vKD?i6;B9apw3-Kx7X>+sp7)3{AUI-CSlJgz9&?A*3>smlVxfP5+;lr zr50)ha=Dm_`>s{n$s06p$x@R^Q$DC_KJ*ISGi}nLC~wWz{z=)(4h79zxoKX>E#DijLBQzZ4l`cuPSxj{ z9NfoM@(xdx_H+z5)y3K3BFd??!c*XaA}14zg7b#A0TWkpYFyS#%)WIevQI2T%jM9M zW4GMY%x7>htuzqoJEGgG9hI_GM)c9%fEh7f3~K~gJQ6INUhj@9uNAzu;WQ8NXiEm4 z_pAqec^R?`iq|C=J->8Tcj;OU0gv+29Sn2%CWJDq?^H58e*1das&y0W-!fi)%6tO|PqF*= z=c~_QpMH&b-fnA#&(${nCfF7j$n&h)pFi#M@A*>ajW^z5o*?_dJiLQHefH`ax$f;p zzwVJ)?|d}iAZzHt(2TtWpBl2_P`_k`NXk{AB&CeNDeiU%ks@dLEKsyFc~QkH>e#i(D-N ICV+}f0BMI-kN^Mx literal 0 HcmV?d00001 diff --git a/data/true_global_rt.rda b/data/true_global_rt.rda index 399520388d6873a1278e61be94909519651c969b..c1a6d882047826236a0403955ff3e97b28ea2134 100644 GIT binary patch literal 2182 zcmah@c{J1u8~%+M%P_+rOp7&ks6>{KYD6;Du}=)fzJ^Mu zkgUtf*008I* z-~!=z>b?@70f06caUiG29E}DmLz5|LJlsJHrXAn`@@%Rs4i9@=f&t@Yf19arp#OIV zEx`dX8=&eyBJ`y|xG`HG!8VsI3k za5(1RK@4b#x*snKcrFQ+tPSt4;(mL7KSV`S2iPGrs!&j`x|vGS|0!Iy^%d0*PA4es zsowRyuLsRZ<(|Z!&j-Jw)Z;JeN0;v(d=ASeDA53oc(S7a%Rd~=$V)_~!M*0@Ad&C3 zG=(!}6C`!^T0Kcg$&p^;wha|EZ|IMYXFYS{R7DW}6U_jqjX*k4x4f<6927aAZF}>J zvJX;DT2#-_1giXq)Rw|3C}Unjj|Shdlf=ease9d$iS@;Pn_Zst*1IdeB6FCo^J6y{ zCZw$XP|t^rba!!6kpSGGFucJzLHd~oj>c@b4UNsGAS5yic}NgO2=(LwbpOAeBV#sY z7X4!`r5T)f6c%gx5Z1#pm*eBS<1zD-fxhOr{yu|(YAE-IqEiZLx1?ZP;-AAlO>+T5 zF6}-q`12m1a-dwd!9x2ZCqd98ZD!c|Wm~^1PqRS8!u3Liufi(_`k3w-Eqz@#{KZgd zVjSOK-8$f}cT9n?S-TmEFh}sGy+jMWwurw+b^tHbrO>W7Go5+st>_J-kWk`HLEvVl zQeqI9J)NDjD#tHQ?uHresOChjU9N{rCmm;HlJuhU&{<31wDT=-H!$SgKh?~=?%%lc zu7l7)IK{Yp>1#u!5o6(Lwa9Id>!VgLa4&P#{?J9nY?_e3i{a&r(T5w#XKtuTy)HMY zmpYcRp2tr{9B?vxBMFI+WXsp0E``_XZW+g*(JjkO<-|{wCVq%ewWDCC?jQSIN0t-No+n7h#!xow%Y(2mS$VRHsy$i$fhW}cClXU3^EjE%inqO0NpUG zbmBG^5)8?R(5li8t>F~oab>7RU@24nDpL7FnSQpv<;VayH#C8U(0S%#2+b_|@dvM8 z?kmvjqiwWUTzG*M;>SUYcD2nVk6pH7Mh&A_5}tL5+e6l78kxj^yYrV_^ZL?LYAudM z^gLau_^Ir7%Y~i~@T#?^UZVmTlKEcXEy4|}9l*ox*II+9^Q2Q9pXkw0v5V$H36i|m zlPrqx$}MsHO^**$a zpu90Dk5!tZ>=PA7O9iRbzsi(kcgij?{ThY?qkWFtljgt>0FrvPL%U4MaC<^#4m++N zo6dpJO}E^s|a$qN~9<_xZkE7sQ#KG;<*l z--``OHznecoUaq(G`T4oE%{jphw%gg>E@=KS^#xjwztR%R#$cCo~}R;GWY;$3mwuf z@hR`Uk}i@7ZHSy^{m|O|=x71E@LkE2d$4tCh1aMTAd%HCPIC&=?#in8jG<}+Hj6p* RKX;GMM*HL{FdfP2{{pa};P?Ol literal 2169 zcmaKnc{tRI8pnUL7<*x?W7n8LcHnr?NXXNx z3~{p*j4_#SjKRR@1Xs-11JVqc9K{F5*t70VoC@{kmRZ|5vXOCGE0f8|Zoz~xBz}^j zhQo+tB0wij8yQp54OQ3bDI7!v?--h0fkNejFhdey1oUpp7!3u$!C@!{#xMh5h#LZM zwW+zP3a6YxZ-*8N2UV$vs>1M$#GzCihBwBc@epKy2P&~8&=3j$nFnehFcctoHY~#x zMk8YoWJ=L3X-?_yG@dvB%g2G(00IGsBLD;j-~j-P1{`v@1R%CJ2#zccC?JuQD(vk_ z7@fw4WgNbsaPZeSGyui`5U`9nqeg&?Fh0D&02B@bgMbidkQg$E&6{b;d*4{>g#7<1 z`4cL(o7VmL{Hymn3rDB6Bn*iGCK;Jo6!D{RIsfW4?*jm1pVUseG@uf^z*_$>bumr5 z$tYaxlE$;9$HJpKS_5Of7zE7FhFkdEUr6@fDBa43!)7*j=-D~JA)&Cp%lrrE(4h%1 zg={1}0LW4MyvC8)sMFDBH0Q{a7}Ub^my1jDU$9vIxVd?s#dqb}H!30h1_^}&&6`W- z_Cb>{kt0&F2-SW`nc}?B^7IpL00}#1p}V;tx^un_UJbVD7*W?%Wab>%R&5T#*??(6 zG&MEQx(yEM<&jmC%>_Ug`~@@=#;7-UEz`y|AsFn+t`7}N8_pqLz3(Q_dfdFbWWN0* z&7bKAk781Wk~~lX2q$>8k+r&8icq6=9^O%Hqo8Ri~ z>(+$PMTL%c*4*j-a@Mj}t0)@dys4mF-IXLZHnQvxI>Ey$kuHCHm=91nI^l^a-hnyL ze5Hi#SK-SBxs&&3H3Hc|c|Y&T3s$&@MxA>)Q052(S=dY}B*4}eei2ocwO<<|Qj)Ap zKFfoXhAX&HqHBJmneS5I-LdL<1-5IkIP*>ujZMX9NC;O;E43jcVTl&2g6Ex5*6@K} zX>YE8jy#&nU+7-yHvU%Z4gRpkP`_0cT|azERPn;cp7jUS*S#kzgzrMR!IvVcGk*a~ zy3PCVi}KXGv+|L+^a0ll->xxy%4;t`HpQiWWMiInBL!_MaZ29(T$pT+4qg#;Z$(Td zCa^?see%v})|C4V)n0c)18i->R}p!6_e^Ca__X6j#lC4J5d^Ve&1r|5eby5B^4cL~ znbq}G!mg$Lt&!DP*@>U}$4+ge#x=@4b7|mD)$gxQ$R)-Zu0IT6+AcX+hnrx_hS>UF zeGQ;TL_BY|=+`OS^Z(8#-8vBv=*%xRfXZA*fC}b_jki(Nth+;ezT&C0bB#sDhB1(5>P+S1$=^sp}sp8tUv^>`kVL1 zIS>VFJ>HWP^lPM|wK6;VP#vwI2u|P-d`B}i)zq>%fbY#6A-@+6d3~kJprknwbO-AF z6KUx{j`b)z@km^~)Gki%h(9Fv8CuUTBt>y#km+)bKcj=QM}FP&_9_l5Y;^Boe|2c~ z0L%BPisc;pYxb0#+7y`6l(OZwD|*F7ag-iS z^q#cB$(uf&Pw+mp+-Ch8nYPL?_G05}>csVbE<);A7OY5F@z3%UIEZMMr{q|t%kol% zN(n<^^)?OQ`SGiB+FgD}oy_%SHuln38qd_+CcOsVDa?R9VZpMQ*&am|=T1I)(%UiE zV0JQSOU@cAaI^i!@tbA^^#;D+G27`-`YWtbGIzYP6+Ts5-JwJ9{K(QRU`phP>qIQ_anA=mgj`1Lp z*_j^`51wZSUv=@L*Y5_+y3;PQV3Lc&_84_5SM$BjP2{BqvA-5trEiu4YnG3G{fCpp zk$%6MmVPKUbS?4tcwEg;FX&-gbi4q5e058zyVqaCUogTJ$pX)6Ab_|vN10NAgz9k~ za`!b!8gM<3`}U)gL6Q0`wW#3Z{?q9LoLws=a^}9tZ|t(h+0hr_gg_|nysNgdJ~*1~ zWS_nQvDBj`1;#6{An$laR}p4RedF^6bWOICc_QDKK7f`Rgz`j&tRjK{pWsdO$Lh8Z%#m463QcXuwtTZD9@C;S&4#?IE^3WL)yCwA3jOc;QGZUPqzra z#4sQUoe|ra#V*r14qQcK)u;#sSBT z?0Y>JRgLem9OTJX&oxfV+oJ>nR{92e>jD(jC+eP&qfb+69wgJ$H1v9q%|lHaP|#_hdW|v26UDUb|}JrmPV#TpF&00001 zpa1{>&;S|%rkZ9`3|nrQ7QeJBNp?6DCT`A|eYv@el^RL@WenqzFoD z;3!J8BmldtAfbPrNQL;XhC~<{1-gT#A&7t@)MbYuPIFbVp2XMxi=N%GU>Cn$Yn27Plvaf|4obdp&Rk7)8hCeuY8@Yu5zfoU2AWe`kND5>0yLmA2Cwg z00kk;7j_vNW`dZ3n7R7bbTfefEFNH?@*9wzIH4Tu$a?Typ$QPw5TRrsgrJDYQ4<=S zC6Pdw@?#1ryRz%VkKT<`bS^@f11#AMh*%Y2DQ1byQqRnno>SbRko}Tbt z4&>mnS9SUO*jJ_yx1#@L?70WcN}FhtxP`UC((W`?JO8oe**AYEkX<{M=2oFiDgpwEAwohQO7Lc_Hynd+Gzr96q`jDe@7lhpD?CV}FE(maq#N-62006kAg z1JpG1ntGW4+6_VKXk^gZntFi32AVxXKpFv{0009)pn8A?K+pgH4Lv|KGy$eVOqvWz zQ~(c9&@?un4IZOF(0Yc{007VcX`lcA0MkZ;AO?T{F#|vu05Sof00006fDixx0iXte z0000D0000oXbgY=0MGyc00000000000004#Kq8V6Ae$8SsBI>L)Y0kUpm{(Cr~?qw zKn(x}gG_+*o})uR$N&RFO#^Bg13&-(4F{+IWXNa_Q$RgPo>CSdk|-d>1d2?_nSw=- zW+9U^CLtunGG;-UFlZWqc=8IU6;`na2KKjIYV;w*f&ea`{vd)P5Djhx2vn-BrhpWn z)d50#P>>4iFbD=Jc_0O`t4c`(Rh~n63Iq6m-jw(eMSv(%t~{AxQiT8u7_F3&fKrRj z>Od&(FoLz<6dE~ctR|6C@>zSiO+bL%-QdE;6}b>t1O^~)pao=*CmGpV_-pO zo9AB2teXs2S4;k1 zvx*ul^xFl*xp?uoiYCjbV`LW)j^Lm$bMT+M0j@^+t+a;^0GLQu*8zuBg8r1Em1&>;s+v#m$-MFc7|d}ozK|De&pN+{DFp!Vj@tSBh*91H)s?` zURj5c9ttr}V%#rd7+Vn0QmS~Odlb2Dzg)0uJOV5UH6oOrhx$YU1&eu1tY;<(q=cR^ zLnpIuof&Pw+ZmEGM_-!b^Cx4A$>FTB3K0UOc>sqoQb026g}}xLOT<*5S||XUp;V=N zYf9?FN2S7W`CII#qd4gOB&-poxgsN6R{j%OGo+ws*7H$TW^1I*<>kZPr)t_|{gTV3 zkm(AeGlH*xpmm92Rjk28Mm?<`<mN_IAnH!l6tX{p~X<_n$0j)zTE9pcny2zyk~< zf4$@BUPn&s-L$g_#rBm|i5o|zbL=!%^TK+I zCJpyWJUt#SH;MX;9t%Q!Y6CaAQl%&m9oG?{n8&T}$C2*lm2KKtH+8ADjSxUCi2xR7 z`DX_kAV>h}rf<^px82Cwd+?u4A6aD`T2()_Z~$*mHWd?3uUcqv9~EfM*0E3$%!JGJ7ORr=!atwC51zg6YAt23$p8RS4nP1~2sm%l3Ds2e-F^gE?MaZ;$^nKyYp z3j4Eid;Y0mr$|R}B!$^W-yEqsU3tUN+rE^G#j%)jh!$53mq$qQ*fRe3=(7`CKE~MD zJK|fkz#|H~r;_sU)9n8UfC{DY_o-m44HlPU0V2Ot&M%B008u7#WV&4HhR27~7>Bv- z-l9YyKH+!EPkLQ5pnPuI0OBf>HUXMo0#UtSw|2#~&-0`}+`iY>>D}4vAQ65S_<5<1 zm;`+*3tmoVI{X4q;TtlgcX&WLaTYhoIm7}cXTVsMA*+gxtVFmBf5qI9P81{;g%vo! DlbG>! diff --git a/data/ww_data_eval.rda b/data/ww_data_eval.rda new file mode 100644 index 0000000000000000000000000000000000000000..176a52b471dbadb3a38f39b5d9c98f9beb7ba6ef GIT binary patch literal 1925 zcmV;02YUEIT4*^jL0KkKS%_c%%m4`zfB*mg{r~^}|NsC0|NsC0|G)qL|NsC0|G)qL z|Nr0r|LxEPT<`*vd%4-#&t}(1LXk9@Jx@uKPbfT-YBcp8lha7VdY+@j0py!V4@v3` zGzNgvN2#MmY79oy4@e%Ts1H-r^#B0%9+O5*JfXEcA*PuPH1!Wt(F~hOqfDNmqd>}O zp)d)i27+MJW`jVO4I=@dnqZg#7$Zyo01^6t011FK8ek>>00hZ^00h7Uc>pv9p%P6L z^&3xA{U)Q-!8WEN)HKubiIXR(nunr1Q$|6M#A0Y*Lm00000000000000000Te(00000 z00|_Br|MJnPs%n$F{$KF6xvObBP40)nr%-g(0YxjrbnnfN2nTU>Ulxx49Om$>S*;g zQRIx&@{J81pfmvTjRuCA4H^vrka~kn4LpgXKo3eP!Y&v9>BkV@4DJcg>Co=(ojZv- zcOBiG$7gqU2LN%?x(7p(1u>aS)6G=caYWQPP6XhLslny)&6weHE~KTVu0ly-_d-BT zhy^^556h&G=cW*n9gPPeBomAY0?0n#1&=1#IAVeK3q$|&|I^q_3IrsKn7R@P*T51+ z9f}T_$OWQnMnDK5GC%$ly5`_)H3HL$qxYSHIjNOxQA`>b}r(Ewz0JixgB>(3b!dLnx6{EpKBFI?XodQ7>{;65xUw*G}_%gdqe*KwnVrdk4fQ z%m^NudE_Oa&}#9Ok8bLC?WFJ|PhUyvV&d@`v;}*%bkdm*!Ng1))5-{rs+ZP0U$LdE z^e5k?YSuQ)bc~}gZkY3a0SUqr>?D|G229qg)3h+5AiQk=BvHq1n4m_@U+B;{s3m2m zI!iVeG;T|PZw^V%?(d$J+#xR3O7>o_oq!@TmTAhE`nSxbgNP{|#WUKM1sxPUq5<(# z_b$xCm&HGN#yN{^os-MqWu(Knh(~hMvaMQQF{Oitia{uNS5xgnw1YFPfbtN7Dv1yw zVh;vw$Zzu`y-*6IS%@3TiTXUV_HI_Jwp&+D_#C~3kb#&$sqZIh?(WO8ylJWW*H&G( zB6qacc9)&IN0jOWGb9BL3!VT5WFRqF%Zzew(3?Cf9YZB2{ZAknFuku4e(gt7cEitd^FDXXS0yh3^$s;Zd+S=NNr5 z3ep;0p+4WC# zNedpAHh0;ARdFb&2oNMNnFv6V1cU%22muHHW*&w+(e53F@~)0;2U1L6q`^=htAP2_Gn> z%ZSD2P{TWcLqN8${6lb&KDz^7ID;iTvFcd%t)Wn=HSa^LsVn%x8sH@@Wu%y^nkd8J zjh&ghz>usM(!R@1BetuRXHPCv(=%p?NItw*fezK93)Len{ha)M}{+?x~g?sE34M;tY-P*(5{| zqYYbc4+(muG}eaLQtRF|i!isrJcIAB0{|c-0D09U0RenZMjVaw5K*}ZB*0AzaXmGo z7?{5KC1A|zX907CZlT)A*H6S|96e;gAec5u?GPye5Jd|z9V}~SRQic01|$4vHO%9J z`KXnJh71uXY|!tFh#x1~7_>91>w`(>-@I6bO7oNZ3)Pzatu6xTRE&m33uC3+fPh4r z-5;A!WD5Wg2Z0OP)yI=)inHvQX~W{M?|JpVkPrhi5kwyFUEr#ONx?HA# zm*YpKOy}!mA1`b1pAZ0HCkXNX3lH4bt4sm|lbc?R^Q46-2H8;>GHECPfLs2|$wb*; zITSVu5IuYde-tnZpb^8=e8anK0sR1AAc+7VphX0F1Q4Zx#tT<>Bp?8TqeiyHce+Lr z*3WNQPecA_#Jov`ifil_r+v{RI067w9VI58+E_s-pR^aUSlrY8Mt00e3YCKWfnR>U zBwa*Y8d;bv@Yr0Z{qkHPDx{H2Qb2!nH`!a$YJ=!8C062?ZY%@@eE=X3_Sia|`a7+0 zOugnhD~b6gAS2c?eXc^d1OlUTntqLD$g3nk0svvb6}3J?h??9Xn7QM@%mp%R{F1VE zGI6k^?Q+t>Kv!)+1|}@EKDz4LOlg4z6?Da{omAoiMlx#3%>jSP&?r-0o Date: Mon, 4 Nov 2024 12:00:39 -0500 Subject: [PATCH 43/46] Issue 238: Fix plot bug (#239) * swap order of plotting so calib data shows up * fix plot function --- R/figures.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/figures.R b/R/figures.R index ce40b45e..03ee740d 100644 --- a/R/figures.R +++ b/R/figures.R @@ -57,7 +57,6 @@ get_plot_forecasted_counts <- function(draws, aes(x = .data$date, y = .data$pred_value, group = .data$draw), color = "red4", alpha = 0.1, linewidth = 0.2 ) + - geom_point(aes(x = .data$date, y = .data$observed_value)) + geom_vline( xintercept = lubridate::ymd(forecast_date), linetype = "dashed" @@ -91,7 +90,11 @@ get_plot_forecasted_counts <- function(draws, shape = 21, color = "black", fill = "white" ) } - return(p) + # Add calibration data as final step, this should be plotted on top of + # the eval data(if present) and draws + p_final <- p + geom_point(aes(x = .data$date, y = .data$observed_value)) + + return(p_final) } #' Get plot of fit and forecasted wastewater concentrations From 7c753499239abdfded182f9e8be1219827d889fb Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson <94390107+kaitejohnson@users.noreply.github.com> Date: Tue, 5 Nov 2024 15:07:54 -0500 Subject: [PATCH 44/46] use `pkgdown` from main --- .github/workflows/pkgdown.yaml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 58e00f10..862f3750 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -4,7 +4,7 @@ on: push: branches: [main, prod] pull_request: - branches: [spatial-main, main, prod] + branches: [main, prod] release: types: [published] workflow_dispatch: @@ -33,8 +33,6 @@ jobs: contents: write id-token: write pages: write - outputs: - page_artifact_id: ${{ steps.upload-artifact.outputs.artifact_id }} steps: ########################################################################## From 39570b09e4644b7d266b5ff799f3a583fc1caea4 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson Date: Tue, 5 Nov 2024 20:26:04 +0000 Subject: [PATCH 45/46] fix data.R, remove extra docs --- R/data.R | 89 ------------------------------------ man/subpop_hosp_data.Rd | 37 --------------- man/subpop_hosp_data_eval.Rd | 48 ------------------- man/ww_data_eval.Rd | 55 ---------------------- 4 files changed, 229 deletions(-) delete mode 100644 man/subpop_hosp_data.Rd delete mode 100644 man/subpop_hosp_data_eval.Rd delete mode 100644 man/ww_data_eval.Rd diff --git a/R/data.R b/R/data.R index 043cd713..42660979 100644 --- a/R/data.R +++ b/R/data.R @@ -39,48 +39,6 @@ #' @source vignette_data.R "ww_data" -#' Example evaluation wastewater dataset. -#' -#' A dataset containing the simulated retrospective wastewater concentrations -#' (labeled here as `log_genome_copies_per_ml_eval`) by sample collection date -#' (`date`), the site where the sample was collected (`site`) and the lab -#' where the samples were processed (`lab`). Additional columns that are -#' required attributes needed for the model are the limit of detection for -#' that lab on each day (labeled here as `log_lod`) and the population size of -#' the wastewater catchment area represented by the wastewater concentrations -#' in each `site`. -#' -#' This data is generated via the default values in the -#' `generate_simulated_data()` function. They represent the bare minumum -#' required fields needed to pass to the model, and we recommend that users -#' try to format their own data to match this format. -#' -#' The variables are as follows: -#' -#' @format ## ww_data_eval -#' A tibble with 126 rows and 6 columns -#' \describe{ -#' \item{date}{Sample collection date, formatted in ISO8601 standards as -#' YYYY-MM-DD} -#' \item{site}{The wastewater treatment plant where the sample was collected} -#' \item{lab}{The lab where the sample was processed} -#' \item{log_genome_copies_per_ml_eval}{The natural log of the wastewater -#' concentration measured on the date specified, collected in the site -#' specified, and processed in the lab specified. The package expects -#' this quantity in units of log estimated genome copies per mL.} -#' \item{log_lod}{The log of the limit of detection in the site and lab on a -#' particular day of the quantification device (e.g. PCR). This should be in -#' units of log estimated genome copies per mL.} -#' \item{site_pop}{The population size of the wastewater catchment area -#' represented by the site variable} -#' \item{location}{ A string indicating the location that all of the -#' data is coming from. This is not a necessary column, but instead is -#' included to more realistically mirror a typical workflow} -#' } -#' @source vignette_data.R -"ww_data_eval" - - #' Example wastewater dataset with independent site correlations. @@ -346,53 +304,6 @@ "rt_site_data" -#' \item{date}{Date the hospital admissions occurred, formatted in ISO8601 -#' standards as YYYY-MM-DD} -#' \item{subpop_name}{A string indicating the subpopulation the hospital -#' admissiosn corresponds to. This is either a wastewater site, or the -#' remainder of the population} -#' \item{daily_hosp_admits}{The number of individuals admitted to the -#' hospital on that date, available as of the forecast date} -#' \item{subpop_pop}{The number of people contributing to the daily hospital -#' admissions in each subpopulation} -#' } -#' @source vignette_data.R -"subpop_hosp_data" - - -#' Example subpopulation level retrospective hospital admissions dataset -#' -#' A dataset containing the simulated daily hospital admissions -#' (labeled here as `daily_hosp_admits`) by date of admission (`date`) in -#' each subpopulation observed retrospectively. -#' Additional columns that are required are the population size of the -#' population contributing to the hospital admissions. In this instance, -#' the subpopulations here are each of the wastewater catchment areas plus -#' an additional subpopulation for the portion of the population not captured -#' by wastewater surveillance. The data generated are daily hospital -#' admissions but they could be any other epidemiological count dataset e.g. -#' cases.This data should contain hospital admissions retrospectively beyond -#' the forecast date in order to evaluate the forecasts. -#' -#' This data is generated via the default values in the -#' `generate_simulated_data()` function. They represent the bare minimumum -#' required fields needed to pass to the model, and we recommend that users -#' try to format their own data to match this format. -#' -#' The variables are as follows: -#' \describe{ -#' \item{date}{Date the hospital admissions occurred, formatted in ISO8601 -#' standards as YYYY-MM-DD} -#' \item{subpop_name}{A string indicating the subpopulation the hospital -#' admissions corresponds to. This is either a wastewater site, or the -#' remainder of the population} -#' \item{daily_hosp_admits_for_eval}{The number of individuals admitted to the -#' hospital on that date, available as of the forecast date} -#' \item{subpop_pop}{The number of people contributing to the daily hospital -#' admissions in each subpopulation} -#' } -#' @source vignette_data.R -"subpop_hosp_data_eval" #' COVID-19 post-Omicron generation interval probability mass function diff --git a/man/subpop_hosp_data.Rd b/man/subpop_hosp_data.Rd deleted file mode 100644 index fd8cd6fa..00000000 --- a/man/subpop_hosp_data.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{subpop_hosp_data} -\alias{subpop_hosp_data} -\title{\item{date}{Date the hospital admissions occurred, formatted in ISO8601 -standards as YYYY-MM-DD} -\item{subpop_name}{A string indicating the subpopulation the hospital -admissiosn corresponds to. This is either a wastewater site, or the -remainder of the population} -\item{daily_hosp_admits}{The number of individuals admitted to the -hospital on that date, available as of the forecast date} -\item{subpop_pop}{The number of people contributing to the daily hospital -admissions in each subpopulation} -}} -\format{ -An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 450 rows and 4 columns. -} -\source{ -vignette_data.R -} -\usage{ -subpop_hosp_data -} -\description{ -\item{date}{Date the hospital admissions occurred, formatted in ISO8601 -standards as YYYY-MM-DD} -\item{subpop_name}{A string indicating the subpopulation the hospital -admissiosn corresponds to. This is either a wastewater site, or the -remainder of the population} -\item{daily_hosp_admits}{The number of individuals admitted to the -hospital on that date, available as of the forecast date} -\item{subpop_pop}{The number of people contributing to the daily hospital -admissions in each subpopulation} -} -} -\keyword{datasets} diff --git a/man/subpop_hosp_data_eval.Rd b/man/subpop_hosp_data_eval.Rd deleted file mode 100644 index 9da0cc9d..00000000 --- a/man/subpop_hosp_data_eval.Rd +++ /dev/null @@ -1,48 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{subpop_hosp_data_eval} -\alias{subpop_hosp_data_eval} -\title{Example subpopulation level retrospective hospital admissions dataset} -\format{ -An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 635 rows and 4 columns. -} -\source{ -vignette_data.R -} -\usage{ -subpop_hosp_data_eval -} -\description{ -A dataset containing the simulated daily hospital admissions -(labeled here as \code{daily_hosp_admits}) by date of admission (\code{date}) in -each subpopulation observed retrospectively. -Additional columns that are required are the population size of the -population contributing to the hospital admissions. In this instance, -the subpopulations here are each of the wastewater catchment areas plus -an additional subpopulation for the portion of the population not captured -by wastewater surveillance. The data generated are daily hospital -admissions but they could be any other epidemiological count dataset e.g. -cases.This data should contain hospital admissions retrospectively beyond -the forecast date in order to evaluate the forecasts. -} -\details{ -This data is generated via the default values in the -\code{generate_simulated_data()} function. They represent the bare minimumum -required fields needed to pass to the model, and we recommend that users -try to format their own data to match this format. - -The variables are as follows: -\describe{ -\item{date}{Date the hospital admissions occurred, formatted in ISO8601 -standards as YYYY-MM-DD} -\item{subpop_name}{A string indicating the subpopulation the hospital -admissions corresponds to. This is either a wastewater site, or the -remainder of the population} -\item{daily_hosp_admits_for_eval}{The number of individuals admitted to the -hospital on that date, available as of the forecast date} -\item{subpop_pop}{The number of people contributing to the daily hospital -admissions in each subpopulation} -} -} -\keyword{datasets} diff --git a/man/ww_data_eval.Rd b/man/ww_data_eval.Rd deleted file mode 100644 index 2afdd3d1..00000000 --- a/man/ww_data_eval.Rd +++ /dev/null @@ -1,55 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{ww_data_eval} -\alias{ww_data_eval} -\title{Example evaluation wastewater dataset.} -\format{ -\subsection{ww_data_eval}{ - -A tibble with 126 rows and 6 columns -\describe{ -\item{date}{Sample collection date, formatted in ISO8601 standards as -YYYY-MM-DD} -\item{site}{The wastewater treatment plant where the sample was collected} -\item{lab}{The lab where the sample was processed} -\item{log_genome_copies_per_ml_eval}{The natural log of the wastewater -concentration measured on the date specified, collected in the site -specified, and processed in the lab specified. The package expects -this quantity in units of log estimated genome copies per mL.} -\item{log_lod}{The log of the limit of detection in the site and lab on a -particular day of the quantification device (e.g. PCR). This should be in -units of log estimated genome copies per mL.} -\item{site_pop}{The population size of the wastewater catchment area -represented by the site variable} -\item{location}{ A string indicating the location that all of the -data is coming from. This is not a necessary column, but instead is -included to more realistically mirror a typical workflow} -} -} -} -\source{ -vignette_data.R -} -\usage{ -ww_data_eval -} -\description{ -A dataset containing the simulated retrospective wastewater concentrations -(labeled here as \code{log_genome_copies_per_ml_eval}) by sample collection date -(\code{date}), the site where the sample was collected (\code{site}) and the lab -where the samples were processed (\code{lab}). Additional columns that are -required attributes needed for the model are the limit of detection for -that lab on each day (labeled here as \code{log_lod}) and the population size of -the wastewater catchment area represented by the wastewater concentrations -in each \code{site}. -} -\details{ -This data is generated via the default values in the -\code{generate_simulated_data()} function. They represent the bare minumum -required fields needed to pass to the model, and we recommend that users -try to format their own data to match this format. - -The variables are as follows: -} -\keyword{datasets} From 3c5853a13c88b3b4968d424d23784985bd7d1e55 Mon Sep 17 00:00:00 2001 From: Kaitlyn Johnson Date: Wed, 6 Nov 2024 11:14:57 -0500 Subject: [PATCH 46/46] remove package data --- data/subpop_hosp_data.rda | Bin 1122 -> 0 bytes data/subpop_hosp_data_eval.rda | Bin 1349 -> 0 bytes data/ww_data_eval.rda | Bin 1925 -> 0 bytes 3 files changed, 0 insertions(+), 0 deletions(-) delete mode 100644 data/subpop_hosp_data.rda delete mode 100644 data/subpop_hosp_data_eval.rda delete mode 100644 data/ww_data_eval.rda diff --git a/data/subpop_hosp_data.rda b/data/subpop_hosp_data.rda deleted file mode 100644 index 29de916840b52c20232fad3acc5bd125460e1fad..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1122 zcmZ>Y%CIzaj8qGb6f`V7#~`g+fBgUNnk(V|f#CcfhyCUE7C1NrFmNz1I5;?7VBKT$ z@STO$SvCW?+{0SSS8j2eG0Wsc=464(3~fHMQZ6o=$^SRhkeP!=z(i@DbFf43SC+ql zvlJIQFi7&+Dm%Vn00O4qOPwB74g3Le8YYYjfC9D-KtfQ|6-@sRWnj1f0|zhb#HtI~n3;o_@|zrj}+j7&1l`UlUNpYli5YpPbr%AlpBQfvBI zg2jB4ZG3lLoHympT+NqfgO^)PUTt-Gy{+es*_*G5!$ zuU{wfz5ml{j;?mn>CH1%AW$9Bfy4-rzEzjC!bHjnY#XLoa@xwMuVM+1{z4|2FP#)%2GZSiJj7#^LNN%|~~=N-oVUS$4dB z;ra8@oxbK1TfH(v!n6dAT%MwJUh>fjNrSGrBC}umtm^u^!EFw&eAuBir)?x%Tb7A# zm~!gGydP6Os9L`Cd9KW-ppwAJ!Q{p{!&PBzlIEs=VUiDK?B?|8oODuixly{YSAe%m zP*Vh_f{F*%*$9rM8jUk~3)cj@x+!V6D4Vxz>P(xW;_2=5*fY^X;Kjvxy;{Z>uPwHf z=`uavl|Ad(&b?NXi%Qj29<)$DZF;tNwe=mz-UF#Vy;>$qGCpsSoE^tp8CtfcUrsRS zh1--hQXEQs0y^hiWvewO_S!`-((!y0MCPokmIfQ0zm~!4?*{fia<%-t3e=@J_ zKjD@5_`~n@`Q6$_-v6-C^snBU^GRk-%9IO_cE`R8o4YP3*zVf7Imt}HUcu9*ob6Lt zp6=|bxlr>Tr>{(=FA(~fEblye-mCD>Nx#Um&z4%wxv%XMylu*%;B%oCcX{VM7FVB{ zv((rt)2ke4_;%YlmAiS@$-dold!Njlhng+REW<4|Prg(VY%CIzaj8qGboWI{!ok5MG{`mjjaaY3s1Ht(}4*SdRuW)j3VBlb2aBy&bz%C(v z?}P6L#(540URWrKddw77Yi2aLxO}nV{!k7R6Qc|h>0th#`d2F#vq&Pz!Dnr|8Hmj<6;M?Bwhw1HZ>-o90NlJo8*#?B}ohnJPiyc zyhaQR7o>oqzFw19X1jb^?91>KD010Bis51huT(}=xhxfEXD@ zm*33lRGH*SIbvI|>fDxV9H9%XH7CtovSFs@v}r+?($uojRkyU9_bEByGv$=emNPzA z&iQ<~;OVJr67*0_ZIatsli9g@-=*vKu08QLLU(@fl8kt_^^524ycRlZx1qp>35WbS zB+n+OcB&uoaQqaawmvMBDPVz7TUN@1B|fdCYI}W}>zx*yvk?&1+%c>ZX-$(UH>ID#5o!YZIe@Zc6epfs`*QeiOwPYX$^HMFdF; zCt67<3aopYS;@hDGEi3C!9`51bm5^@(;b%Y_bzMX3RFomT(hlnn;w%V+u78e!Kyzt z$lG1m!_dgUC_ZnB;{xRlvp`|hWtVQfG5R+9teb|B>dR;O>pi2M>fQ@o_e5D>MhoAS zo@FQ2rm;>o*!S3S*^O3_1s#GeSDG|bUK%R3+^rNmp>lv>)sbxJKlQoq@{8xKp0{ev zEzY>Br#}{nhL+p9%l`dYV-u?Xc~2EX@rxxNe$BOd`?m4%7lxk)Y89-kukU&Mxbb-O z-ld_jNh_0>POop7^mJ#cU}46p^{iT793Cz8zICMZRmrctEIZwGE!tMC_IknG^&q~j z;oE`l3yLhaK3SQ%DsolSTD=Ani>Rfm_4)go)&&Qh`jt@V-CDq2JykDwf=tlE12RF6 zu54YIx-vKD?i6;B9apw3-Kx7X>+sp7)3{AUI-CSlJgz9&?A*3>smlVxfP5+;lr zr50)ha=Dm_`>s{n$s06p$x@R^Q$DC_KJ*ISGi}nLC~wWz{z=)(4h79zxoKX>E#DijLBQzZ4l`cuPSxj{ z9NfoM@(xdx_H+z5)y3K3BFd??!c*XaA}14zg7b#A0TWkpYFyS#%)WIevQI2T%jM9M zW4GMY%x7>htuzqoJEGgG9hI_GM)c9%fEh7f3~K~gJQ6INUhj@9uNAzu;WQ8NXiEm4 z_pAqec^R?`iq|C=J->8Tcj;OU0gv+29Sn2%CWJDq?^H58e*1das&y0W-!fi)%6tO|PqF*= z=c~_QpMH&b-fnA#&(${nCfF7j$n&h)pFi#M@A*>ajW^z5o*?_dJiLQHefH`ax$f;p zzwVJ)?|d}iAZzHt(2TtWpBl2_P`_k`NXk{AB&CeNDeiU%ks@dLEKsyFc~QkH>e#i(D-N ICV+}f0BMI-kN^Mx diff --git a/data/ww_data_eval.rda b/data/ww_data_eval.rda deleted file mode 100644 index 176a52b471dbadb3a38f39b5d9c98f9beb7ba6ef..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1925 zcmV;02YUEIT4*^jL0KkKS%_c%%m4`zfB*mg{r~^}|NsC0|NsC0|G)qL|NsC0|G)qL z|Nr0r|LxEPT<`*vd%4-#&t}(1LXk9@Jx@uKPbfT-YBcp8lha7VdY+@j0py!V4@v3` zGzNgvN2#MmY79oy4@e%Ts1H-r^#B0%9+O5*JfXEcA*PuPH1!Wt(F~hOqfDNmqd>}O zp)d)i27+MJW`jVO4I=@dnqZg#7$Zyo01^6t011FK8ek>>00hZ^00h7Uc>pv9p%P6L z^&3xA{U)Q-!8WEN)HKubiIXR(nunr1Q$|6M#A0Y*Lm00000000000000000Te(00000 z00|_Br|MJnPs%n$F{$KF6xvObBP40)nr%-g(0YxjrbnnfN2nTU>Ulxx49Om$>S*;g zQRIx&@{J81pfmvTjRuCA4H^vrka~kn4LpgXKo3eP!Y&v9>BkV@4DJcg>Co=(ojZv- zcOBiG$7gqU2LN%?x(7p(1u>aS)6G=caYWQPP6XhLslny)&6weHE~KTVu0ly-_d-BT zhy^^556h&G=cW*n9gPPeBomAY0?0n#1&=1#IAVeK3q$|&|I^q_3IrsKn7R@P*T51+ z9f}T_$OWQnMnDK5GC%$ly5`_)H3HL$qxYSHIjNOxQA`>b}r(Ewz0JixgB>(3b!dLnx6{EpKBFI?XodQ7>{;65xUw*G}_%gdqe*KwnVrdk4fQ z%m^NudE_Oa&}#9Ok8bLC?WFJ|PhUyvV&d@`v;}*%bkdm*!Ng1))5-{rs+ZP0U$LdE z^e5k?YSuQ)bc~}gZkY3a0SUqr>?D|G229qg)3h+5AiQk=BvHq1n4m_@U+B;{s3m2m zI!iVeG;T|PZw^V%?(d$J+#xR3O7>o_oq!@TmTAhE`nSxbgNP{|#WUKM1sxPUq5<(# z_b$xCm&HGN#yN{^os-MqWu(Knh(~hMvaMQQF{Oitia{uNS5xgnw1YFPfbtN7Dv1yw zVh;vw$Zzu`y-*6IS%@3TiTXUV_HI_Jwp&+D_#C~3kb#&$sqZIh?(WO8ylJWW*H&G( zB6qacc9)&IN0jOWGb9BL3!VT5WFRqF%Zzew(3?Cf9YZB2{ZAknFuku4e(gt7cEitd^FDXXS0yh3^$s;Zd+S=NNr5 z3ep;0p+4WC# zNedpAHh0;ARdFb&2oNMNnFv6V1cU%22muHHW*&w+(e53F@~)0;2U1L6q`^=htAP2_Gn> z%ZSD2P{TWcLqN8${6lb&KDz^7ID;iTvFcd%t)Wn=HSa^LsVn%x8sH@@Wu%y^nkd8J zjh&ghz>usM(!R@1BetuRXHPCv(=%p?NItw*fezK93)Len{ha)M}{+?x~g?sE34M;tY-P*(5{| zqYYbc4+(muG}eaLQtRF|i!isrJcIAB0{|c-0D09U0RenZMjVaw5K*}ZB*0AzaXmGo z7?{5KC1A|zX907CZlT)A*H6S|96e;gAec5u?GPye5Jd|z9V}~SRQic01|$4vHO%9J z`KXnJh71uXY|!tFh#x1~7_>91>w`(>-@I6bO7oNZ3)Pzatu6xTRE&m33uC3+fPh4r z-5;A!WD5Wg2Z0OP)yI=)inHvQX~W{M?|JpVkPrhi5kwyFUEr#ONx?HA# zm*YpKOy}!mA1`b1pAZ0HCkXNX3lH4bt4sm|lbc?R^Q46-2H8;>GHECPfLs2|$wb*; zITSVu5IuYde-tnZpb^8=e8anK0sR1AAc+7VphX0F1Q4Zx#tT<>Bp?8TqeiyHce+Lr z*3WNQPecA_#Jov`ifil_r+v{RI067w9VI58+E_s-pR^aUSlrY8Mt00e3YCKWfnR>U zBwa*Y8d;bv@Yr0Z{qkHPDx{H2Qb2!nH`!a$YJ=!8C062?ZY%@@eE=X3_Sia|`a7+0 zOugnhD~b6gAS2c?eXc^d1OlUTntqLD$g3nk0svvb6}3J?h??9Xn7QM@%mp%R{F1VE zGI6k^?Q+t>Kv!)+1|}@EKDz4LOlg4z6?Da{omAoiMlx#3%>jSP&?r-0o