clean

R/ocPostprobDist.R

@@ -83,134 +83,149 @@ h_get_decisionDist <- function(nnr,
   )
 }
 
-#' Calculate operating characteristics for posterior probability method
-#' with beta prior on SOC
+#' Calculate Operating characteristics of Posterior Probability method
+#' with Beta Prior on the Control or Standard of Care Arm
 #'
 #' The trial is stopped for efficacy if the posterior probability to be at
-#' least deltaE better than the control is larger than tU, and stopped for
-#' futility if the posterior probability to be at least deltaF worse than the
-#' control is larger than tL. Otherwise the trial is continued, and at the
+#' least `deltaE` better than the control is larger than `tU`, and stopped for
+#' futility if the posterior probability to be at least `deltaF` worse than the
+#' control is larger than `tL`. Otherwise the trial is continued, and at the
 #' maximum sample size it may happen that no decision is made ("gray zone").
 #'
-#' Returned operating characteristics in a matrix include:
-#' ExpectedN: expected number of patients in the trials
-#' PrStopEarly: probability to stop the trial early (before reaching the
+#' #' Stop criteria for Efficacy :
+#'
+#' `P_e(p > p1 + deltaE) > tU`
+#'
+#' Stop criteria for Futility :
+#'
+#' `P_E(p < p0 + deltaF) > tL`
+#'
+#' Resulting operating characteristics include the following:
+#'
+#' - `ExpectedN`: expected number of patients in the trials
+#' - `PrStopEarly`: probability to stop the trial early (before reaching the
 #' maximum sample size)
-#' PrEarlyEff: probability to decide for efficacy early
-#' PrEarlyFut: probability to decide for futility early
-#' PrEfficacy: probability to decide for efficacy
-#' PrFutility: probability to decide for futility
-#' PrGrayZone: probability of no decision at the end ("gray zone")
-#'
-#' @param nn vector of look locations for efficacy
-#' (if futility looks should be different, please specify also \code{nnF})
-#' @param p true rate (scenario)
-#' @param deltaE delta for efficacy: P(pE > pS + deltaE) should be large
-#' to stop for efficacy
-#' @param deltaF delta for futility: P(pE < pS - deltaF) should be large to
-#' stop for futility
-#' @param relativeDelta see \code{\link{postprobDist}}
-#' @param tL probability threshold for being below control - deltaF
-#' @param tU probability threshold for being above control + deltaE
-#' @param parE beta parameters for the prior on the treatment proportion
-#' @param parS beta parameters for the prior on the control proportion
-#' @param ns number of simulations
-#' @param nr generate random look locations? (not default)
-#' @param d distance for random looks around the look locations in \code{nn}
-#' @param nnF vector of look locations for futility
-#' (default: same as efficacy)
-#' @return A list with the following elements:
-#' oc: matrix with operating characteristics (see Details section)
-#' Decision: vector of the decisions made in the simulated trials
-#' (\code{TRUE} for success, \code{FALSE} for failure, \code{NA} for no
-#' decision)
-#' SampleSize: vector of the sample sizes in the simulated trials
-#' nn: vector of look locations
-#' nnE: vector of efficacy look locations
-#' nnF: vector of futility look locations
-#' todo: would we like to return nnr instead, the actual look locations?
-#' params: input parameters for this function
+#' - `PrEarlyEff`: probability of Early Go decision
+#' - `PrEarlyFut`: probability of for Early Stop decision
+#' - `PrEfficacy`: probability of Go decision
+#' - `PrFutility`: probability of Stop decision
+#' - `PrGrayZone`: probability between Go and Stop ,"Evaluate" or Gray decision zone
+#'
+#' @inheritParams ocPostprob
+#' @inheritParams postprobDist
+#' @inheritParams h_get_decisionDist
+#' @inheritParams h_get_distance
+#' @typed deltaE : number
+#'  margin by which the response rate in the treatment group should be better
+#'  than in the standard of care of `group`. Delta for efficacy is used to
+#'  calculate `P(P_E > P_S + deltaE)` which should
+#'  exceed threshold `tU` to to stop for efficacy.
+#'  Note that this can also be negative, e.g. when non-inferiority is being assessed.
+#'  See note.
+#' @typed deltaF : number
+#'  margin by which the response rate in the treatment group should be better
+#'  than in the standard of care of `group`. Delta for futility is used to
+#'  calculate  `P(P_E > P_S + deltaS)` which should
+#'  exceed threshold `tL` to stop for futility.
+#'  Note that this can also be negative, e.g. when non-inferiority is being assessed.
+#'  See note.
+#'
+#' @note
+#'
+#' ## Delta :
+#'
+#' The desired improvement is denoted as `delta`. There are two options in using `delta`.
+#' The absolute case when `relativeDelta = FALSE` and relative as when `relativeDelta = TRUE`.
+#'
+#' 1. The absolute case is when we define an absolute delta, greater than `P_S`,
+#' the response rate of the standard of care or control or `S` group such that
+#' the posterior is `Pr(P_E > P_S + deltaE | data)` for efficacy looks
+#' or `Pr(P_E > P_S + deltaF | data)` for futility looks.
+#'
+#' 2. In the relative case, we suppose that the treatment group's
+#' response rate is assumed to be greater than `P_S + (1-P_S) * delta` such that
+#' the posterior is `Pr(P_E > P_S + (1 - P_S) * deltaE | data)` for efficacy looks
+#' or `Pr(P_E > P_S + (1 - P_S) * deltaF | data)` for futility looks.
 #'
 #' @example examples/ocPostprobDist.R
 #' @export
