tests/testthat/test-estimate_rolling.R

In cfr: Estimate Disease Severity and Case Ascertainment

#### Tests for the rolling static CFR function cfr_rolling() ####
# prepare data and common testing elements

# Load ebola 1976 outbreak data
data("ebola1976")

# Calculate rolling static naive CFR
rolling_scfr_naive <- cfr_rolling(
  data = ebola1976
)

# Ebola onset to death distribution comes from Barry et al. 2018
# a gamma distribution with shape = 2.40, scale = 3.33

# Calculate static corrected CFRs
rolling_scfr_corrected <- cfr_rolling(
  data = ebola1976,
  delay_density = function(x) dgamma(x, shape = 2.40, scale = 3.33)
)

# Basic expectations
test_that("`cfr_rolling`: Basic expectations", {
  # expect dataframes with specific columns
  expect_s3_class(rolling_scfr_naive, "data.frame")
  expect_s3_class(rolling_scfr_corrected, "data.frame")

  # expect rows are identical to each method and to original data
  expect_identical(
    nrow(rolling_scfr_naive),
    nrow(rolling_scfr_corrected)
  )
  expect_identical(
    nrow(rolling_scfr_naive),
    nrow(ebola1976)
  )

  # expected names
  expected_names <- c(
    "date", "severity_estimate", "severity_low", "severity_high"
  )
  # expect named columns
  expect_named(
    rolling_scfr_naive,
    expected_names
  )
  expect_named(
    rolling_scfr_corrected, expected_names
  )

  # snapshot tests for naive and corrected static CFR
  rows <- 15L
  expect_snapshot(head(rolling_scfr_naive, rows))
  expect_snapshot(head(rolling_scfr_corrected, rows))

  # expect that all columns in naive static CFR have values between 0 and 1
  invisible(
    apply(
      rolling_scfr_naive[, grepl(
        "severity",
        colnames(rolling_scfr_corrected),
        fixed = TRUE
      )], 2, function(x) {
        expect_true(all((x >= 0.0 & x <= 1.0) | is.na(x)))
      }
    )
  )

  # expect that all columns in corrected rolling CFR have values between 0 and 1
  # exclude date column
  invisible(
    apply(
      rolling_scfr_naive[, grepl(
        "severity",
        colnames(rolling_scfr_corrected),
        fixed = TRUE
      )], 2, function(x) {
        expect_true(all((x >= 0.0 & x <= 1.0) | is.na(x)))
      }
    )
  )
})

# Statistical correctness of cfr_rolling()
# the final value should be the same as cfr_static()
# for the corresponding value of corrected_for_delays
test_that("`cfr_rolling`: Comparison with `cfr_static()`", {
  # remove date col
  expect_equal(
    tail(
      rolling_scfr_naive[, grepl(
        "severity", colnames(rolling_scfr_naive),
        fixed = TRUE
      )], 1
    ),
    cfr_static(
      ebola1976
    ),
    ignore_attr = TRUE
  )

  expect_equal(
    tail(
      rolling_scfr_corrected[, grepl(
        "severity", colnames(rolling_scfr_corrected),
        fixed = TRUE
      )], 1
    ),
    cfr_static(
      ebola1976,
      delay_density = function(x) dgamma(x, shape = 2.40, scale = 3.33)
    ),
    ignore_attr = TRUE
  )
})

test_that("`cfr_rolling`: Errors and messages", {
  # expect error when columns are missing
  expect_error(
    cfr_rolling(
      data = ebola1976[, c("date", "cases")]
    )
  )

  # Input df_in is not a data.frame
  expect_error(
    cfr_rolling(
      c(cases = 10, deaths = 2, date = as.Date(Sys.time()))
    )
  )

  # Input dataframe has wrong column names
  df_in_malformed <- ebola1976
  df_in_malformed$date_time <- df_in_malformed$date
  df_in_malformed$date <- NULL

  expect_error(
    cfr_rolling(data = df_in_malformed)
  )

  # Input dataframe `date` column has wrong class; POSIXct instead of Date
  df_in_malformed <- ebola1976
  df_in_malformed$date <- as.POSIXct(df_in_malformed$date)

  expect_error(
    cfr_rolling(data = df_in_malformed)
  )

  # Input dataframe has non-sequential dates
  df_in_malformed <- ebola1976
  df_in_malformed <- df_in_malformed[-seq(10, 30), ]

  expect_error(
    cfr_rolling(data = df_in_malformed),
    regexp = "(Input data must have sequential dates)*(none missing)*duplicated"
  )
})

# Test case where cumulative cases and deaths are zero
test_that("cfr_rolling handles cumulative zeroes case", {
  data <- covid_data
  data <- data[data$country == "United Kingdom", ]

  # naive estimate works, expect message but no warnings
  expect_message(
    cfr_rolling(data),
    regexp = "(is a convenience function)*(cfr_time_varying)*(instead)"
  )

  # corrected estimate works
  expect_no_warning(
    cfr_rolling(
      data,
      delay_density = function(x) dlnorm(x, meanlog = 2.577, sdlog = 0.440)
    )
  )

  # expect as many NAs as there are days with cumulative cases and deaths at 0
  cuml_cases <- cumsum(data$cases)
  cuml_deaths <- cumsum(data$deaths)
  n_nas <- which.max((cuml_cases & cuml_deaths))

  cfr_estimate <- cfr_rolling(data)

  expect_identical(
    which.min(is.na(cfr_estimate$severity_estimate)),
    n_nas
  )
})