GitHub/290 294 issues

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: gsDesign
-Version: 3.10.1.9001
+Version: 3.11.0.9002
 Title: Group Sequential Design
 Authors@R: c(
     person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut", "cre")),

NAMESPACE

@@ -58,6 +58,7 @@ export(gsSurvPower)
 export(hrn2z)
 export(hrz2n)
 export(isInteger)
+export(minMedianFollowUp)
 export(nBinomial)
 export(nBinomial1Sample)
 export(nEvents)
@@ -66,6 +67,7 @@ export(nNormal)
 export(nSurv)
 export(nSurvival)
 export(normalGrid)
+export(plotMinMedianFollowUp)
 export(repeatedPValueBinomialExact)
 export(sequentialPValue)
 export(sequentialPValueBinomialExact)

NEWS.md

@@ -2,6 +2,12 @@
 
 ## New features
 
+- Added `minMedianFollowUp()` and `plotMinMedianFollowUp()` to compute and plot
+  minimum median follow-up at any calendar time from the piecewise enrollment
+  assumptions in an `nSurv` or `gsSurv` design. The plot accepts arbitrary
+  time-unit labels through `timename`; month and year labels default to x-axis
+  breaks every 6 months and 0.5 years, respectively, while other units use
+  automatic breaks (#281).
 - Sequential p-values, including exact-binomial repeated and sequential
   efficacy p-values, now support `test.type = 8` by ignoring its non-binding
   futility and harm bounds. `toBinomialExact()` now provides full exact
@@ -13,6 +19,19 @@
 
 ## Bug fixes
 
+- `gsSurvPower()` now retains exact event totals when `targetEvents` determines
+  an analysis, rather than exposing small root-finding residuals that could
+  make `gsBoundSummary()` round an integer event target up by one (#294).
+- Survival sample-size outputs now normalize machine-precision representations
+  of integers before applying display rounding, so `gsSurvPower()` and
+  `gsBoundSummary()` preserve exact arm and total sample sizes (#290).
+- Single-analysis survival designs now use a fixed-design `nSurv()` path in
+  `gsSurv(k = 1)` and `gsSurvPower(k = 1)`. The resulting objects work with
+  `toInteger()` and `gsBoundSummary()`, including alternate-alpha summaries
+  and use all alpha at the sole analysis without displaying an irrelevant
+  spending function in `summary()`. An `nSurv()` object can now also be passed
+  directly to `toInteger()` and is returned as an `nSurv` object with integer
+  event and sample-size targets (#289).
 - Power plots for test types 7 and 8 now treat crossing the futility threshold
   as the union of futility-only and harm stops. The separate harm curve remains
   harm-only, and the mutually exclusive probabilities stored on the design are

R/gsMethods.R

@@ -69,7 +69,11 @@ print.gsProbability <- function(x, ...) {
 summary.gsDesign <- function(object, information = FALSE, timeunit = "months", ...) {
   out <- NULL
   if (object$test.type == 1) {
-    out <- paste(out, "One-sided group sequential design with ", sep = "")
+    out <- paste(
+      out,
+      if (object$k == 1) "One-sided fixed design with " else "One-sided group sequential design with ",
+      sep = ""
+    )
   } else if (object$test.type == 2) {
     out <- paste(out, "Symmetric two-sided group sequential design with ", sep = "")
   } else if (object$test.type %in% c(7, 8)) {
@@ -87,18 +91,26 @@ summary.gsDesign <- function(object, information = FALSE, timeunit = "months", .
       out <- paste(out, "non-binding futility bound, ", sep = "")
     }
   }
-  out <- paste(out, object$k, " analyses, ", sep = "")
+  out <- paste(
+    out,
+    object$k,
+    if (object$k == 1) " analysis, " else " analyses, ",
+    sep = ""
+  )
   if (object$nFixSurv > 0) {
     out <- paste(out, "time-to-event outcome with sample size ", ceiling(object$nSurv),
       " and ", ceiling(object$n.I[object$k]), " events required, ",
       sep = ""
     )
   } else if ("gsSurv" %in% class(object)) {
+    experimental_n <- gsRoundNearInteger(rowSums(object$eNE))
+    control_n <- gsRoundNearInteger(rowSums(object$eNC))
     out <- paste(out, "time-to-event outcome with sample size ",
-      ifelse(object$ratio == 1, 2 * ceiling(rowSums(object$eNE))[object$k],
-        (ceiling(rowSums(object$eNE)) + ceiling(rowSums(object$eNC)))[object$k]
+      ifelse(object$ratio == 1, 2 * ceiling(experimental_n)[object$k],
+        (ceiling(experimental_n) + ceiling(control_n))[object$k]
       ),
-      " and ", ceiling(object$n.I[object$k]), " events required, ",
+      " and ", ceiling(gsRoundNearInteger(object$n.I[object$k])),
+      " events required, ",
       sep = ""
     )
   } else if (information) {
@@ -115,14 +127,18 @@ summary.gsDesign <- function(object, information = FALSE, timeunit = "months", .
       sep = ""
     )
   }
-  if (object$test.type == 2) {
-    out <- paste(out, ". Bounds derived using a ", sep = "")
+  if ("gsSurv" %in% class(object) && object$k == 1) {
+    out <- paste0(out, ".")
   } else {
-    out <- paste(out, ". Efficacy bounds derived using a", sep = "")
+    if (object$test.type == 2) {
+      out <- paste(out, ". Bounds derived using a ", sep = "")
+    } else {
+      out <- paste(out, ". Efficacy bounds derived using a", sep = "")
+    }
+    out <- paste(out, " ", summary(object$upper), ".", sep = "")
+    if (object$test.type > 2) out <- paste(out, " Futility bounds derived using a ", summary(object$lower), ".", sep = "")
+    if (object$test.type %in% c(7, 8)) out <- paste(out, " Harm bounds derived using a ", summary(object$harm), ".", sep = "")
   }
-  out <- paste(out, " ", summary(object$upper), ".", sep = "")
-  if (object$test.type > 2) out <- paste(out, " Futility bounds derived using a ", summary(object$lower), ".", sep = "")
-  if (object$test.type %in% c(7, 8)) out <- paste(out, " Harm bounds derived using a ", summary(object$harm), ".", sep = "")
   return(out)
 }
 
@@ -469,23 +485,28 @@ gsBoundSummary0 <- function(
     for (i in 1:length(x$theta)) pframe3 <- rbind(pframe3, data.frame("Harm" = cumsum(x$harm$prob[, i])))
     pframe <- data.frame(pframe, pframe3)
   }
-  # conditional power at bound, theta=hat(theta)
-  cp <- data.frame(gsBoundCP(x, r = r))
-  # conditional power at bound, theta=theta[1]
-  cp1 <- data.frame(gsBoundCP(x, theta = x$delta, r = r))
-  if (x$test.type %in% c(7, 8)) {
-    colnames(cp) <- c("Futility", "Efficacy", "Harm")
-    colnames(cp1) <- c("Futility", "Efficacy", "Harm")
-  } else if (x$test.type > 1) {
-    colnames(cp) <- c("Futility", "Efficacy")
-    colnames(cp1) <- c("Futility", "Efficacy")
+  if (x$k > 1) {
+    # conditional power at bound, theta=hat(theta)
+    cp <- data.frame(gsBoundCP(x, r = r))
+    # conditional power at bound, theta=theta[1]
+    cp1 <- data.frame(gsBoundCP(x, theta = x$delta, r = r))
+    if (x$test.type %in% c(7, 8)) {
+      colnames(cp) <- c("Futility", "Efficacy", "Harm")
+      colnames(cp1) <- c("Futility", "Efficacy", "Harm")
+    } else if (x$test.type > 1) {
+      colnames(cp) <- c("Futility", "Efficacy")
+      colnames(cp1) <- c("Futility", "Efficacy")
+    } else {
+      colnames(cp) <- "Efficacy"
+      colnames(cp1) <- "Efficacy"
+    }
+    cp <- data.frame(cp, "Value" = "CP", i = seq_len(x$k - 1))
+    cp1 <- data.frame(cp1, "Value" = "CP H1", i = seq_len(x$k - 1))
   } else {
-    colnames(cp) <- "Efficacy"
-    colnames(cp1) <- "Efficacy"
+    cp <- NULL
+    cp1 <- NULL
   }
-  cp <- data.frame(cp, "Value" = "CP", i = 1:(x$k - 1))
-  cp1 <- data.frame(cp1, "Value" = "CP H1", i = 1:(x$k - 1))
-  if ("PP" %in% exclude) {
+  if ("PP" %in% exclude || x$k == 1) {
     pp <- NULL
   } else {
     # predictive probability
@@ -560,19 +581,49 @@ gsBoundSummary0 <- function(
     }
   } else {
     nstat <- 4
-    statframe[statframe$Value == statframe$Value[3], ]$Analysis <- paste("Events:", ceiling(x$n.I))
-    if (x$ratio == 1) N <- 2 * ceiling(rowSums(x$eNE)) else N <- ceiling(rowSums(x$eNE)) + ceiling(rowSums(x$eNC))
+    event_counts <- gsRoundNearInteger(x$n.I)
+    statframe[statframe$Value == statframe$Value[3], ]$Analysis <- paste("Events:", ceiling(event_counts))
+    experimental_n <- gsRoundNearInteger(rowSums(x$eNE))
+    control_n <- gsRoundNearInteger(rowSums(x$eNC))
+    if (x$ratio == 1) N <- 2 * ceiling(experimental_n) else N <- ceiling(experimental_n) + ceiling(control_n)
     Time <- round(x$T, tdigits)
     statframe[statframe$Value == statframe$Value[4], ]$Analysis <- paste(timename, ": ", as.character(Time), sep = "")
   }
   statframe[statframe$Value == statframe$Value[2], ]$Analysis <- paste(Nname, ": ", N, sep = "")
   # add POS and predictive POS, if requested
   if (POS) {
-    ppos <- rep("", x$k)
-    for (i in 1:(x$k - 1)) ppos[i] <- paste("Post IA POS: ", as.character(round(100 * gsCPOS(i = i, x = x, theta = prior$z, wgts = prior$wgts), 1)), "%", sep = "")
-    statframe[statframe$Value == statframe$Value[nstat + 1], ]$Analysis <- ppos
-    statframe[nstat + 2, ]$Analysis <- ppos[1]
-    statframe[nstat + 1, ]$Analysis <- paste("Trial POS: ", as.character(round(100 * gsPOS(x = x, theta = prior$z, wgts = prior$wgts), 1)), "%", sep = "")
+    if (x$k == 1) {
+      trial_pos <- sum(
+        prior$wgts * stats::pnorm(
+          prior$z * sqrt(x$n.I[1]) - x$upper$bound[1]
+        )
+      )
+      statframe$Analysis[nrow(statframe)] <- paste0(
+        "Trial POS: ", round(100 * trial_pos, 1), "%"
+      )
+    } else {
+      ppos <- rep("", x$k)
+      for (i in seq_len(x$k - 1)) {
+        ppos[i] <- paste(
+          "Post IA POS: ",
+          as.character(round(100 * gsCPOS(
+            i = i, x = x, theta = prior$z, wgts = prior$wgts
+          ), 1)),
+          "%",
+          sep = ""
+        )
+      }
+      statframe[statframe$Value == statframe$Value[nstat + 1], ]$Analysis <- ppos
+      statframe[nstat + 2, ]$Analysis <- ppos[1]
+      statframe[nstat + 1, ]$Analysis <- paste(
+        "Trial POS: ",
+        as.character(round(100 * gsPOS(
+          x = x, theta = prior$z, wgts = prior$wgts
+        ), 1)),
+        "%",
+        sep = ""
+      )
+    }
   }
   # add futility and harm columns to data frame
   if (x$test.type %in% c(7, 8)) {
@@ -636,6 +687,8 @@ gsBoundSummary0 <- function(
 #' provided for LaTeX output by setting default options for
 #' \code{\link[xtable]{print.xtable}} when producing tables summarizing design
 #' bounds.
+#' Single-analysis fixed designs are supported; interim-only characteristics
+#' such as conditional and predictive power are omitted when \code{k = 1}.
 #'
 #' Individual transformation of z-value test statistics for interim and final
 #' analyses are obtained from \code{gsBValue()}, \code{gsDelta()},
@@ -1060,6 +1113,21 @@ gsAlternateAlphaDesign <- function(
     sfu = x$upper$sf,
     sfupar = x$upper$param,
     usTime = x$upper$sTime) {
+  if (x$k == 1) {
+    y <- x
+    y$alpha <- alpha
+    y$upper$spend <- alpha
+    y$upper$bound <- stats::qnorm(1 - alpha)
+    y$upper$prob <- matrix(
+      stats::pnorm(
+        outer(sqrt(y$n.I), y$theta) - y$upper$bound
+      ),
+      nrow = 1
+    )
+    y$beta <- 1 - y$upper$prob[1, length(y$theta)]
+    return(y)
+  }
+
   test_upper <- if (is.null(x$testUpper)) rep(TRUE, x$k) else x$testUpper
   lower_sf <- if (is.null(x$lower) || is.null(x$lower$sf)) sfHSD else x$lower$sf
   lower_param <- if (is.null(x$lower) || is.null(x$lower$param)) -2 else x$lower$param

R/gsSurv-nSurv.R

@@ -10,6 +10,10 @@
 #' are also supported; see Details.
 #' \code{gsSurv()} combines \code{nSurv()} with \code{gsDesign()} to derive a
 #' group sequential design for a study with a time-to-event endpoint.
+#' When \code{k = 1}, \code{gsSurv()} uses the fixed-design calculations from
+#' \code{nSurv()} directly and returns a normalized single-analysis
+#' \code{gsSurv} object for use with functions such as
+#' \code{\link{toInteger}} and \code{\link{gsBoundSummary}}.
 #'
 #' @details
 #' The Lachin and Foulkes method uses both null and alternate hypothesis

R/gsSurv-utils.R

@@ -66,3 +66,124 @@ validate_survival_timing_inputs <- function(R, T, minfup, call = "nSurv") {
   }
   invisible(TRUE)
 }
+
+# Construct the gsDesign portion of a single-analysis survival design without
+# calling gsDesign(), whose group-sequential validation requires k >= 2.
+gsSurvFixedDesignObject <- function(
+    alpha,
+    design_beta,
+    n_fix,
+    event_count,
+    delta0,
+    delta1,
+    theta_alt,
+    power,
+    sfu = sfHSD,
+    sfupar = -4,
+    sided = 1,
+    tol = .Machine$double.eps^0.25,
+    r = 18) {
+  z_alpha <- stats::qnorm(1 - alpha)
+
+  if (is.character(sfu)) {
+    upper <- list(
+      sf = sfu, name = sfu, parname = "Delta", param = sfupar, sTime = 1
+    )
+    if (sfu %in% c("OF", "Pocock")) upper$param <- NULL
+    class(upper) <- "spendfn"
+  } else if (is.function(sfu)) {
+    upper <- sfu(alpha, 1, sfupar)
+    upper$sTime <- 1
+  } else {
+    stop("Upper spending function mis-specified")
+  }
+  upper$spend <- alpha
+  upper$bound <- z_alpha
+  upper$prob <- matrix(c(alpha, power), nrow = 1)
+
+  delta <- (z_alpha + stats::qnorm(1 - design_beta)) / sqrt(n_fix)
+  result <- list(
+    k = 1L,
+    test.type = 1L,
+    alpha = alpha,
+    sided = sided,
+    beta = 1 - power,
+    astar = 0,
+    delta = delta,
+    n.fix = n_fix,
+    timing = 1,
+    tol = tol,
+    r = r,
+    n.I = event_count,
+    maxn.IPlan = event_count,
+    nFixSurv = 0,
+    nSurv = 0,
+    endpoint = NULL,
+    delta1 = delta1,
+    delta0 = delta0,
+    overrun = 0,
+    usTime = NULL,
+    lsTime = NULL,
+    testUpper = TRUE,
+    testLower = FALSE,
+    testHarm = FALSE,
+    upper = upper,
+    lower = NULL,
+    theta = c(0, theta_alt),
+    en = rep(event_count, 2)
+  )
+  class(result) <- "gsDesign"
+  result
+}
+
+asGsSurvFixedDesign <- function(
+    x,
+    sfu = sfHSD,
+    sfupar = -4,
+    r = 18,
+    tol = .Machine$double.eps^0.25,
+    call = NULL,
+    inputs = NULL) {
+  design <- gsSurvFixedDesignObject(
+    alpha = x$alpha / x$sided,
+    design_beta = x$beta,
+    n_fix = x$d,
+    event_count = x$d,
+    delta0 = log(x$hr0),
+    delta1 = log(x$hr),
+    theta_alt = (stats::qnorm(1 - x$alpha / x$sided) +
+      stats::qnorm(x$power)) / sqrt(x$d),
+    power = x$power,
+    sfu = sfu,
+    sfupar = sfupar,
+    sided = x$sided,
+    tol = tol,
+    r = r
+  )
+
+  design$T <- x$T
+  design$eDC <- matrix(x$eDC, nrow = 1)
+  design$eDE <- matrix(x$eDE, nrow = 1)
+  design$eDC0 <- matrix(x$eDC0, nrow = 1)
+  design$eDE0 <- matrix(x$eDE0, nrow = 1)
+  design$eNC <- matrix(x$eNC, nrow = 1)
+  design$eNE <- matrix(x$eNE, nrow = 1)
+  design$hr <- x$hr
+  design$hr0 <- x$hr0
+  design$R <- x$R
+  design$S <- x$S
+  design$minfup <- x$minfup
+  design$gamma <- x$gamma
+  design$ratio <- x$ratio
+  design$lambdaC <- x$lambdaC
+  design$etaC <- x$etaC
+  design$etaE <- x$etaE
+  design$variable <- x$variable
+  design$method <- x$method
+  design$power <- x$power
+  design$call <- call
+  design$inputs <- inputs
+  class(design) <- c("gsSurv", "gsDesign")
+
+  design
+}