diff --git a/tests/testthat/test_check_data.R b/tests/testthat/test_check_data.R new file mode 100644 index 0000000..efd44de --- /dev/null +++ b/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") +}) diff --git a/tests/testthat/test_get_ncast.R b/tests/testthat/test_get_ncast.R new file mode 100644 index 0000000..dd703c5 --- /dev/null +++ b/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)) +})