#' Design a single-stage single-arm trial for a single binary endpoint
#'
#' Determines single-stage single-arm clinical trial designs
#' for a single binary primary endpoint, using either exact binomial
#' calculations, or a normal approximation approach.
#'
#' \code{des_fixed()} supports the determination of single-stage single-arm
#' clinical trial designs for a single binary primary endpoint. The following
#' hypotheses are tested for the response probability
#' \ifelse{html}{\out{<i>π</i>}}{\eqn{\pi}}
#'
#' \ifelse{html}{\out{<center><i>H</i><sub>0</sub> : <i>π</i> ≤ <i>π
#' </i><sub>0</sub>, <i>H</i><sub>1</sub> : <i>π</i> > <i>π</i><sub>
#' 0</sub>,</center>}}{\deqn{H_0 : \pi \le \pi_0,\qquad H_1 : \pi > \pi_0,}}
#'
#' for \ifelse{html}{\out{<i>π</i><sub>0</sub>}}{\eqn{\pi_0}}, specified
#' using the argument \code{pi0}.
#'
#' In each instance, the optimal design is required to meet the following
#' operating characteristics
#'
#' \ifelse{html}{\out{<center><i>P</i>(<i>π</i><sub>0</sub>) ≤
#' <i>α</i>, <i>P</i>(<i>π</i><sub>1</sub>) ≥ 1 - <i>β</i>,
#' </center>}}{\deqn{P(\pi_0) \le \alpha,\qquad P(\pi_1) \ge 1 - \beta,}}
#'
#' where \ifelse{html}{\out{<i>P</i>(<i>π</i>)}}{\eqn{P(\pi)}} is the
#' probability of rejecting \ifelse{html}{\out{<i>H</i><sub>0</sub>}}{\eqn{H_0}}
#' when the true response probability is
#' \ifelse{html}{\out{<i>π</i>}}{\eqn{\pi}}, and the values of
#' \ifelse{html}{\out{<i>α</i>}}{\eqn{\alpha}} and
#' \ifelse{html}{\out{<i>β</i>}}{\eqn{\beta}} are specified using the
#' arguments \code{alpha} and \code{beta} respectively. Moreover,
#' \ifelse{html}{\out{<i>π</i><sub>1</sub>}}{\eqn{\pi_1}}, satisfying
#' \ifelse{html}{\out{<i>π</i><sub>0</sub> <
#' <i>π</i><sub>1</sub>}}{\eqn{\pi_0 < \pi_1}}, is specified using the
#' argument \code{pi1}.
#'
#' A single-stage single-arm design for a single binary endpoint is ultimately
#' indexed by three parameters: \ifelse{html}{\out{<i>a</i>}}{\eqn{a}},
#' \ifelse{html}{\out{<i>r</i>}}{\eqn{r}}, and
#' \ifelse{html}{\out{<i>n</i>}}{\eqn{n}}.
#'
#' With these parameters, and denoting the number of responses after
#' \ifelse{html}{\out{<i>m</i>}}{\eqn{m}} outcomes have been observed by
#' \ifelse{html}{\out{<i>s</i><sub><i>m</i></sub>}}{\eqn{s_m}}, the testing
#' rules for the trial are as follows
#'
#' \itemize{
#' \item If \ifelse{html}{\out{<i>s</i><sub><i>n</i></sub>
#' ≤ <i>a</i>}}{\eqn{s_{n} \le a}}, then do not reject
#' \ifelse{html}{\out{<i>H</i><sub>0</sub>}}{\eqn{H_0}}.
#' \item Else if \ifelse{html}{\out{<i>s</i><sub><i>n</i></sub>
#' ≥ <i>r</i>}}{\eqn{s_{n} \ge r}}, then reject
#' \ifelse{html}{\out{<i>H</i><sub>0</sub>}}{\eqn{H_0}}.
#' }
#'
#' The purpose of this function is then to determine (optimise)
#' \ifelse{html}{\out{<i>a</i>}}{\eqn{a}},
#' \ifelse{html}{\out{<i>r</i>}}{\eqn{r}}, and
#' \ifelse{html}{\out{<i>n</i>}}{\eqn{n}}, accounting for the chosen
#' restrictions placed on these parameters.
#'
#' The arguments \code{Nmin} and \code{Nmax} allow restrictions
#' to be placed on \ifelse{html}{\out{<i>n</i>}}{\eqn{n}}.
#' Precisely, \code{Nmin} and \code{Nmax} set an inclusive range of allowed
#' values for \ifelse{html}{\out{<i>n</i>}}{\eqn{n}}.
#'
#' Note that to ensure a decision is made about
#' \ifelse{html}{\out{<i>H</i><sub>0</sub>}}{\eqn{H_0}}, this function always
#' enforces \ifelse{html}{\out{<i>a</i> + 1 = <i>r</i>}}{\eqn{a + 1 = r}}.
#'
#' The optimal design is then the one that minimises
#' \ifelse{html}{\out{<i>n</i>}}{\eqn{n}}. In the case where there are multiple
#' feasible designs with the same minimal value of
#' \ifelse{html}{\out{<i>n</i>}}{\eqn{n}}, the optimal design is the one amongst
#' these which maximises
#' \ifelse{html}{\out{<i>P</i>(<i>π</i><sub>1</sub>)}}{\eqn{P(\pi_1)}}.
#'
#' If \code{exact} is set to \code{TRUE} then exact binomial probability
#' calculations are used to identify the optimal design. Otherwise, a normal
#' approximation approach is used. Note that setting \code{exact = TRUE} is
#' recommended.
#'
#' @param pi0 The (undesirable) response probability used in the definition of
#' the null hypothesis. Defaults to 0.1.
#' @param pi1 The (desirable) response probability at which the trial is
#' powered. Defaults to 0.3.
#' @param alpha The desired maximal type-I error rate. Defaults to 0.05.
#' @param beta The desired maximal type-II error rate. Defaults to 0.2.
#' @param Nmin The minimal sample size to allow in considered designs. Defaults
#' to 1.
#' @param Nmax The maximal sample size to allow in considered designs. Defaults
#' to 30.
#' @param exact A logical variable indicating whether exact binomial
#' calculations or a normal approximation approach should be used to determine
#' the optimal design. Defaults to TRUE.
#' @param summary A logical variable indicating whether a summary of the
#' function's progress should be printed to the console. Defaults to FALSE.
#' @return A list of class \code{"sa_des_fixed"} containing the following
#' elements
#' \itemize{
#' \item A tibble in the slot \code{$des} summarising the characteristics of the
#' identified optimal design. This will be \code{NULL} if no feasible design was
#' identified in the considered range for
#' \ifelse{html}{\out{<i>n</i>}}{\eqn{n}}.
#' \item A tibble in the slot \code{$feasible}, consisting of the identified
#' designs which met the required operating characteristics.
#' \item Each of the input variables as specified, subject to internal
#' modification.
#' }
#' @examples
#' # The optimal design for the default parameters
#' des <- des_fixed()
#' # The optimal single-stage design for a 10% type-I error rate
#' des_10 <- des_fixed(alpha = 0.1)
#' @references A'Hern RP (2001) Sample size tables for exact single-stage phase
#' II designs. \emph{Statistics in Medicine} \strong{20:}859-66.
#' @references Fleming TR (1982) One-sample multiple testing procedure for phase
#' II clinical trials. \emph{Biometrics} \strong{38:}143-51.
#' @seealso \code{\link{opchar_fixed}}, \code{\link{est_fixed}},
#' \code{\link{pval_fixed}}, \code{\link{ci_fixed}}, and their
#' associated \code{plot} family of functions. Note that similar functionality
#' is available through \code{\link[clinfun]{ph2single}}.
#' @export
des_fixed <- function(pi0 = 0.1, pi1 = 0.3, alpha = 0.05, beta = 0.2, Nmin = 1,
Nmax = 30, exact = T, summary = F) {
##### Input Checking #########################################################
check_real_pair_range_strict(pi0, pi1, "pi0", "pi1", c(0, 1))
check_real_range_strict(alpha, "alpha", c(0, 1), 1)
check_real_range_strict(beta, "beta", c(0, 1), 1)
check_integer_pair_range(Nmin, Nmax, "Nmin", "Nmax", c(0, Inf))
check_logical(exact, "exact")
check_logical(summary, "summary")
##### Print Summary ##########################################################
if (summary){
message(rep("-", 10))
message("Design of a single-stage single-arm trial for a single binary endpoint")
message(rep("-", 10))
Sys.sleep(2)
message("\nYou have chosen to test the following hypotheses\n")
message(" H\u2080: \u03c0 \u2264 \u03c0\u2080 = ", pi0, ", H\u2081: \u03c0 > \u03c0\u2080 = ", pi0, ".\n")
message("with the following error constraints\n")
message(" P(\u03c0\u2080) = P(", pi0, ") \u2264 \u03b1 = ", alpha, ", P(\u03c0\u2081) = P(", pi1, ") \u2265 1 - \u03b2 = ", 1 - beta, ".\n")
Sys.sleep(2)
message("You have chosen to restrict the allowed possible sample size N = n such that\n")
message(" \u2022 N \u2265 ", Nmin, ".")
message(" \u2022 N \u2264 ", Nmax, ".\n")
Sys.sleep(2)
if (exact) {
message("You have chosen to compute the optimal design using exact binomial calculations.\n")
} else {
message("You have chosen to compute the optimal design using a normal approximation approach.\n")
}
Sys.sleep(2)
message("Beginning the required calculations...")
}
##### Main Computations ######################################################
pmf <- list()
for (n in 1:Nmax) {
pmf[[n]] <- pmf_fixed(c(pi0, pi1), n)
}
pmf <- tibble::as_tibble(plyr::rbind.fill(pmf))
if (exact) {
possible <- as.matrix(expand.grid(rep(list(0:Nmax), 2)))[, 2:1]
} else {
possible <- Nmin:Nmax
possible <- cbind(possible, round(possible*pi0 + stats::qnorm(1 - alpha)*
sqrt(possible*pi0*(1 - pi0))))
}
possible <- possible[which(possible[, 1] > possible[, 2] &
possible[, 2] >= 0), ]
possible <- tibble::tibble(n = as.integer(possible[, 1]),
a = as.integer(possible[, 2]),
r = a + 1L, `P(pi0)` = NA_real_,
`P(pi1)` = NA_real_)
for (i in 1:nrow(possible)) {
possible[i, 4] <-
sum(dplyr::filter(pmf, pi == pi0 & m == as.integer(possible[i, 1]) &
s > as.integer(possible[i, 2]))$`f(s,m|pi)`)
possible[i, 5] <-
sum(dplyr::filter(pmf, pi == pi1 & m == as.integer(possible[i, 1]) &
s > as.integer(possible[i, 2]))$`f(s,m|pi)`)
if (all(summary, i%%1000 == 0)) {
message("...", i, " designs evaluated...")
}
}
feasible <- dplyr::filter(possible, `P(pi0)` <= alpha &
`P(pi1)` >= 1 - beta)
if (nrow(feasible) > 0) {
if (summary) {
message("...feasible designs identified in range of considered N...")
Sys.sleep(2)
message("...now identifying the optimal design...")
}
feasible <- dplyr::mutate(feasible, `ESS(pi0)` = n,
`ESS(pi1)` = n, `VSS(pi0)` = 0,
`VSS(pi1)` = 0, `Med(pi0)` = n,
`Med(pi1)` = n, `A1(pi0)` = 1 - `P(pi0)`,
`R1(pi0)` = `P(pi0)`,
`A1(pi1)` = 1 - `P(pi1)`,
`R1(pi1)` = `P(pi1)`, `S1(pi0)` = 1,
`S1(pi1)` = 1, `cum(S1(pi0))` = 1,
`cum(S1(pi1))` = 1)
feasible <- dplyr::arrange(feasible, n, dplyr::desc(`P(pi1)`))
feasible[, 4:19] <- dplyr::mutate_if(feasible[, 4:19], is.integer,
as.double)
des <- list(n = as.numeric(feasible[1, 1]),
a = as.numeric(feasible[1, 2]),
r = as.numeric(feasible[1, 3]), pi0 = pi0,
pi1 = pi1, alpha = alpha, beta = beta,
opchar = feasible[1, ])
} else {
feasible <- des <- NULL
if (summary) {
message("...no feasible designs identified in range of considered N. Consider decreasing Nmin and increasing Nmax.")
}
}
##### Outputting #############################################################
if (summary) {
message("...outputting.")
}
output <- list(des = des, feasible = feasible, pi0 = pi0, pi1 = pi1,
alpha = alpha, beta = beta, Nmin = Nmin, Nmax = Nmax,
exact = exact, summary = summary)
class(output) <- "sa_des_fixed"
return(output)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.