Fix test for ahr_blinded.R

tests/testthat/test-independent-ahr_blinded.R

@@ -1,4 +1,4 @@
-test_that("hr vector must be a vector of positive numbers", {
+test_that("ahr_blinded throws an error for non-numeric or negative hr", {
   expect_error(
     ahr_blinded(hr = c(1, -2, 3)),
     "ahr_blinded: hr must be a vector of positive numbers."
@@ -9,26 +9,56 @@ test_that("hr vector must be a vector of positive numbers", {
   )
 })
 
-test_that("Piecewise model hr and intervals must be aligned", {
-  expect_error(
-    ahr_blinded(hr = c(1, 2, 4), intervals = 3),
-    "ahr_blinded: the piecewise model specified hr and intervals are not aligned."
-  )
-  expect_error(
-    ahr_blinded(hr = c(1, 3), intervals = c(3, 4)),
-    "ahr_blinded: the piecewise model specified hr and intervals are not aligned."
-  )
+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)),
+               "ahr_blinded: the piecewise model specified hr and intervals are not aligned.")
+})
+
+test_that("ahr_blinded handles piecewise exponential model fitting and calculations correctly", {
+  surv <- Surv(time = simtrial::ex1_delayed_effect$month,
+               event = simtrial::ex1_delayed_effect$evntd)
+  intervals <- c(3, 6, Inf)
+  hr <- c(1, 0.7, 0.5)
+  ratio <- 2
+
+  # Run the function
+  result <- ahr_blinded(surv = surv, intervals = intervals, hr = hr, ratio = ratio)
+
+  # Test 1: Correct fitting of survival data into piecewise exponential model
+  event <- simtrial::fit_pwexp(surv, intervals)[, 3]
+  expect_length(event, length(intervals))
+  expect_true(all(event >= 0))
+
+  # Test 2: Hazard ratio vector is correctly extended
+  nhr <- length(hr)
+  nx <- length(event)
+  if (length(hr) < length(event)) {
+    hr <- c(hr, rep(hr[nhr], nx - nhr))
+  }
+  expect_equal(length(hr), length(event))
+  expect_equal(hr, c(1, 0.7, 0.5))  # Expected extended hr vector
+
+  # Test 3: Blinded AHR (theta) is computed correctly
+  theta <- -sum(log(hr[1:nx]) * event) / sum(event)
+  expect_true(!is.na(theta))
+
+  # Test 4: Information adjustment (q_e) is computed correctly
+  q_e <- ratio / (1 + ratio)
+  expect_equal(q_e, 2 / 3)
+
+  # Check the overall result
+  expect_true(inherits(result, "tbl_df"))
+  expect_equal(result$event, sum(event))
+  expect_equal(result$theta, theta)
+  expect_equal(result$ahr, exp(-theta))
 })
 
 test_that("Correct computation of blinded AHR and information adjustment", {
-  surv <- survival::Surv(
-    simtrial::ex2_delayed_effect$month,
-    event = simtrial::ex2_delayed_effect$evntd
-  )
+  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]
+  event<- simtrial::fit_pwexp(surv, intervals)[, 3]
 
   expected_event <- sum(surv[, "status"])
   expected_theta <- -sum(log(hr[1:length(event)]) * event) / sum(event)
@@ -42,3 +72,10 @@ test_that("Correct computation of blinded AHR and information adjustment", {
   expect_equal(result$theta, expected_theta, tolerance = 0.001)
   expect_equal(result$info0, expected_info0)
 })
+
+test_that("ahr_blinded returns a tibble with correct structure", {
+  result <- ahr_blinded()
+  expect_true(tibble::is_tibble(result))
+  expect_named(result, c("event", "ahr", "theta", "info0"))
+  expect_true(nrow(result) == 1)
+})