Condition on cases and return accepted sample size by scenario

condition_and_report_on_cases(
  sims,
  condition_date = NULL,
  lower_bound = NULL,
  upper_bound = NULL,
  samples = NULL,
  end_of_seed_date = "2019-12-31",
  scenarios_list = c("scenario", "event_duration", "event_size", "serial_mean",
    "serial_type", "upper_R0", "lower_R0")
)

Arguments

sims

A data.table from scenario_analysis.

condition_date

A character string in the following format "2020-01-01". Sets the date on which to condition the data.

lower_bound

Numeric, the estimated lower bound on cases.

upper_bound

Numeric, the estimated upper bound on cases.

samples

Numeric, the number of samples that were used.

end_of_seed_date

A character string in the following format "2020-01-01". The assumed end date of the seeding event.

scenarios_list

A character vector listing scenarios evaluated.

Value

A list of 3 data.frames as produced by condition_on_known, proportion_allowed_by_condition, and restrict_by_condition.

Examples

## Example sims <- data.frame(time = rep(1:10, 10), size = rep(1:10, 10), sample = unlist(lapply(1:10, function(.) {rep(., 10)})), scenario = c(rep(1, 5), rep(1, 5)), tmp = c(rep(1, 5), rep(1, 5)), event_duration = 1 ) condition_and_report_on_cases(sims, condition_date = "2020-01-03", lower_bound = 3, upper_bound = 5, scenarios_list = c("scenario", "tmp"), samples = 10)
#> $date_conditioned #> [1] "2020-01-03" #> #> $proportion_allowed_sims #> scenario tmp allowed_per #> 1: 1 1 1 #> #> $conditioned_sims #> time size sample scenario tmp event_duration #> 1: 1 1 1 1 1 1 #> 2: 2 2 1 1 1 1 #> 3: 3 3 1 1 1 1 #> 4: 4 4 1 1 1 1 #> 5: 5 5 1 1 1 1 #> 6: 6 6 1 1 1 1 #> 7: 7 7 1 1 1 1 #> 8: 8 8 1 1 1 1 #> 9: 9 9 1 1 1 1 #> 10: 10 10 1 1 1 1 #> 11: 1 1 2 1 1 1 #> 12: 2 2 2 1 1 1 #> 13: 3 3 2 1 1 1 #> 14: 4 4 2 1 1 1 #> 15: 5 5 2 1 1 1 #> 16: 6 6 2 1 1 1 #> 17: 7 7 2 1 1 1 #> 18: 8 8 2 1 1 1 #> 19: 9 9 2 1 1 1 #> 20: 10 10 2 1 1 1 #> 21: 1 1 3 1 1 1 #> 22: 2 2 3 1 1 1 #> 23: 3 3 3 1 1 1 #> 24: 4 4 3 1 1 1 #> 25: 5 5 3 1 1 1 #> 26: 6 6 3 1 1 1 #> 27: 7 7 3 1 1 1 #> 28: 8 8 3 1 1 1 #> 29: 9 9 3 1 1 1 #> 30: 10 10 3 1 1 1 #> 31: 1 1 4 1 1 1 #> 32: 2 2 4 1 1 1 #> 33: 3 3 4 1 1 1 #> 34: 4 4 4 1 1 1 #> 35: 5 5 4 1 1 1 #> 36: 6 6 4 1 1 1 #> 37: 7 7 4 1 1 1 #> 38: 8 8 4 1 1 1 #> 39: 9 9 4 1 1 1 #> 40: 10 10 4 1 1 1 #> 41: 1 1 5 1 1 1 #> 42: 2 2 5 1 1 1 #> 43: 3 3 5 1 1 1 #> 44: 4 4 5 1 1 1 #> 45: 5 5 5 1 1 1 #> 46: 6 6 5 1 1 1 #> 47: 7 7 5 1 1 1 #> 48: 8 8 5 1 1 1 #> 49: 9 9 5 1 1 1 #> 50: 10 10 5 1 1 1 #> 51: 1 1 6 1 1 1 #> 52: 2 2 6 1 1 1 #> 53: 3 3 6 1 1 1 #> 54: 4 4 6 1 1 1 #> 55: 5 5 6 1 1 1 #> 56: 6 6 6 1 1 1 #> 57: 7 7 6 1 1 1 #> 58: 8 8 6 1 1 1 #> 59: 9 9 6 1 1 1 #> 60: 10 10 6 1 1 1 #> 61: 1 1 7 1 1 1 #> 62: 2 2 7 1 1 1 #> 63: 3 3 7 1 1 1 #> 64: 4 4 7 1 1 1 #> 65: 5 5 7 1 1 1 #> 66: 6 6 7 1 1 1 #> 67: 7 7 7 1 1 1 #> 68: 8 8 7 1 1 1 #> 69: 9 9 7 1 1 1 #> 70: 10 10 7 1 1 1 #> 71: 1 1 8 1 1 1 #> 72: 2 2 8 1 1 1 #> 73: 3 3 8 1 1 1 #> 74: 4 4 8 1 1 1 #> 75: 5 5 8 1 1 1 #> 76: 6 6 8 1 1 1 #> 77: 7 7 8 1 1 1 #> 78: 8 8 8 1 1 1 #> 79: 9 9 8 1 1 1 #> 80: 10 10 8 1 1 1 #> 81: 1 1 9 1 1 1 #> 82: 2 2 9 1 1 1 #> 83: 3 3 9 1 1 1 #> 84: 4 4 9 1 1 1 #> 85: 5 5 9 1 1 1 #> 86: 6 6 9 1 1 1 #> 87: 7 7 9 1 1 1 #> 88: 8 8 9 1 1 1 #> 89: 9 9 9 1 1 1 #> 90: 10 10 9 1 1 1 #> 91: 1 1 10 1 1 1 #> 92: 2 2 10 1 1 1 #> 93: 3 3 10 1 1 1 #> 94: 4 4 10 1 1 1 #> 95: 5 5 10 1 1 1 #> 96: 6 6 10 1 1 1 #> 97: 7 7 10 1 1 1 #> 98: 8 8 10 1 1 1 #> 99: 9 9 10 1 1 1 #> 100: 10 10 10 1 1 1 #> time size sample scenario tmp event_duration #>
## Code condition_and_report_on_cases
#> function (sims, condition_date = NULL, lower_bound = NULL, upper_bound = NULL, #> samples = NULL, end_of_seed_date = "2019-12-31", scenarios_list = c("scenario", #> "event_duration", "event_size", "serial_mean", "serial_type", #> "upper_R0", "lower_R0")) #> { #> sims <- data.table::setDT(sims) #> days_since_end_seed <- (lubridate::as_date(condition_date) - #> lubridate::as_date(end_of_seed_date)) %>% as.numeric() #> allowed_scenarios <- WuhanSeedingVsTransmission::condition_on_known(sims, #> days_since_end_seed = days_since_end_seed, lower_bound = lower_bound, #> upper_bound = upper_bound) #> prop_allowed <- WuhanSeedingVsTransmission::proportion_allowed_by_condition(allowed_scenarios, #> samples = samples, group_var = scenarios_list) #> restrict_sims <- WuhanSeedingVsTransmission::restrict_by_condition(sims, #> allowed_scenarios) #> out <- list(lubridate::as_date(condition_date), prop_allowed, #> restrict_sims) #> names(out) <- c("date_conditioned", "proportion_allowed_sims", #> "conditioned_sims") #> return(out) #> } #> <bytecode: 0x55a6b0a92360> #> <environment: namespace:WuhanSeedingVsTransmission>