R/Rfun_wHolmTargetDiffM2.R

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

#' Find the difference between the achieved power and the desired power for rejecting H2 using the weighted Holm procedure with allowance for different data maturities
#'
#' @param n the sample size
#' @param alpha1 the weighted significance levels assigned to H1
#' @param alpha the significance level
#' @param beta2 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
#'
#' @returns the difference between the achieved power and the desired power for rejecting H2
#' @export
#'
#' @importFrom mvtnorm pmvnorm
#' @importFrom mvtnorm Miwa
#' @author Jiangtao Gou
#' @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.
wHolmTarget2m <- function (n, alpha1, alpha, beta2, deltavec, rho,maturity) {
  # Applied in R20241124e.R
  # no pmax/pmin functions
  sigma <- matrix(c(1, rho, rho, 1), nrow = 2)
  lower <- c( qnorm(1 - alpha) - deltavec[1]*sqrt(maturity[1]*n), qnorm(1 - alpha) - deltavec[2]*sqrt(maturity[2]*n) )
  upper <- c(1000, 1000)
  Part2Rslt <- mvtnorm::pmvnorm(lower = lower, upper = upper, mean = rep(0, 2), sigma = sigma, algorithm = mvtnorm::Miwa(steps = 128))
  Part2 <- as.numeric(Part2Rslt)
  #
  lower <- c( qnorm(1 - alpha) - deltavec[1]*sqrt(maturity[1]*n), qnorm(1 - alpha) - deltavec[2]*sqrt(maturity[2]*n) )
  upper <- c( qnorm(1 - alpha1) - deltavec[1]*sqrt(maturity[1]*n), qnorm(1 - alpha + alpha1) - deltavec[2]*sqrt(maturity[2]*n) )
  #
  Part3Rslt <- mvtnorm::pmvnorm(lower = lower, upper = upper, mean = rep(0, 2), sigma = sigma, algorithm = mvtnorm::Miwa(steps = 128))
  Part3 <- as.numeric(Part3Rslt)
  #
  if (abs(alpha - alpha1) < 1e-15) {
    return (Part2 - Part3 - 1 + beta2)
  }
  #
  lower <- c( -1000, qnorm(1 - alpha + alpha1) - deltavec[2]*sqrt(maturity[2]*n) )
  upper <- c(qnorm(1 - alpha) - deltavec[1]*sqrt(maturity[1]*n) , 1000 )
  Part1Rslt <- mvtnorm::pmvnorm(lower = lower, upper = upper, mean = rep(0, 2), sigma = sigma, algorithm = mvtnorm::Miwa(steps = 128))
  Part1 <- as.numeric(Part1Rslt)
  return (Part1 + Part2 - Part3 - 1 + beta2)
}