R/ps.balance.matched.pscore.R

In nonrandom: Stratification and matching by the propensity score

## ###############################################################
## A function for checking the balance in covariate distribution
## between treatment groups if class of object is 'matched.pscore'
## ###############################################################
ps.balance.matched.pscore <- function(object,
                                      sel           = NULL,
                                      treat         = NULL,
                                      stratum.index = NULL,
                                      match.index   = NULL,
                                      method        = "classical",
                                      cat.levels    = 2,
                                      alpha         = 5,
                                      equal         = TRUE)
{
  ## #################
  ## Check match.index
  if (is.null(match.index)){
    d1 <- object$data
    d2 <- object$data.matched
 
    d1[,"match.strata"] <- rep(1,nrow(d1))  ## unmatched
    d2[,"match.strata"] <- rep(2,nrow(d2))  ## matched
  
    data <- (rbind(d1,d2))
    data$match.strata <- as.factor(data$match.strata)

    match.index <- data$match.strata
    name.match.index <- "match.strata"
    
  }else{
    if (is.character(match.index) | is.numeric(match.index)){
      if (is.character(match.index)){      

        A <- find.strata(data   = object$data,
                         strata = match.index,
                         match  = TRUE)

        d1 <- object$data             ## A[[1]] contains match index
        d2 <- object$data[A[[1]]>0,]  ## A[[1]]>0 : matched obs

        d1[,"match.strata"] <- rep(1,nrow(d1))  ## unmatched
        d2[,"match.strata"] <- rep(2,nrow(d2))  ## matched
        
        data <- (rbind(d1,d2))
        data$match.strata <- as.factor(data$match.strata)

        match.index <- data$match.strata
        name.match.index <- A[[2]]
        
      }else{

        A <- find.strata(data   = object$data,
                         strata = match.index,
                         match  = TRUE)    

        d1 <- object$data
        d2 <- object$data[A[[1]]>0,]  ## A[[1]]>0 : matched obs

        d1[,"match.strata"] <- rep(1,nrow(d1))  ## unmatched
        d2[,"match.strata"] <- rep(2,nrow(d2))  ## matched
        
        data <- (rbind(d1,d2))
        data$match.strata <- as.factor(data$match.strata)

        match.index <- data$match.strata
        name.match.index <- A[[2]]
        
      }
    }else{
      stop("Argument 'match.index' must be numeric or a string.")
    } 
  }

  ## ########
  ## find sel
  if(is.null(sel)){
    sel <- data[,-which(c(names(data)==name.match.index))]
  }else{
    if (is.data.frame(sel)){
      sel <- data[, names(sel)]
    }else{
      sel <- find.sel(data, sel)
    }
  }
  
  ## ##########
  ## find treat
  if (is.null(treat)){   
    name.treat <- object$name.treat
    treat      <- data[,name.treat]
  }else{
    if (is.character(treat) | is.numeric(treat)){
      A <- find.treat(data  = data,
                      treat = treat)
      treat      <- A[[1]]
      name.treat <- A[[2]]
    }else{
      stop("Argument 'treat' must be either numeric or a string.")
    }
  } 
  if (any(names(sel)==name.treat))
    warning("Argmuent 'sel' contains argument 'treat'.")

  ## ###########
  ## Check alpha
  if (!is.numeric(alpha)){
    stop("Argument 'alpha' must be numeric.")
  }else{
    if (alpha < 1 | alpha > 100){
      stop("Argument 'alpha' must be in [1,100].")
    }
  }
      
  ## ################
  ## selection method
  if (is.character(method) | is.numeric(method)){   
      bal.test <- find.balance.method(sel        = sel,
                                      treat      = treat,
                                      index      = match.index,
                                      method     = method,
                                      cat.levels = cat.levels,
                                      match.T    = TRUE,
                                      alpha      = alpha,
                                      equal      = equal)      
    }

  object$data.matched      <- d2[,-which(c(names(d2)=="match.strata"))]
  object$bal.test          <- bal.test
  object$treat             <- treat
  object$name.treat        <- name.treat
  object$match.index       <- match.index
  object$name.match.index  <- name.match.index

  class(object) <- c("bal.matched.pscore",
                     class(object)[class(object)!="bal.matched.pscore"])
  
  return(object)
  
}