41_h_get_decisionDist.R clean

R/ocPostprobDist.R

@@ -1,6 +1,104 @@
 #' @include postprobDist.R
 NULL
 
+#' Evaluate posteriors based on  Efficacy and Futility thresholds in two-armed trials.
+#'
+#' The helper function to evaluate generated posteriors and create an "array"
+#' or "vector" of decision results based on user defined thresholds.
+#' `h_get_decisionDist` was adapted by incorporating `postprobDist()`
+#' instead of `postprob()` to evaluate this posterior.
+#' The methodology is from Thall & Simon 1994 (Biometrics).
+#'
+#' @typed nnr : numeric
+#'  the union of `nnE`and `nnF`.
+#' @typed nnrE
+#'  the result for Efficacy looks with random distance added.
+#' @typed nnrF
+#'  the result for Futility looks with random distance added.
+#' @typed truep : number
+#'  assumed true response rate or true rate (scenario).
+#' @typed parE :
+#'  alpha and beta parameters for the prior on the treatment population.
+#'  Default set at alpha = 1, beta = 1, or uniform prior.
+#' @typed parS :
+#'  alpha and beta parameters for the prior on the control population.
+#'  Default set at alpha = 1, beta = 1, or uniform prior.
+#' @typed tL : number
+#'  posterior probability threshold for being below `p0`.
+#' @typed tU : number
+#'  posterior probability threshold for being above `p1`.
+#' @typed deltaF :
+#'  delta for efficacy: `P(P_E > P_S + deltaE)` should be large
+#'  to stop for efficacy.
+#' @typed deltaE :
+#'  margin by which the response rate in the treatment group should
+#'  be better than in the standard of care or control or `S` group.
+#' @typed relativeDelta : flag
+#'  If `TRUE`, then a `relativeDelta` is used. Represents that a minimum
+#'  response rate in magnitude of `delta` of the `S` non-responding patients
+#'  exists and is used if `TRUE`.
+#'  See [postprobDist()].
+#'
+#' @return A list of the following objects :
+#'  - `decision` : resulting numeric of decision, one of `TRUE` for Go, `FALSE` for Stop, `NA` for Gray zone.
+#'  - `all_sizes` : resulting numeric of look size, anything below maximum
+#'   look size is an indicated interim, Futility or Efficacy or both.
+#'
+#' @keywords internal
+#'
+h_get_decisionDist <- function(nnr,
+                               nnrE,
+                               nnrF,
+                               truep,
+                               parE = c(1, 1),
+                               parS = c(1, 1),
+                               tL,
+                               tU,
+                               deltaF,
+                               deltaE,
+                               relativeDelta) {
+  index_look <- 1
+  size_look <- nnr[index_look]
+  all_sizes <- decision <- NA
+  response <- stats::rbinom(max(nnr), size = 1, truep)
+
+  while (is.na(decision) && index_look <= length(nnr)) {
+    if (size_look %in% nnrF) {
+      qL <- postprobDist(
+        x = 0,
+        n = 0,
+        xS = sum(response[1:size_look]),
+        nS = size_look,
+        delta = deltaF,
+        relativeDelta = relativeDelta,
+        parE = parS,
+        parS = parE
+      )
+      decision <- ifelse(qL >= tL, FALSE, NA)
+    }
+    if (size_look %in% nnrE) {
+      qU <- postprobDist(
+        x = sum(response[1:size_look]),
+        n = size_look,
+        xS = 0,
+        nS = 0,
+        delta = deltaE,
+        relativeDelta = relativeDelta,
+        parE = parE,
+        parS = parS
+      )
+      decision <- ifelse(qU < tU, decision, TRUE)
+    }
+    all_sizes <- size_look
+    index_look <- index_look + 1
+    size_look <- nnr[index_look]
+  }
+  list(
+    decision = decision,
+    all_sizes = all_sizes
+  )
+}
+
 #' Calculate operating characteristics for posterior probability method
 #' with beta prior on SOC
 #'