#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.