344 create dynamic low case count thresholds (#353)

* add command line and config options for low case count thresholds

* incorporate thresholds into diagnostic file

* precommit

* Update R/pipeline.R

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>

* Update R/diagnostics.R

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>

* Update R/diagnostics.R

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>

* Update R/diagnostics.R

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>

* change to use thresholds from constants file

* pre-commit

* edit low case count tests

* add aconfigs to the config.R file

* test Config.Rd

* add .Rd items

* edit to roxygen documentation

* [pre-commit.ci] auto fixes from pre-commit.com hooks

for more information, see https://pre-commit.ci

* precommit

* edit test config files

* edit to test-diagnostics.R

* account for tests in diagnostics.R

* precommit tests

* tests edit

* triage test errors

* double brackets to resolve error

* add low case count threshold to metadata

* [pre-commit.ci] auto fixes from pre-commit.com hooks

for more information, see https://pre-commit.ci

* edit tests

* spacing

* undo dockerfile test

* updating documentation

* Update R/find_low_count_threshold.R

Co-authored-by: Nate McIntosh <NMcIntosh@cdc.gov>

* Update R/diagnostics.R

Co-authored-by: Nate McIntosh <NMcIntosh@cdc.gov>

* Update R/diagnostics.R

Co-authored-by: Nate McIntosh <NMcIntosh@cdc.gov>

* Update R/diagnostics.R

Co-authored-by: Nate McIntosh <NMcIntosh@cdc.gov>

* fix specifying disease

* roxygen edits

* additional document edits

* precommit

* additional roxygen edit

* Update R/diagnostics.R

Co-authored-by: Katie Gostic <uep6@cdc.gov>

* add example for creating thresholds value in R + Roxygen edits

* roxygen

---------

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: pre-commit-ci[bot] <66853113+pre-commit-ci[bot]@users.noreply.github.com>
Co-authored-by: Micah Wiesner <micahwiesner67@gmail.com>
Co-authored-by: Micah Wiesner <33739832+micahwiesner67@users.noreply.github.com>
Co-authored-by: Nate McIntosh <NMcIntosh@cdc.gov>
Co-authored-by: Katie Gostic <uep6@cdc.gov>

Author: 6 people

NAMESPACE

@@ -17,6 +17,7 @@ export(format_generation_interval)
 export(format_right_truncation)
 export(format_stan_opts)
 export(low_case_count_diagnostic)
+export(low_case_count_threshold)
 export(orchestrate_pipeline)
 export(process_quantiles)
 export(process_samples)

NEWS.md

@@ -1,6 +1,8 @@
 # CFAEpiNow2Pipeline v0.2.0
 
 ## Features
+
+* add pathogen-specific low case count thresholds options
 * Updating make commands to be called from docker image locally
 * Updating pre-commit to block specific test.parquet file
 * Scheduling `make run-prod` on Github Actions Wednesdays at 8 AM ET

R/config.R

@@ -132,6 +132,9 @@ Data <- S7::new_class(
 #' Formatted as "YYYY-MM-DD".
 #' @param disease A string specifying the disease being modeled. One of
 #'    `"COVID-19"` or `"Influenza"` or `"RSV"`.
+#' @param low_case_count_thresholds A named list of thresholds to use for
+#'  determining n_low_case_count in diagnostic file
+#' Example: list(`COVID-19` = 10, `Influenza`` = 10, `RSV` = 5)
 #' @param geo_value An uppercase, two-character string specifying the geographic
 #'   value, usually a state or `"US"` for national data.
 #' @param geo_type A string specifying the geographic type, usually "state".
@@ -168,6 +171,7 @@ Config <- S7::new_class(
     report_date = S7::class_character,
     production_date = S7::class_character,
     disease = S7::class_character,
+    low_case_count_thresholds = S7::class_list,
     geo_value = S7::class_character,
     geo_type = S7::class_character,
     seed = S7::class_integer,

R/diagnostics.R

@@ -9,6 +9,12 @@
 #'
 #' @param fit The model fit object from `EpiNow2`
 #' @param data A data frame containing the input data used in the model fit.
+#' @param low_count_threshold an integer that determines cutoff for
+#' determining low_case_count flag. If the jurisdiction has less than
+#' X DDI counts for the respective pathogen, it will be considered
+#' as having too few cases and later on in post-processing the
+#' Rt estimate and growth category will be edited to NA and
+#' "Not Estimated", respectively, in release
 #' @inheritParams Config
 #'
 #' @return A \code{data.frame} containing the extracted diagnostic metrics. The
@@ -18,7 +24,9 @@
 #'   \item \code{value}: The value of the diagnostic metric.
 #'   \item \code{job_id}: The unique identifier for the job.
 #'   \item \code{task_id}: The unique identifier for the task.
-#'   \item \code{disease,geo_value,model}: Metadata for downstream processing.
+#'   \item \code{disease,geo_value,model}: Metadata
+#' for downstream processing.
+
 #' }
 #'
 #' @details
@@ -49,13 +57,14 @@
 extract_diagnostics <- function(
   fit,
   data,
+  low_count_threshold,
   job_id,
   task_id,
   disease,
   geo_value,
   model
 ) {
-  low_case_count <- low_case_count_diagnostic(data)
+  low_case_count <- low_case_count_diagnostic(data, low_count_threshold)
 
   epinow2_diagnostics <- rstan::get_sampler_params(
     fit$estimates$fit,
@@ -127,22 +136,30 @@ extract_diagnostics <- function(
 
 #' Calculate low case count diagnostic flag
 #'
-#' The diagnostic flag is TRUE if either of the _last_ two weeks of the dataset
-#' have fewer than an aggregate 10 cases per week. This aggregation excludes the
-#' count from confirmed outliers, which have been set to NA in the data.
+#' The diagnostic flag is TRUE if either of the _last_ two weeks
+#' of the dataset have fewer than an aggregate X cases per week.
+#' See the low_case_count_threshold parameter for what the value
+#' of X is. This aggregation excludes the count from confirmed
+#' outliers, which have been set to NA in the data.
 #'
 #' This function assumes that the `df` input dataset has been
 #' "completed": that any implicit missingness has been made explicit.
 #'
 #' @param df A dataframe as returned by [read_data()]. The dataframe must
 #' include columns such as `reference_date` (a date vector) and `confirm`
 #' (the number of confirmed cases per day).
+#' @param low_count_threshold an integer that determines cutoff for
+#' determining low_case_count flag. If the jurisdiction has less than
+#' X ED visist for the respective pathogen, it will be considered
+#' as having too few cases and later on in post-processing the
+#' Rt estimate and growth category will be edited to NA and
+#' "Not Estimated", respectively
 #'
 #' @return A logical value (TRUE or FALSE) indicating whether either of the last
 #' two weeks in the dataset had fewer than 10 cases per week.
 #' @family diagnostics
 #' @export
-low_case_count_diagnostic <- function(df) {
+low_case_count_diagnostic <- function(df, low_count_threshold) {
   cli::cli_alert_info("Calculating low case count diagnostic")
   # Get the dates in the last and second-to-last weeks
   last_date <- as.Date(max(df[["reference_date"]], na.rm = TRUE))
@@ -190,7 +207,7 @@ low_case_count_diagnostic <- function(df) {
   ))
 
   any(
-    ultimate_week_count < 10,
-    penultimate_week_count < 10
+    ultimate_week_count < low_count_threshold,
+    penultimate_week_count < low_count_threshold
   )
 }

R/find_low_count_threshold.R

@@ -0,0 +1,17 @@
+#' Determine Low Case Count Threshold Based on Pathogen
+#'
+#' @inheritParams Config
+#'
+#' @return low_count_threshold An integer that reflects the value X where
+#' number ED visits < X in the past week and week prior results in an
+#' n_low_case_count flag for that pathogen-state pair
+#' @family diagnostics
+#' @export
+low_case_count_threshold <- function(low_case_count_thresholds, disease) {
+  if (disease == "test") {
+    low_count_threshold <- 10
+  } else {
+    low_count_threshold <- low_case_count_thresholds[[disease]]
+  }
+  return(low_count_threshold)
+}

R/pipeline.R

@@ -241,9 +241,16 @@ execute_model_logic <- function(config, input_dir, output_dir) {
     priors = config@priors,
     sampler_opts = config@sampler_opts
   )
+
+  low_count_threshold <- low_case_count_threshold(
+    disease = config@disease,
+    low_case_count_thresholds = config@low_case_count_thresholds
+  )
+
   diagnostics <- extract_diagnostics(
     fit = fit,
     data = cases_df,
+    low_count_threshold = low_count_threshold,
     job_id = config@job_id,
     task_id = config@task_id,
     disease = config@disease,
@@ -271,6 +278,7 @@ execute_model_logic <- function(config, input_dir, output_dir) {
     data_path = empty_str_if_non_existent(config@data@path),
     model = config@model,
     disease = config@disease,
+    low_case_count_threshold = low_count_threshold,
     geo_value = config@geo_value,
     report_date = config@report_date,
     production_date = config@production_date,