R/R_targetLam.R

In cobenrich: Using Multiple Continuous Biomarkers for Patient Enrichment in Two-Stage Clinical Designs

#' Find the difference between the standardized average subpopulation treatment effect and the desired one
#'
#' @param z2 the standardized biomarker value of the second biomarker
#' @param kkk the researchers' weighting preference between the two biomarkers
#' @param muminusmu0 a number of the difference between the mean of outcome and the minimal clinically important treatment effect
#' @param kappa a number of the correlation coefficient between two biomarkers
#' @param rhovec a numeric vector of two correlation coefficients between the output and two biomarkers
#' @param sigma a number of the standard deviation of outcome
#' @param cLam the desired standardized average subpopulation treatment effect
#'
#' @returns the difference between the standardized average subpopulation treatment effect and the desired one
#' @export
#' @importFrom tmvtnorm mtmvnorm
#'
targetLam <- function(z2, kkk, muminusmu0, kappa, rhovec, sigma, cLam) {
  #
  corrmat <- matrix(c(1, kappa, kappa, 1), 2, 2)
  #
  z1 <- stats::qnorm(p = kkk * stats::pnorm(q = z2, lower.tail = FALSE), lower.tail = FALSE)
  #
  z1z2 <- c(z1, z2)
  #
  hfunrslt <- tmvtnorm::mtmvnorm(mean = c(0, 0),
                                 sigma = corrmat,
                                 lower = z1z2,
                                 upper = c(Inf, Inf),
                                 doComputeVariance=TRUE)
  h10 <- hfunrslt$tmean[1]
  h01 <- hfunrslt$tmean[2]
  h20 <- hfunrslt$tvar[1,1] + (hfunrslt$tmean[1])^2
  h02 <- hfunrslt$tvar[2,2] + (hfunrslt$tmean[2])^2
  h11 <- hfunrslt$tvar[1,2] + hfunrslt$tmean[1] * hfunrslt$tmean[2]
  #
  cVar <- sigma^2/(1-kappa^2)^2*( 2*(rhovec[1] - kappa*rhovec[2])*(rhovec[2] - kappa*rhovec[1])*(h11 - h10*h01) + (rhovec[1] - kappa*rhovec[2])^2*(h20 - h10^2) + (rhovec[2] - kappa*rhovec[1])^2*(h02 - h01^2) ) + sigma^2*(1 - (rhovec[1]^2 + rhovec[2]^2 - 2*kappa*rhovec[1]*rhovec[2])/(1-kappa^2))
  #
  delta <- muminusmu0 + sigma/(1-kappa^2)*((rhovec[1] - kappa*rhovec[2])*h10  + (rhovec[2] - kappa*rhovec[1])*h01)
  #
  lambda <- delta/sqrt(cVar)
  #
  return (lambda - cLam)
}