diff --git a/NEWS.md b/NEWS.md index cfcc4434..29470202 100644 --- a/NEWS.md +++ b/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). diff --git a/R/gsSurv-method.R b/R/gsSurv-method.R index ac363439..c948fc9b 100644 --- a/R/gsSurv-method.R +++ b/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] } } } diff --git a/R/gsSurv-nSurv.R b/R/gsSurv-nSurv.R index f1e45844..9876c9b2 100644 --- a/R/gsSurv-nSurv.R +++ b/R/gsSurv-nSurv.R @@ -455,7 +455,7 @@ #' 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 @@ -463,7 +463,7 @@ #' 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") } diff --git a/R/gsSurv-utils.R b/R/gsSurv-utils.R index 15e68608..f4aceae1 100644 --- a/R/gsSurv-utils.R +++ b/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) +} diff --git a/R/gsSurv.R b/R/gsSurv.R index 53ddbe85..465cc0f0 100644 --- a/R/gsSurv.R +++ b/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)) { diff --git a/man/nSurv.Rd b/man/nSurv.Rd index 69ddcd83..33be375b 100644 --- a/man/nSurv.Rd +++ b/man/nSurv.Rd @@ -640,7 +640,7 @@ gsSurv( 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 @@ -648,7 +648,7 @@ 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() diff --git a/tests/testthat/test-gsSurvCalendar.R b/tests/testthat/test-gsSurvCalendar.R index d109caae..58c6a675 100644 --- a/tests/testthat/test-gsSurvCalendar.R +++ b/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" ) }) diff --git a/tests/testthat/test-independent-test-toBinomialExact.R b/tests/testthat/test-independent-test-toBinomialExact.R index 5dd14683..a5bbe03a 100644 --- a/tests/testthat/test-independent-test-toBinomialExact.R +++ b/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)), diff --git a/tests/testthat/test-nSurv.R b/tests/testthat/test-nSurv.R index 0229df9c..11a4034c 100644 --- a/tests/testthat/test-nSurv.R +++ b/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"),