R/s.itrtest.R

In kdoub5ha/mvITR: Discovery of risk controlled individualized treatment rules (ITRs)

#' @title Estimates value for survival data (currently experimental)
#' 
#' @description This function is used inside the rcDT construction functions.  
#' 
#' @param dat dataset being assessed 
#' @param z new (alternative) treatment assignment in the splitting procedure.  
#' @param n0 minimum number of observations needed to make a split. 
#' @param aug logical indicator for AIPWE estimation (TRUE) or IPWE estimation (FALSE).
#' @return ITR value from the new treatment assignments
#' @examples 
#' dat <- gdataM(n=1000, depth=2, beta1=3, beta2=1)
#' # Assign every other patient to treatment
#' z <- rep(c(0,1), nrow(dat)/2)
#' # IPWE value
#' itrtest(dat, z, 5, FALSE)
#' # AIPWE value
#' itrtest(dat, z, 5, TRUE)
#' @export



s.itrtest <- function(dat, z, n0, aug){
  y <- dat$y
  trt <- dat$trt
  prtx <- dat$prtx
  status <- dat$status
  KM.cens <- dat$KM.cens

  if(aug){
    if(all(sum(trt==1) > 0, sum(trt==0) > 0)){
      m1 <- mean(y[trt==1])
      m0 <- mean(y[trt==0])
    }
  }
  
  itr <- NA
  n <- nrow(dat)
  
  if (length(y)!=length(z)) stop("the vector z must have the same length as data.")
  
  if(all(sum(trt == 1) > 0, sum(trt == 0) > 0)){
    if(!aug){
      itr.num <- mean(trt*y*z*status/(prtx*KM.cens)+(1-trt)*y*(1-z)*status/((1-prtx)*(KM.cens)))
      # itr.den <- mean(trt*z*status/(prtx*KM.cens)+(1-trt)*(1-z)*status/((1-prtx)*(KM.cens)))
      # itr <- itr.num/itr.den
      itr <- itr.num
    }

    # ===========================================================
    # Augmentation not supported yet
    # ===========================================================
    
    if(aug){
      stop("Augmentation not supported yet")
    #   first <- (trt*z+(1-trt)*(1-z))*y/(prtx*trt+(1-prtx)*(1-trt))
    #   second <- (((trt*z+(1-trt)*(1-z)) - (prtx*trt+(1-prtx)*(1-trt)))/((prtx*trt+(1-prtx)*(1-trt))))*(m1*z+m0*(1-z))
    #   itr <- mean(first-second)
     }
  }
  return(round(itr,8))
}