-ocPostprobDist <- function(nn, p, deltaE, deltaF, relativeDelta = FALSE,
-                           tL, tU,
+ocPostprobDist <- function(nn,
+                           truep,
+                           deltaE,
+                           deltaF,
+                           relativeDelta = FALSE,
+                           tL,
+                           tU,
                            parE = c(a = 1, b = 1),
                            parS = c(a = 1, b = 1),
-                           ns = 10000, nr = FALSE, d = NULL, nnF = nn) {
+                           wiggle = TRUE,
+                           sim = 50000,
+                           nnF = nn) {
+  assert_numeric(nn, min.len = 1, lower = 1, upper = max(nn), any.missing = FALSE)
+  assert_number(truep, lower = 0, upper = 1)
+  assert_number(deltaE, upper = 1, finite = TRUE)
+  assert_number(deltaF, upper = 1, finite = TRUE)
+  assert_flag(relativeDelta)
+  assert_number(tL, lower = 0, upper = 1)
+  assert_number(tU, lower = 0, upper = 1)
+  assert_numeric(parE, lower = 0, finite = TRUE, any.missing = FALSE)
+  assert_numeric(parS, lower = 0, finite = TRUE, any.missing = FALSE)
+  assert_number(sim, lower = 100, finite = TRUE)
+  assert_flag(wiggle)
+  assert_numeric(nnF, min.len = 1, any.missing = FALSE)
+
+  if (sim < 50000) {
+    warning("Advise to use sim >= 50000 to achieve convergence")
+  }
+  decision <- vector(length = sim)
+  all_sizes <- vector(length = sim)
+
   nnE <- sort(nn)
   nnF <- sort(nnF)
-  s <- rep(NA, ns)
-  n <- s
   nn <- sort(unique(c(nnF, nnE)))
   nL <- length(nn)
   Nstart <- nn[1]
   Nmax <- nn[nL]
-  if (nr && is.null(d)) {
-    ## set parameter d for randomly generating look locations
-    d <- floor(min(nn - c(0, nn[-nL])) / 2)
-  }
-  nnr <- nn
-  nnrE <- nnE
-  nnrF <- nnF
-  ## simulate a clinical trial ns times
-  for (k in 1:ns) {
-    if (nr && (d > 0)) {
-      ## randomly generate look locations
-      dd <- sample(-d:d,
-        size = nL - 1, replace = TRUE,
-        prob = 2^(c(-d:0, rev(-d:(-1))) / 2)
-      )
-      nnr <- nn + c(dd, 0)
-      nnrE <- nnr[nn %in% nnE]
-      nnrF <- nnr[nn %in% nnF]
-    }
-    x <- stats::rbinom(Nmax, 1, p)
-    j <- 1
-    i <- nnr[j]
-    while (is.na(s[k]) && (j <= length(nnr))) {
-      if (i %in% nnrF) {
-        qL <- postprobDist(
-          x = 0, n = 0,
-          xS = sum(x[1:i]), nS = i,
-          delta = deltaF,
-          relativeDelta = relativeDelta,
-          parE = parS, parS = parE
-        )
-        s[k] <- ifelse(qL >= tL, FALSE, NA)
-      }
-      if (i %in% nnrE) {
-        qU <- postprobDist(
-          x = sum(x[1:i]), n = i,
-          xS = 0, nS = 0,
-          delta = deltaE,
-          relativeDelta = relativeDelta,
-          parE = parE,
-          parS = parS
-        )
-        s[k] <- ifelse(qU < tU, s[k], TRUE)
-      }
-      n[k] <- i
-      j <- j + 1
-      i <- nnr[j]
+
+  # simulate a clinical trial sim times
+  for (k in seq_len(sim)) {
+    if (length(nn) != 1 && wiggle) {
+      # randomly generate look locations
+      dist <- h_get_distance(nn = nn)
+      nnr <- h_get_looks(dist = dist, nnE = nnE, nnF = nnF) # we generate sim number of looks
+      nnrE <- nnr$nnrE
+      nnrF <- nnr$nnrF
+    } else {
+      nnrE <- nnE
+      nnrF <- nnF
     }
+    nnr <- unique(c(nnrE, nnrF))
+    tmp <- h_get_decisionDist(
+      nnr = nnr,
+      nnrE = nnrE,
+      nnrF = nnrF,
+      truep = truep,
+      parE = c(1, 1),
+      tL = tL,
+      tU = tU,
+      deltaE = deltaE,
+      deltaF = deltaF,
+      relativeDelta = relativeDelta
+    )
+    decision[k] <- tmp$decision
+    all_sizes[k] <- tmp$all_sizes
   }
-  oc <- cbind(
-    ExpectedN = mean(n),
-    PrStopEarly = mean(n < Nmax),
-    PrEarlyEff = sum(s * (n < Nmax), na.rm = TRUE) / ns,
-    PrEarlyFut = sum((1 - s) * (n < Nmax), na.rm = TRUE) / ns,
-    PrEfficacy = sum(s, na.rm = TRUE) / ns,
-    PrFutility = sum(1 - s, na.rm = TRUE) / ns,
-    PrGrayZone = sum(is.na(s) / ns)
-  )
+  oc <- h_get_oc(all_sizes = all_sizes, nnr = nnr, decision = decision, nnrE = nnrE, nnrF = nnrF)
   list(
     oc = oc,
-    Decision = s,
-    SampleSize = n,
-    nn = nn,
-    nnE = nnE,
-    nnF = nnF,
+    Decision = decision,
+    SampleSize = all_sizes,
+    union_nn = nnr,
+    input_nnE = nnE,
+    input_nnF = nnF,
+    wiggled_nnE = nnrE,
+    wiggled_nnF = nnrF,
+    wiggle_dist = dist,
     params = as.list(match.call(expand.dots = FALSE))
   )
 }

R/postprobDist.R

@@ -88,7 +88,7 @@ h_get_bounds <- function(controlBetamixPost) {
 #'
 #' Using the approach by Thall and Simon (Biometrics, 1994), this evaluates the
 #' posterior probability of achieving superior response rate in the treatment group `E`
-#' compared to standard of care `S`. `E`See note below for two formulations of the difference in response rates.
+#' compared to standard of care `S`. See note below for two formulations of the difference in response rates.
 #'
 #' @inheritParams h_integrand_relDelta
 #'

design/design-doc_ocPostprobDist.Rmd

@@ -136,8 +136,7 @@ ocPostprobDist <- function(nn,
                            parS = c(a = 1, b = 1),
                            wiggle = TRUE,
                            sim = 50000,
-                           nnF = nn,
-                           randomdist = TRUE) {
+                           nnF = nn) {
   assert_numeric(nn, min.len = 1, lower = 1, upper = max(nn), any.missing = FALSE)
   assert_number(truep, lower = 0, upper = 1)
   assert_number(deltaE, upper = 1, finite = TRUE)
@@ -150,7 +149,6 @@ ocPostprobDist <- function(nn,
   assert_number(sim, lower = 100, finite = TRUE)
   assert_flag(wiggle)
   assert_numeric(nnF, min.len = 1, any.missing = FALSE)
-  assert_flag(randomdist)
 
   if (sim < 50000) {
     warning("Advise to use sim >= 50000 to achieve convergence")
@@ -167,7 +165,7 @@ ocPostprobDist <- function(nn,
 
   # simulate a clinical trial sim times
   for (k in seq_len(sim)) {
-    if (length(nn) != 1 && wiggle && randomdist) {
+    if (length(nn) != 1 && wiggle) {
       # randomly generate look locations
       dist <- h_get_distance(nn = nn)
       nnr <- h_get_looks(dist = dist, nnE = nnE, nnF = nnF) # we generate sim number of looks
@@ -222,7 +220,6 @@ res3 <- ocPostprobDist(
   parE = c(a = 1, b = 1),
   parS = c(a = 1, b = 1),
   sim = 100,
-  randomdist = TRUE,
   wiggle = TRUE
 )
 
@@ -242,7 +239,6 @@ res2 <- ocPostprobDist(
   parE = c(1, 1),
   parS = c(5, 25),
   sim = 100,
-  randomdist = TRUE,
   wiggle = TRUE
 )