Unit test check_data.R and get_ncast.R

tests/testthat/test_check_data.R

@@ -0,0 +1,169 @@
+library(testthat)
+
+# -------------------------------
+# Helper: create valid dummy data
+# -------------------------------
+make_valid_df <- function() {
+  data.frame(
+    target_end_date = c("2025-01-01", "2025-01-08", "2025-01-15"),
+    observation     = c(10, 20, 15),
+    location        = c("NY", "NY", "NY"),
+    target          = c("cases", "cases", "cases"),
+    stringsAsFactors = FALSE
+  )
+}
+
+# -------------------------------
+# 1. Basic success case
+# -------------------------------
+test_that("check_data works on valid input", {
+  df <- make_valid_df()
+
+  result <- check_data(df)
+
+  expect_s3_class(result, "accidda_data")
+  expect_equal(result$location, "NY")
+  expect_equal(result$target, "cases")
+  expect_false(result$history)
+
+  expect_equal(result$window[["from"]], as.Date("2025-01-01"))
+  expect_equal(result$window[["to"]], as.Date("2025-01-15"))
+})
+
+# -------------------------------
+# 2. Already validated input
+# -------------------------------
+test_that("returns input if already accidda_data", {
+  df <- make_valid_df()
+  result1 <- check_data(df)
+
+  result2 <- check_data(result1)
+
+  expect_identical(result1, result2)
+})
+
+# -------------------------------
+# 3. Input must be data frame
+# -------------------------------
+test_that("error if input is not a data frame", {
+  expect_error(
+    check_data(123),
+    "`df` must be a data frame"
+  )
+})
+
+# -------------------------------
+# 4. Missing required columns
+# -------------------------------
+test_that("error when required columns are missing", {
+  df <- data.frame(a = 1:3)
+
+  expect_error(
+    check_data(df),
+    "Missing required columns"
+  )
+})
+
+# -------------------------------
+# 5. Type coercion works
+# -------------------------------
+test_that("type coercion converts columns correctly", {
+  df <- make_valid_df()
+
+  result <- check_data(df)
+
+  expect_true(inherits(result$data$target_end_date, "Date"))
+  expect_true(is.numeric(result$data$observation))
+  expect_true(is.character(result$data$location))
+  expect_true(is.character(result$data$target))
+})
+
+# -------------------------------
+# 6. Invalid date should fail
+# -------------------------------
+test_that("invalid date causes error", {
+  df <- make_valid_df()
+  df$target_end_date[1] <- "invalid-date"
+
+  expect_error(
+    check_data(df),
+    "values that cannot be coerced to Date."
+  )
+})
+
+# -------------------------------
+# 7. Multiple locations should fail
+# -------------------------------
+test_that("multiple locations cause error", {
+  df <- make_valid_df()
+  df$location[2] <- "CA"
+
+  expect_error(
+    check_data(df),
+    "exactly one location"
+  )
+})
+
+# -------------------------------
+# 8. Multiple targets should fail
+# -------------------------------
+test_that("multiple targets cause error", {
+  df <- make_valid_df()
+  df$target[2] <- "deaths"
+
+  expect_error(
+    check_data(df),
+    "exactly one target"
+  )
+})
+
+# -------------------------------
+# 9. History detection
+# -------------------------------
+test_that("history is detected correctly", {
+  df <- make_valid_df()
+  df$as_of <- c("2025-01-02", "2025-01-03", "2025-01-04")
+
+  result <- check_data(df)
+
+  expect_true(result$history)
+  expect_true(inherits(result$data$as_of, "Date"))
+})
+
+# -------------------------------
+# 10. No history when as_of constant
+# -------------------------------
+test_that("history is FALSE when as_of has single value", {
+  df <- make_valid_df()
+  df$as_of <- c("2025-01-02", "2025-01-02", "2025-01-02")
+
+  result <- check_data(df)
+
+  expect_false(result$history)
+})
+
+# -------------------------------
+# 11. Window calculation
+# -------------------------------
+test_that("window is computed correctly", {
+  df <- make_valid_df()
+
+  result <- check_data(df)
+
+  expect_equal(result$window[["from"]], as.Date("2025-01-01"))
+  expect_equal(result$window[["to"]], as.Date("2025-01-15"))
+})
+
+# -------------------------------
+# 12. Print method works
+# -------------------------------
+test_that("print.accidda_data runs without error", {
+  df <- make_valid_df()
+  result <- check_data(df)
+
+  expect_output(print(result), "Location")
+  expect_output(print(result), "Target")
+  expect_output(print(result), "Window")
+  expect_output(print(result), "History")
+  expect_output(print(result), "accidda_data")
+})

tests/testthat/test_get_ncast.R

