R/Rfun_optsamplesize_wHolmpm.R

In itrimhoch: Improved Trimmed Weighted Hochberg Procedures and Sample Size Optimization

#' Compute the optimal sample size for the weighted Holm procedure with allowance for different data maturities
#'
#' @param alpha the significance level
#' @param betavec a numeric vector of two values, including one minus the desired power for rejecting H1 and one minus the desired power for rejecting H2
#' @param deltavec a numeric vector of two values representing the effect sizes for the two hypotheses
#' @param rho the correlation coefficient between two test statistics
#' @param maturity  a numeric vector of two values representing the data maturities for the two hypotheses
#' @param ninterval a vector containing the end-points of the interval to be searched for optimal sample size
#' @param alphalist a vector of discrete alpha values
#'
#' @returns the overall optimal sample size for the weighted Holm procedure with allowance for different data maturities
#' @export
#' @importFrom stats uniroot
#' @author Jiangtao Gou
#' @author Fengqing Zhang
#' @references
#' Gou, J., Chang, Y., Li, T., and Zhang, F. (2025). Improved trimmed weighted Hochberg procedures with two endpoints and sample size optimization. Technical Report.
#' @examples
#' rrr <- 2
#' alpha <- 0.025
#' k <- 0.6761
#' ninterval <- c(2, 1000)
#' betavec <- c(0.05, 0.15)
#' rho <- 0.4
#' maturity <- c(0.65, 0.70)
#' psivec <- c(0.67, 0.73)
#' thetavec <- log(psivec)
#' deltavec <- (-thetavec)*sqrt(rrr)/(1+rrr)
#' result <- optsamplesize_wHolmpm(alpha = alpha, betavec = betavec,
#' deltavec = deltavec , rho = rho,
#' maturity = maturity, ninterval = ninterval)
#' result$nopt
optsamplesize_wHolmpm <- function (alpha, betavec, deltavec, rho, maturity, ninterval = c(2,2000), alphalist = seq(from = 0, to = alpha, by = 0.005)) {
  # R20241124e.R
  NNN <- length(alphalist)
  n1vec <- rep(NA, times = NNN)
  n2vec <- rep(NA, times = NNN)
  #
  for (iii in 1:NNN) {
    #
    alpha1 <- alphalist[iii]
    #
    find_n_result1 <- uniroot(f = wHolmTarget1m, interval = ninterval, tol = .Machine$double.eps^0.8, alpha1 = alpha1, alpha = alpha, beta1 = betavec[1], deltavec = deltavec, rho = rho, maturity = maturity)
    n_opt_1 <- find_n_result1$root
    n1vec[iii] <- n_opt_1
    #
    #
    find_n_result2 <- uniroot(f = wHolmTarget2m, interval = ninterval, tol = .Machine$double.eps^0.8, alpha1 = alpha1, alpha = alpha, beta2 = betavec[2], deltavec = deltavec, rho = rho, maturity = maturity)
    n_opt_2 <- find_n_result2$root
    n2vec[iii] <- n_opt_2
  }
  #
  values <- n1vec - n2vec
  x <- alphalist
  interpolate_zero(values, x)
  nloccont <- interpolate_zero(values, 1:NNN)
  nlocflr <- floor(nloccont)
  n1opt <- n1vec[nloccont] + (n1vec[nloccont+1] - n1vec[nloccont])*(nloccont - nlocflr)
  n2opt <- n2vec[nloccont] + (n2vec[nloccont+1] - n2vec[nloccont])*(nloccont - nlocflr)
  nopt <- (n1opt + n2opt)/2
  #
  return (list(nopt = nopt, n1opt = n1opt, n2opt = n2opt, alphalist = alphalist, n1vec = n1vec, n2vec = n2vec))
}