R/iMatchIt.R

In ncarchedi/iMatchIt: An interactive wrapper for the MatchIt R package

#' Run iMatchIt decision tree
#' 
#' @param digraph Optional, digraph to run
#' @import MatchIt
#' @export
go <- function(digraph=NULL) {
  removeTaskCallback("listener")
  e <- new.env(globalenv())
  cb <- function(expr, val, ok, vis, data=e){
    e$expr <- expr
    e$val <- val
    e$ok <- ok
    e$vis <- vis
    return(handler(e))
  }
  addTaskCallback(cb, name="listener")
  e$digraph <- digraph
  
  pretty_out("Welcome to iMatchIt!\n\nI'm going to walk you through the process of selecting matched samples of your original treated and control groups with similar covariate distributions.\n\nPlease load your data into a new variable called `myData`.", skip_after=TRUE)
  
  invisible()
}

# Sets everything up then runs the decision tree
handler <- function(e) {
  if(!exists("paused", e)) {
    e$paused <- FALSE
  }
  if(!e$paused && identical(e$expr, quote(pause()))) {
    pretty_out("Pausing...")
    e$paused <- TRUE
  }
  if(e$paused && identical(e$expr, quote(resume()))) {
    pretty_out("Resuming...")
    e$paused <- FALSE
  }
  if(!e$paused && loadsData(e)) {
    ready <- setup(e)
    if(!ready) return(FALSE)
    if(is.null(e$digraph)) {
      d <- read_digraph(system.file("firstSteps.yaml", package="iMatchIt"))
      runDigraph(d, e)
    } else {
      runDigraph(e$digraph, e)
    }
  }
  return(TRUE)
}

getTreatment <- function(e) {
  separate()
  pretty_out("Which of the following is your TREATMENT indicator variable?")
  tr <- select.list(e$allvars, graphics=FALSE)
  separate()
  pretty_out(paste0("Is the `", tr, "` variable coded 1 for treatment and 0 for controls?"))
  if(!yes()) {
    # TODO: More elegant fix for improper treatment coding
    stop("Please code your treatment variable appropriately and restart!")
  }
  tr
}

getOutcome <- function(e) {
  separate()
  pretty_out("Which of the following are OUTCOME variables, which should be EXCLUDED from the matching process?")
  vars <- setdiff(e$allvars, e$treat)
  select.list(vars, multiple=TRUE, graphics=FALSE)
}

getCovariates <- function(e) {
  separate()
  pretty_out("Which, if any, of the remaining variables do you wish to EXCLUDE from the matching process?")
  vars <- setdiff(e$allvars, c(e$treat, e$outcome))
  excl <- select.list(vars, multiple=TRUE, graphics=FALSE)
  setdiff(vars, excl)
}

setup <- function(e) {
  pretty_out("It looks like you've loaded your data. Are you ready to begin?")
  if(yes()) {
    e$data <- get("myData", globalenv())
    e$allvars <- names(e$data)
    e$treat <- getTreatment(e)
    e$outcome <- getOutcome(e)
    e$covar <- getCovariates(e)
    e$excl <- setdiff(e$allvars, c(e$treat, e$outcome, e$covar))
  } else {
    pretty_out("Goodbye!", skip_after=TRUE)
    return(FALSE)
  }
  return(TRUE)
}