R/Rfun_tHpTarget2.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 trimmed or truncated Hochberg procedure
#'
#' @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
#'
#' @returns the difference between the achieved power and the desired power for rejecting H2 using the weighted trimmed or truncated Hochberg procedure
#' @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.
tHpTarget2 <- function (n, alpha1, alpha, beta2, deltavec, rho) {
  # tHpTarget1
  # tHpTarget2
  # Applied in 1124c
  sigma <- matrix(c(1, rho, rho, 1), nrow = 2)
  lower <- pmax(c( qnorm(1 - alpha) - deltavec[1]*sqrt(n), qnorm(1 - alpha) - deltavec[2]*sqrt(n) ), c(-1000, -1000))
  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)
  if (abs(alpha - alpha1) < 1e-15) {
    return (Part2 - 1 + beta2)
  }
  #
  lower <- pmax(c( qnorm(alpha1) - deltavec[1]*sqrt(n), qnorm(1 - alpha + alpha1) - deltavec[2]*sqrt(n) ), c(-1000, -1000))
  upper <- pmin(c(qnorm(1 - alpha) - deltavec[1]*sqrt(n) , 1000 ), c(1000, 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 - 1 + beta2)
}