diff --git a/R/ahr_blinded.R b/R/ahr_blinded.R index 691afe59..8dbb66dc 100644 --- a/R/ahr_blinded.R +++ b/R/ahr_blinded.R @@ -91,7 +91,7 @@ ahr_blinded <- function( stop("'intervals' must be a vector of positive numbers.") } if (length(intervals) != length(hr)) { - stop("the piecewise model specified 'hr' and 'intervals' differ in length.") + stop("The piecewise model specified 'hr' and 'intervals' differ in length.") } # Set final element of "intervals" to Inf diff --git a/tests/testthat/test-independent-ahr_blinded.R b/tests/testthat/test-independent-ahr_blinded.R new file mode 100644 index 00000000..6d52bb24 --- /dev/null +++ b/tests/testthat/test-independent-ahr_blinded.R @@ -0,0 +1,112 @@ +test_that("ahr_blinded throws an error for non-numeric or negative hr", { + expect_error( + ahr_blinded(hr = c(1, -2, 3)), + "'hr' must be a vector of positive numbers." + ) + expect_error( + ahr_blinded(hr = "abc"), + "'hr' must be a vector of positive numbers." + ) +}) + +test_that("ahr_blinded throws an error when intervals and hr are not aligned", { + expect_error( + ahr_blinded(intervals = c(3, 6), hr = c(1)), + "The piecewise model specified 'hr' and 'intervals' differ in length." + ) +}) + +test_that("Correct computation of blinded AHR and information adjustment", { + surv <- survival::Surv(simtrial::ex2_delayed_effect$month, event = simtrial::ex2_delayed_effect$evntd) + intervals <- c(3, Inf) + hr <- c(1, 0.6) + ratio <- 1 + event <- simtrial::fit_pwexp(surv, intervals)[, 3] + + expected_event <- sum(surv[, "status"]) + expected_theta <- -sum(log(hr[1:length(event)]) * event) / sum(event) + expected_ahr <- exp(-(-sum(log(hr[1:length(event)]) * event) / sum(event))) + expected_info0 <- sum(surv[, "status"]) * (1 - ratio / (1 + ratio)) * (ratio / (1 + ratio)) + + result <- ahr_blinded(surv = surv, intervals = intervals, hr = hr, ratio = ratio) + + expect_equal(result$event, expected_event) + expect_equal(result$ahr, expected_ahr, tolerance = 0.001) + expect_equal(result$theta, expected_theta, tolerance = 0.001) + expect_equal(result$info0, expected_info0) +}) + +test_that("ahr_blinded computes theta with constant hazard ratios correctly", { + surv <- survival::Surv( + simtrial::ex1_delayed_effect$month, + simtrial::ex1_delayed_effect$evntd + ) + intervals <- c(3, 6, Inf) + hr <- c(1, 1, 1) + result <- ahr_blinded(surv = surv, intervals = intervals, hr = hr) + + # When all hr = 1, theta should be 0 + expect_equal(result$theta, 0) +}) + +test_that("ahr_blinded handles zero events", { + surv <- survival::Surv(time = c(1, 2, 3, 4, 5), event = c(0, 0, 0, 0, 0)) # No events + intervals <- c(2, 3, Inf) + hr <- c(0.8, 0.9, 1) + + result <- ahr_blinded(surv = surv, intervals = intervals, hr = hr) + + expect_equal(result$event, 0) + expect_true(is.nan(result$ahr)) + expect_true(is.nan(result$theta)) + expect_equal(result$info0, 0) +}) + +test_that("ahr_blinded handles all events in the first interval", { + surv <- survival::Surv(time = c(1, 2, 2.5, 3, 3.5), event = c(1, 1, 1, 1, 1)) + # Only the first interval contains events + intervals <- c(4, Inf) + hr <- c(0.5, 0.7) + + result <- ahr_blinded(surv = surv, intervals = intervals, hr = hr) + + # All events are in the first interval, so result should reflect hr[1] + expected_theta <- -sum(log(hr[1]) * sum(surv[, "status"])) / sum(surv[, "status"]) + expect_equal(result$theta, expected_theta) + expect_equal(result$event, sum(surv[, "status"])) +}) + +test_that("ahr_blinded handles very small hazard ratios", { + surv <- survival::Surv(time = c(1, 2, 3, 4, 5), event = c(1, 1, 1, 1, 1)) + intervals <- c(2, 3, Inf) + hr <- c(0.1, 0.2, 0.3) + + res <- ahr_blinded(surv = surv, intervals = intervals, hr = hr) + + expect_true(res$theta > 0) + expect_true(res$ahr < 1) +}) + +test_that("ahr_blinded handles very high randomization ratio", { + surv <- survival::Surv(time = c(1, 2, 3, 4, 5), event = c(1, 1, 1, 1, 1)) + intervals <- c(2, 3, Inf) + hr <- c(0.8, 0.9, 0.95) + ratio <- 100 + + result <- ahr_blinded(surv = surv, intervals = intervals, hr = hr, ratio = ratio) + + # info0 should be near 0 + expect_equal(result$info0, 0, tolerance = 0.05) +}) + +test_that("ahr_blinded returns a tibble with correct structure and types", { + result <- ahr_blinded() + + expect_true(tibble::is_tibble(result)) + expect_named(result, c("event", "ahr", "theta", "info0")) + expect_true(nrow(result) == 1L) + expect_type(result$event, "double") + expect_type(result$ahr, "double") + expect_type(result$theta, "double") + expect_type(result$info0, "double") +})