diff --git a/tests/testthat/test-estimate_secondary.R b/tests/testthat/test-estimate_secondary.R index a887c2381..2eabcd5ec 100644 --- a/tests/testthat/test-estimate_secondary.R +++ b/tests/testthat/test-estimate_secondary.R @@ -36,18 +36,18 @@ inc_posterior <- inc$posterior[variable %in% params] #### Prevalence data example #### # make some example prevalence data -cases <- example_confirmed -cases <- as.data.table(cases)[, primary := confirm] +prev_cases <- example_confirmed +prev_cases <- as.data.table(prev_cases)[, primary := confirm] # Assume that only 30 percent of cases are reported -cases[, scaling := 0.3] +prev_cases[, scaling := 0.3] # Parameters of the assumed log normal delay distribution -cases[, meanlog := 1.6][, sdlog := 0.8] +prev_cases[, meanlog := 1.6][, sdlog := 0.8] # Simulate secondary cases -cases <- simulate_secondary(cases, type = "prevalence") +prev_cases <- simulate_secondary(prev_cases, type = "prevalence") # fit model to example prevalence data -prev <- estimate_secondary(cases[1:100], +prev <- estimate_secondary(prev_cases[1:100], secondary = secondary_opts(type = "prevalence"), obs = obs_opts( week_effect = FALSE, @@ -75,6 +75,56 @@ test_that("estimate_secondary can return values from simulated data and plot expect_error(plot(inc, primary = TRUE), NA) }) +test_that("estimate_secondary successfully returns estimates when passed NA values", { + skip_on_cran() + cases_na <- data.table::copy(cases) + cases_na[sample(1:60, 5), secondary := NA] + inc_na <- estimate_secondary(cases_na[1:60], + delays = delay_opts( + dist_spec( + mean = 1.8, mean_sd = 0, + sd = 0.5, sd_sd = 0, max = 30 + ) + ), + obs = obs_opts(scale = list(mean = 0.2, sd = 0.2), week_effect = FALSE), + verbose = FALSE + ) + prev_cases_na <- data.table::copy(prev_cases) + prev_cases_na[sample(1:60, 5), secondary := NA] + prev_na <- estimate_secondary(prev_cases_na[1:60], + secondary = secondary_opts(type = "prevalence"), + delays = delay_opts( + dist_spec( + mean = 1.8, mean_sd = 0, + sd = 0.5, sd_sd = 0, max = 30 + ) + ), + obs = obs_opts(scale = list(mean = 0.2, sd = 0.2), week_effect = FALSE), + verbose = FALSE + ) +}) + +test_that("estimate_secondary successfully returns estimates when accumulating to weekly", { + skip_on_cran() + secondary_weekly <- cases[, list(date, secondary)] + secondary_weekly[, secondary := frollsum(secondary, 7)] + secondary_weekly <- secondary_weekly[seq(7, nrow(secondary_weekly), by = 7)] + cases_weekly <- merge( + cases[, list(date, primary)], secondary_weekly, by = "date", all.x = TRUE + ) + inc_weekly <- estimate_secondary(cases_weekly, + delays = delay_opts( + dist_spec( + mean = 1.8, mean_sd = 0, + sd = 0.5, sd_sd = 0, max = 30 + ) + ), + obs = obs_opts( + scale = list(mean = 0.4, sd = 0.05), week_effect = FALSE, na = "accumulate" + ), verbose = FALSE + ) +}) + test_that("estimate_secondary can recover simulated parameters", { expect_equal( inc_posterior[, mean], c(1.8, 0.5, 0.4),