R/object.R

In aVirtualTwins: Adaptation of Virtual Twins Method from Jared Foster

# VT.OBJECT ---------------------------------------------------------------

#' VT.object
#' 
#' A Reference Class to deal with RCT dataset
#' 
#' Currently working with binary response only. Continous will come, one day. 
#' Two-levels treatment only as well.
#' 
#' \code{data} field should be as described, however if virtual twins won't used
#' interactions, there is no need to transform factors. See
#' \link{formatRCTDataset} for more details.
#' 
#' 
#' @field data Data.frame with format: \eqn{Y,T,X_{1}, \ldots, X_{p}}. Y must be
#'   two levels factor if type is binary. T must be numeric or integer.
#' @field screening Logical, set to \code{FALSE} Set to \code{TRUE} to use
#'   \code{varimp} in trees computation.
#' @field varimp Character vector of important variables to use in trees 
#'   computation.
#' @field delta Numeric representing the difference of incidence between 
#'   treatments.
#' @field type Character : binary or continous. Only binary is currently 
#'   available.
#'   
#' @import methods
#'   
#' @name VT.object
#'   
#' @export VT.object
#'   
#' @examples
#' \dontrun{
#' # Default use :
#' vt.o <- VT.object$new(data = my.rct.dataset)
#' 
#' # Getting data
#' head(vt.o$data)
#' 
#' # or getting predictor with interactions
#' vt.o$getX(interactions = T)
#' 
#' # or getting X|T = 1
#' vt.o$getX(trt = 1)
#' 
#' # or getting Y|T = 0
#' vt.o$getY(0)
#' 
#' # Print incidences
#' vt.o$getIncidences()
#' }
#' 
#' @seealso \code{\link{VT.difft}}
#'   
VT.object <- setRefClass(
  Class = "VT.object",
  
  fields = list(
    data = "data.frame",
    screening = "logical",
    varimp = "character",
    delta = "numeric",
    type = "character"
  ),
  
  methods = list(
    initialize = function(screening = F, type = "binary", ...){
      
      .self$screening <- screening
      
      .self$type <- type
            
      .self$initFields(...)
    },
    
    getFormula = function(){
      "Return formula : Y~T+X1+...+Xp. Usefull for cforest function."
      return(as.formula(paste(colnames(.self$data)[1], ".", sep = "~")))
    },
    
    getX = function(interactions = T, trt = NULL){
      "Return predictors (T,X,X*T,X*(1-T)). Or (T,X) if interactions is FALSE.
        If trt is not NULL, return predictors for T = trt"
      # predictors if trt is not null
      if(!is.null(trt)) return(.self$data[.self$data[,2] == trt, -c(1,2)])
      # predictor*treatment no matter trt if interactions is TRUE
      if(interactions == T) return(.self$getXwithInt())
      # predictors
      return(.self$data[, -1])
    },
    
    getY = function(trt = NULL){
      "Return outcome. If trt is not NULL, return outcome for T = trt."
      if(is.null(trt)) return(.self$data[, 1])
      return(.self$data[.self$data[,2] == trt, 1])
    },
    
    getXwithInt = function(){
      "Return predictors with interactions. Use VT.object::getX(interactions = T) instead."
      tmp <- .self$data[, -c(1,2)]
      return(data.frame(cbind(.self$data[,-1], tmp*.self$data[, 2], tmp*(1 - .self$data[, 2]))))
    },
    
    getData = function(interactions = F){
      "Return dataset. If interactions is set to T, return data with treatement interactions"
      if(!isTRUE(interactions))
        return(.self$data)
      else{
        data.int <- cbind(.self$data[, 1], .self$getX(T))
        colnames(data.int)[1] <- colnames(.self$data)[1]
        return(data.int)
      }
    },
    
    switchTreatment = function(){
      "Switch treatment value."
      cl <- class(.self$data[, 2])
      # Treatments must be numeric or integer and binary
      .self$data[, 2] <- 1 - .self$data[, 2]
      # keep original class for treatment
      if(cl == "integer"){
        .self$data[, 2] <- as.integer(.self$data[, 2])
      }else{
        .self$data[, 2] <- as.numeric(.self$data[, 2])
      }
      return(TRUE)
    },
    
    computeDelta = function(){
      "Compute delta value."
      if(.self$type == "binary"){
        .self$delta <- sum((as.numeric(.self$data[, 1]) - 1)*(.self$data[, 2])) / sum(.self$data[, 2]) -
          sum((as.numeric(.self$data[, 1]) - 1)*(1 - .self$data[, 2])) / sum(1 - .self$data[, 2])
        
        return(.self$delta)
      }else{
        stop("Error : type is not Binary")  
      }
    },
    
    # Hack of VT.incidences
    getIncidences = function(rule = NULL){
      "Return incidence table of data if rule set to NULL. Otherwise return incidence for the rule."
      hack.difft <- VT.difft$new(.self)
      if(is.null(rule))  
        return(vt.getIncidence(.self$data))
      else
        return(VT.incidences(hack.difft, rule, F))
    }
  )
)