Improve survival timing validation

NEWS.md

@@ -73,6 +73,10 @@
 
 ## Bug fixes
 
+- `nSurv()` and `gsSurv()` now validate fixed survival timing inputs before
+  enrollment periods are adjusted, giving a clear error when `R`/`gamma`
+  imply accrual beyond `T - minfup` instead of failing later while assigning
+  row names (#274).
 - `Power.ssrCP()` now uses the interim efficacy bound when integrating the
   no-sample-size-re-estimation region and when falling back to the upper
   conditional-power changepoint (#213).

R/gsSurv-method.R

@@ -31,7 +31,7 @@ LFPWE <- function(
       if (is.vector(gamma)) {
         gamma <- gamma[1:length(R)]
       } else {
-        gamma <- gamma[1:length(R), ]
+        gamma <- gamma[1:length(R), , drop = FALSE]
       }
     }
   }

R/gsSurv-nSurv.R

@@ -455,15 +455,15 @@
 #' nSurv(
 #'   lambdaC = matrix(log(2) / c(6, 12, 18, 24), ncol = 2), hr = .5,
 #'   eta = matrix(log(2) / c(40, 50, 45, 55), ncol = 2), S = 3,
-#'   gamma = matrix(c(3, 6, 5, 7), ncol = 2), R = c(5, 10), minfup = 12,
+#'   gamma = matrix(c(3, 6, 5, 7), ncol = 2), R = c(5, 10), T = 27, minfup = 12,
 #'   alpha = .025, beta = .1, method = "BernsteinLagakos"
 #' )
 #' # Same assumptions for group sequential design
 #' gsSurv(
 #'   k = 4, sfu = gsDesign::sfHSD, sfupar = -4, sfl = gsDesign::sfPower, sflpar = .5,
 #'   lambdaC = matrix(log(2) / c(6, 12, 18, 24), ncol = 2), hr = .5,
 #'   eta = matrix(log(2) / c(40, 50, 45, 55), ncol = 2), S = 3,
-#'   gamma = matrix(c(3, 6, 5, 7), ncol = 2), R = c(5, 10), minfup = 12,
+#'   gamma = matrix(c(3, 6, 5, 7), ncol = 2), R = c(5, 10), T = 27, minfup = 12,
 #'   alpha = .025, beta = .1, method = "BernsteinLagakos"
 #' ) |>
 #'   print()
@@ -503,9 +503,7 @@ nSurv <- function(
       stop("S must be a numeric vector of positive values")
     }
   }
-  if (is.null(R)) {
-    stop("R must be specified and cannot be NULL")
-  }
+  validate_survival_timing_inputs(R = R, T = T, minfup = minfup, call = "nSurv")
   if (is.null(beta) && (is.null(T) || is.null(minfup))) {
     stop("When beta is NULL, R, T, and minfup must all be specified")
   }

R/gsSurv-utils.R

@@ -25,3 +25,44 @@ nameperiod <- function(R, digits = 2) {
   R0 <- c(0, R[1:(length(R) - 1)])
   return(paste(round(R0, digits), "-", round(R, digits), sep = ""))
 }
+
+# validate_survival_timing_inputs function [sinew] ----
+validate_survival_timing_inputs <- function(R, T, minfup, call = "nSurv") {
+  if (is.null(R)) {
+    stop(call, ": R must be specified and cannot be NULL", call. = FALSE)
+  }
+  if (!is.numeric(R) || any(is.na(R)) || any(!is.finite(R)) || any(R <= 0)) {
+    stop(call, ": R must be a numeric vector of positive finite values", call. = FALSE)
+  }
+  if (!is.null(T) &&
+    (!is.numeric(T) || length(T) != 1 || is.na(T) || !is.finite(T) || T <= 0)) {
+    stop(
+      call, ": T must be NULL or a single positive finite numeric value",
+      call. = FALSE
+    )
+  }
+  if (!is.null(minfup) &&
+    (!is.numeric(minfup) || length(minfup) != 1 ||
+      is.na(minfup) || !is.finite(minfup) || minfup < 0)) {
+    stop(
+      call, ": minfup must be NULL or a single non-negative finite numeric value",
+      call. = FALSE
+    )
+  }
+  if (!is.null(T) && !is.null(minfup)) {
+    accrual_duration <- T - minfup
+    if (accrual_duration <= 0) {
+      stop(call, ": T must be greater than minfup", call. = FALSE)
+    }
+    tolerance <- sqrt(.Machine$double.eps) * max(1, abs(accrual_duration))
+    if (length(R) > 1 && sum(R) - accrual_duration > tolerance) {
+      stop(
+        call, ": enrollment duration from R (", signif(sum(R), 12),
+        ") exceeds T - minfup (", signif(accrual_duration, 12),
+        "); shorten R/gamma or increase T relative to minfup",
+        call. = FALSE
+      )
+    }
+  }
+  invisible(TRUE)
+}