@@ -0,0 +1,186 @@
+# -----------------------------
+# Helper: dummy accidda_data object
+# -----------------------------
+make_dummy_data <- function() {
+  df <- data.frame(
+    target_end_date = as.Date(c(
+      "2025-01-01", "2025-01-01", "2025-01-01",
+      "2025-01-08", "2025-01-08",
+      "2025-01-15",
+      "2025-01-22", "2025-01-22", "2025-01-22",
+      "2025-01-29", "2025-01-29"
+    )),
+    as_of = as.Date(c(
+      "2025-01-01", "2025-01-08", "2025-01-15",
+      "2025-01-08", "2025-01-15",
+      "2025-01-15",
+      "2025-01-22", "2025-01-29", "2025-02-05",
+      "2025-01-29", "2025-02-05"
+    )),
+    observation = c(100, 120, 130, 80, 110, 50, 40, 100, 160, 20, 70),
+    location = "test_loc",
+    target = "cases"
+  )
+
+  structure(
+    list(
+      data = df,
+      location = "test_loc",
+      target = "cases",
+      history = TRUE
+    ),
+    class = "accidda_data"
+  )
+}
+
+# -----------------------------
+# Test 1: week_floor behavior
+# -----------------------------
+test_that("week_floor correctly floors dates to week start", {
+  x <- as.Date(c("2025-01-15", "2025-01-18"))
+
+  result <- as.Date(cut(x, "week"))
+
+  expect_equal(
+    result,
+    as.Date(c("2025-01-13", "2025-01-13"))
+  )
+})
+
+# -----------------------------
+# Test 2: transmute step
+# -----------------------------
+test_that("transmute creates correct columns", {
+  df <- make_dummy_data()$data
+
+  week_floor <- function(x) as.Date(cut(x, "week"))
+
+  result <- df |>
+    dplyr::transmute(
+      reference_date = week_floor(target_end_date),
+      report_date = week_floor(as_of),
+      confirm = as.integer(round(observation))
+    )
+
+  expect_true(all(c("reference_date", "report_date", "confirm") %in% colnames(result)))
+  expect_type(result$confirm, "integer")
+})
+
+# -----------------------------
+# Test 3: summarise step
+# -----------------------------
+test_that("summarise keeps max confirm per group", {
+  df <- data.frame(
+    reference_date = as.Date(c("2025-01-01", "2025-01-01")),
+    report_date = as.Date(c("2025-01-08", "2025-01-08")),
+    confirm = c(100, 120)
+  )
+
+  result <- df |>
+    dplyr::summarise(
+      confirm = max(confirm, na.rm = TRUE),
+      .by = c(reference_date, report_date)
+    )
+
+  expect_equal(nrow(result), 1)
+  expect_equal(result$confirm, 120)
+})
+
+# -----------------------------
+# Test 4: delta calculation
+# -----------------------------
+test_that("delta correctly computes increments", {
+  df <- data.frame(
+    reference_date = as.Date(c("2025-01-01", "2025-01-01", "2025-01-01")),
+    report_date = as.Date(c("2025-01-01", "2025-01-08", "2025-01-15")),
+    confirm = c(100, 120, 130)
+  )
+
+  result <- df |>
+    arrange(reference_date, report_date) |>
+    group_by(reference_date) |>
+    mutate(
+      delta = confirm - dplyr::lag(confirm, default = 0L),
+      count = pmax(0L, delta)
+    ) |>
+    ungroup()
+
+  expect_equal(result$delta, c(100, 20, 10))
+  expect_equal(result$count, c(100, 20, 10))
+})
+
+# -----------------------------
+# Test 5: negative revisions handling
+# -----------------------------
+test_that("negative deltas are clamped to zero", {
+  df <- data.frame(
+    reference_date = as.Date(c("2025-01-01", "2025-01-01")),
+    report_date = as.Date(c("2025-01-01", "2025-01-08")),
+    confirm = c(120, 100)  # decrease (bad data)
+  )
+
+  result <- df |>
+    arrange(reference_date, report_date) |>
+    group_by(reference_date) |>
+    mutate(
+      delta = confirm - dplyr::lag(confirm, default = 0L),
+      count = pmax(0L, delta)
+    ) |>
+    ungroup()
+
+  expect_equal(result$count, c(120, 0))
+})
+
+# -----------------------------
+# Test 6: full get_ncast basic output
+# -----------------------------
+test_that("get_ncast returns expected structure", {
+  skip_if_not_installed("baselinenowcast")
+
+  df <- make_dummy_data()
+
+  result <- get_ncast(df, max_delay = 2, draws = 100, prop_delay = 0.5, scale_factor = 2)
+
+  expect_true("data" %in% names(result))
+  expect_true("plot" %in% names(result))
+  expect_s3_class(result, "accidda_ncast")
+})
+
+# -----------------------------
+# Test 7: corrected weeks only
+# -----------------------------
+test_that("only last max_delay weeks are corrected", {
+  skip_if_not_installed("baselinenowcast")
+
+  df <- make_dummy_data()
+
+  result <- get_ncast(df, max_delay = 2, draws = 100, prop_delay = 0.5, scale_factor = 2)
+
+  out <- result$data
+
+  latest_date <- max(out$target_end_date)
+
+  corrected_rows <- out$target_end_date > (latest_date - 7)
+
+  expect_true(any(!is.na(out$ncast_lower[corrected_rows])))
+  expect_false(all(is.na(out$ncast_lower[!corrected_rows])))
+})
+
+# -----------------------------
+# Test 8: error when no history
+# -----------------------------
+test_that("error thrown when history is FALSE", {
+  df <- make_dummy_data()
+  df$history <- FALSE
+
+  expect_error(get_ncast(df))
+})
+
+# -----------------------------
+# Test 9: error when max_delay <= 0
+# -----------------------------
+test_that("error thrown for invalid max_delay", {
+  df <- make_dummy_data()
+
+  expect_error(get_ncast(df, max_delay = 0))
+})