R/Rfun_solveAlphaXsampleSizeGA.R

In triggerstrategy: Trigger Strategy in Clinical Trials

#Rfun_solveAlphaXsampleSizeGA
# 2020-03-20
#
#' @name solveAlphaXsampleSizeGA
#' @title Sample size calculation using Genetic Algorithms
#' @description This function computes the sample size and the error rate pre-assigned to the primary endpoint using methods of \code{trigger}, \code{holm}, \code{maurer-bretz}, \code{bonferroni}, with Genetic Algorithms.
#' @param alpha a number of overall type I error rate
#' @param beta0 a number of type II error rate for H0
#' @param beta1 a number of type II error rate for H1
#' @param effsz0 a number of the effect size of testing H0
#' @param effsz1 a number of the effect size of testing H1
#' @param szratio a number of the ratio of sample size of testing H0 to that of testing H1
#' @param t0 a vector of information times for H0
#' @param t1 a vector of information times for H1
#' @param tc0 a vector of calendar times for H0
#' @param tc1 a vector of calendar times for H1
#' @param rho a value of correlation coefficient between H0 and H1
#' @param iuse0 an integer shows the type of group sequential boundaries used for the primary endpoint
#' @param iuse1 an integer shows the type of group sequential boundaries used for the secondary endpoint
#' @param phi0 a parameter for the power family or the HSD gamma family for the primary endpoint
#' @param phi1 a parameter for the power family or the HSD gamma family for the secondary endpoint
#' @param usingRhoForBoundary an indicator whether using the informaiton of rho to calculate the boundary, default is FALSE (not using)
#' @param method a text of method, including \code{trigger}, \code{holm}, \code{maurer-bretz}, \code{bonferroni}
#' @param lower a vector of two lower limits for alpha0 and sample size
#' @param upper a vector of two upper limits for alpha0 and sample size.
#' @param maxiter a number of maximum number of iterations
#' @param run a number of maximum number of consecutive generations without any improvement in the best fitness value before the GA is stopped
#' @param seed a number of seed of random number generator
#' @return a list of two values, \code{alpha0} and \code{groupsize}
#' @export
#' @import GA
#' @import stats
#' @details R package \code{GA} is used for Genetic Algorithms.
#' @examples
#' alpha=0.025
#' beta0=0.10
#' beta1=0.20
#' effsz0=0.33
#' effsz1=0.30
#' szratio=1
#' t0=c(0.5,0.9,1)
#' t1=c(0.6,1)
#' tc0=c(1,2)
#' tc1=c(1,2,3)
#' rho=0
#' iuse0=1
#' iuse1=2
#' phi0=-4
#' phi1=1
#' usingRhoForBoundary=FALSE
#' method="trigger"
#' method="bonferroni"
#' method="holm"
#' method="maurer-bretz"
#' lower = c(180,0.005)
#' upper = c(240, alpha-0.005)
#' maxiter = 1 # Increase this number for more precise results
#' run = 1 # Increase this number for more precise results
#' seed = 123
#' result <- solveAlphaXsampleSizeGA(alpha=alpha,
#'     beta0=beta0, beta1=beta1,
#'     effsz0=effsz0, effsz1=effsz1,
#'     szratio=szratio,
#'     t0=t0, t1=t1, tc0=tc0, tc1=tc1,
#'     rho=rho, iuse0=iuse0, iuse1=iuse1,
#'     phi0=phi0, phi1=phi1,
#'     usingRhoForBoundary=usingRhoForBoundary,
#'     method=method,
#'     lower = lower, upper = upper,
#'     maxiter = maxiter,
#'     run = run,
#'     seed = seed)
#' print(result)
#' @references
#'  Gou, J. (2023). Trigger strategy in repeated tests on multiple hypotheses. \emph{Statistics in Biopharmaceutical Research}, 15(1), 133-140.
#'  Gou, J. (2022). Sample size optimization and initial allocation of the significance levels in group sequential trials with multiple endpoints. \emph{Biometrical Journal}, 64(2), 301-311.
#
solveAlphaXsampleSizeGA <- function(alpha, beta0, beta1, effsz0, effsz1, szratio=1, t0=1, t1=1, tc0=t0, tc1=t1, rho=0, iuse0=1, iuse1=1, phi0=rep(1,length(alpha)), phi1=rep(1,length(alpha)), usingRhoForBoundary=FALSE, method="trigger", lower=c(1,1e-4), upper=c(1e4,alpha-1e-4), maxiter=20, run=200, seed=1949) {
  #
  constraint <- function(alpha, alpha0, t0, t1, tc0, tc1, rho, iuse0, iuse1, phi0, phi1, usingRhoForBoundary, groupsize, szratio, effsz0, effsz1, beta0, beta1) {
    if (method == "trigger") {
      groupsize <- floor(groupsize)         # sample size
      t0 <- floor(t0*groupsize)/groupsize
      t1 <- floor(t1*groupsize)/groupsize
      #
      pspwr <- psPwRtrigger(alpha=alpha, alpha0=alpha0, t0=t0, t1=t1, tc0=tc0, tc1=tc1, rho=rho, iuse0=iuse0, iuse1=iuse1, phi0=phi0, phi1=phi1, usingRhoForBoundary=usingRhoForBoundary, groupsize=groupsize, szratio=szratio, effsz0=effsz0, effsz1=effsz1)
      diff <- 1 - c(beta0, beta1) - pspwr
    } else {
      groupsize <- floor(groupsize)         # sample size
      t0 <- floor(t0*groupsize)/groupsize
      t1 <- floor(t1*groupsize)/groupsize
      #
      pspwr <- psPwRbhmb(alpha=alpha, alpha0=alpha0, t0=t0, t1=t1, tc0=tc0, tc1=tc1, rho=rho, iuse0=iuse0, iuse1=iuse1, phi0=phi0, phi1=phi1, usingRhoForBoundary=usingRhoForBoundary, groupsize=groupsize, szratio=szratio, effsz0=effsz0, effsz1=effsz1, method=method)
      diff <- 1 - c(beta0, beta1) - pspwr
    }
    return (diff)
  } # End of function constraint
  #
  target <- function (x, alpha, t0, t1, tc0, tc1, rho, iuse0, iuse1, phi0, phi1, usingRhoForBoundary, szratio, effsz0, effsz1, beta0, beta1) {
    groupsize <- floor(x[1])
    alpha0 <- x[2]
    #
    # we need to maximise the function
    pen <- sqrt(.Machine$double.xmax)  # penalty term
    cnstrt <- constraint(alpha=alpha, alpha0=alpha0, t0=t0, t1=t1, tc0=tc0, tc1=tc1, rho=rho, iuse0=iuse0, iuse1=iuse1, phi0=phi0, phi1=phi1, usingRhoForBoundary=usingRhoForBoundary, groupsize=groupsize, szratio=szratio, effsz0=effsz0, effsz1=effsz1, beta0=beta0, beta1=beta1)
    penalty <- max(cnstrt,0)*pen # penalisation
    return(-groupsize - penalty)
  } # End of function target
  #
  resultGA <- GA::ga("real-valued", fitness = target,
           lower = lower, upper = upper,
           # selection = GA:::gareal_lsSelection_R,
           maxiter = maxiter, run = run, seed = seed,
           alpha=alpha, t0=t0, t1=t1, tc0=tc0, tc1=tc1, rho=rho, iuse0=iuse0, iuse1=iuse1, phi0=phi0, phi1=phi1, usingRhoForBoundary=usingRhoForBoundary, szratio=szratio, effsz0=effsz0, effsz1=effsz1, beta0=beta0, beta1=beta1)
  #
  myresult <- resultGA@solution
  if (is.matrix(myresult)) {
    myresult <- colMeans(myresult, na.rm=FALSE)
    myresult[1] <- floor(myresult[1])
  } else {
    myresult[1] <- floor(myresult[1])
  }
  alpha0 <- as.numeric(myresult[2])
  groupsize <- as.numeric(c(myresult[1], floor(myresult[1]*szratio)))
  result <- list(alpha0=alpha0, groupsize=groupsize)
  return(result)
}#