tests/testthat/test-estimate_ascertainment.R

In cfr: Estimate Disease Severity and Case Ascertainment

# Tests for estimate_ascertainment()

# load Ebola 1976 outbreak data
data("ebola1976")

# define poisson threshold
poisson_threshold <- 100

test_that("Basic expectations for static ascertainment", {
  ascertainment_estimate <- estimate_ascertainment(
    data = ebola1976,
    severity_baseline = 0.7
  )

  expect_s3_class(ascertainment_estimate, "data.frame")
  expect_named(
    ascertainment_estimate,
    c("ascertainment_estimate", "ascertainment_low", "ascertainment_high")
  )
  expect_true(
    all(
      apply(ascertainment_estimate, 2, function(x) x >= 0.0 && x <= 1.0)
    )
  )
  expect_true(
    all(
      ascertainment_estimate$ascertainment_low <=
        ascertainment_estimate$ascertainment_estimate &&
        ascertainment_estimate$ascertainment_estimate <=
          ascertainment_estimate$ascertainment_high
    )
  )
  # snapshot test
  expect_snapshot(
    estimate_ascertainment(data = ebola1976, severity_baseline = 0.7)
  )
})

test_that("Correct for delays for static ascertainment", {
  ascertainment_estimate <- estimate_ascertainment(
    data = ebola1976,
    delay_density = function(x) dgamma(x, shape = 2.40, scale = 3.33),
    severity_baseline = 0.7
  )

  expect_s3_class(ascertainment_estimate, "data.frame")
  expect_named(
    ascertainment_estimate,
    c("ascertainment_estimate", "ascertainment_low", "ascertainment_high")
  )
  expect_true(
    all(
      apply(ascertainment_estimate, 2, function(x) x >= 0.0 && x <= 1.0)
    )
  )
  expect_true(
    all(
      ascertainment_estimate$ascertainment_low <=
        ascertainment_estimate$ascertainment_estimate &&
        ascertainment_estimate$ascertainment_estimate <=
          ascertainment_estimate$ascertainment_high
    )
  )
  # snapshot test
  expect_snapshot(
    estimate_ascertainment(
      data = ebola1976,
      delay_density = function(x) dgamma(x, shape = 2.40, scale = 3.33),
      severity_baseline = 0.7
    )
  )
})

# load covid data
data("covid_data")
# subset data
covid_uk <- covid_data[covid_data$country == "United Kingdom" &
  covid_data$date <= "2020-06-30", ]

test_that("Static ascertainment from vignette", {
  expect_snapshot(
    estimate_ascertainment(
      data = covid_uk,
      delay_density = function(x) dlnorm(x, meanlog = 2.577, sdlog = 0.440),
      severity_baseline = 0.014
    )
  )
})

# test for a warning from ascertainment ratios > 1.0
# artificially set baseline severity to be very high
# this is more an issue for infections with lower reporting such as Covid-19
test_that("Ascertainment > 1.0 throws a warning", {
  expect_warning(
    estimate_ascertainment(
      data = ebola1976,
      delay_density = function(x) dgamma(x, shape = 2.40, scale = 3.33),
      severity_baseline = 0.99
    ),
    regexp = "Ascertainment ratios > 1.0 detected, setting these values to 1.0"
  )
})

#### Test statistical correctness of ascertainment ####
test_that("Ascertainment is statistically correct", {
  # simple assumptions
  # assume 1% true CFR
  severity_baseline <- 0.01
  daily_cases <- 500
  daily_deaths <- 10

  data <- data.frame(
    date = as.Date("2020-01-01") + seq(0, 99),
    cases = rep(daily_cases, 100),
    deaths = rep(daily_deaths, 100)
  )

  # exepect estimate is 0.5
  expect_identical(
    estimate_ascertainment(
      data,
      severity_baseline = 0.01
    )$ascertainment_estimate,
    severity_baseline / (daily_deaths / daily_cases)
  )
})