R/gsSurv.R

@@ -27,6 +27,7 @@ gsSurv <- function(
   if (!is.numeric(ratio) || length(ratio) != 1 || ratio <= 0) {
     stop("ratio must be a single positive scalar")
   }
+  validate_survival_timing_inputs(R = R, T = T, minfup = minfup, call = "gsSurv")
   solve_followup <- is.null(T) && is.null(minfup)
   if (solve_followup) {
     if (is.null(beta)) {

tests/testthat/test-gsSurvCalendar.R

@@ -19,7 +19,7 @@ test_that("gsSurvCalendar basic functionality works", {
   # Test minimum follow-up validation
   expect_error(
     gsSurvCalendar(calendarTime = c(12, 24), minfup = 25),
-    "Minimum follow-up greater than study duration."
+    "nSurv: T must be greater than minfup"
   )
 })
 

tests/testthat/test-independent-test-toBinomialExact.R

@@ -32,11 +32,11 @@ test_that("toBinomialExact validates inputs", {
 
   expect_error(
     toBinomialExact(design, alpha = c(0.01, 0.02)),
-    "alpha must be a finite numeric scalar"
+    "toBinomialExact: alpha must be a finite numeric scalar in \\(0, 1\\)"
   )
   expect_error(
     toBinomialExact(design, alpha = 1),
-    "alpha must be a finite numeric scalar"
+    "toBinomialExact: alpha must be a finite numeric scalar in \\(0, 1\\)"
   )
   expect_error(
     toBinomialExact(design, observedEvents = c(20.5, 30)),

tests/testthat/test-nSurv.R

@@ -37,6 +37,46 @@ testthat::test_that("Checking consistency nEvents power vs sample size", {
   testthat::expect_equal(pwr$Power, .9, info = "Checking power calculation")
 })
 
+testthat::test_that("nSurv and gsSurv validate fixed survival timing inputs", {
+  testthat::expect_error(
+    nSurv(lambdaC = .2, hr = .7, eta = .1, T = "a", minfup = 1.5),
+    "nSurv: T must be NULL or a single positive finite numeric value"
+  )
+  testthat::expect_error(
+    gsSurv(lambdaC = .2, hr = .7, eta = .1, T = "a", minfup = 1.5),
+    "gsSurv: T must be NULL or a single positive finite numeric value"
+  )
+  testthat::expect_error(
+    nSurv(lambdaC = .2, hr = .7, eta = .1, T = 2, R = "a", minfup = 1.5),
+    "nSurv: R must be a numeric vector of positive finite values"
+  )
+  testthat::expect_error(
+    gsSurv(lambdaC = .2, hr = .7, eta = .1, T = 2, R = 0, minfup = 1.5),
+    "gsSurv: R must be a numeric vector of positive finite values"
+  )
+  testthat::expect_error(
+    nSurv(
+      lambdaC = log(2) / 20, hr = 0.65, hr0 = 1,
+      eta = -log(1 - 0.02) / 18,
+      gamma = c(1, 6, 10, 20, 30), R = rep(1, 5),
+      T = 12, minfup = 8, ratio = 1
+    ),
+    "nSurv: enrollment duration from R \\(5\\) exceeds T - minfup \\(4\\)"
+  )
+  testthat::expect_error(
+    gsSurv(
+      k = 2, test.type = 4, alpha = 0.025, beta = 0.1,
+      astar = 0, timing = 0.75, sfu = sfLDOF, sfupar = 0,
+      sfl = sfHSD, sflpar = 0,
+      lambdaC = log(2) / 20, hr = 0.65, hr0 = 1,
+      eta = -log(1 - 0.02) / 18,
+      gamma = c(1, 6, 10, 20, 30), R = rep(1, 5),
+      S = NULL, T = 12, minfup = 8, ratio = 1
+    ),
+    "gsSurv: enrollment duration from R \\(5\\) exceeds T - minfup \\(4\\)"
+  )
+})
+
 testthat::test_that("nSurv matches rpact for Schoenfeld and Freedman", {
   getDesignGroupSequential <- tryCatch(
     utils::getFromNamespace("getDesignGroupSequential", "rpact"),