R/parseBranchingLogic.R

In nutterb/redcapAPI: Interface to 'REDCap'

#' @name parseBranchingLogic
#' @export parseBranchingLogic
#' 
#' @title Parse Branching Logic
#' @description Branching logic from the REDCap Data Dictionary is parsed into
#'   R Code and returned as expressions.  These can be evaluated if desired
#'   and allow the user to determine if missing values are truly missing or
#'   not required because the branching logic prevented the variable from being
#'   presented.
#'   
#' @param l A vector of REDCap branching logic statements.  These are usually
#'   passed as the vector `meta_data$branching_logic`.  
#'   
#' @details For a study, I was asked to identify which subjects had missing 
#'   values so that remaining data could be collected.  The initial pass of 
#'   `is.na` produced a lot of subjects missing values where there was no
#'   need to collect data because they did not qualify for some variables in 
#'   the branching logic.  Parsing the logic allowed me to determine which 
#'   values we expected to be missing and narrow the search to just those 
#'   subjects with legitimately missing values.
#'   
#'   The utility of this function is limited to simple logic where all of the
#'   data exist within the same row. Any complex statements using events 
#'   will result in a failure. 
#'   
#' @return Returns a list of unevaluated expressions.
#' 
#' @seealso [missingSummary()]
#' 
#' @examples
#' \dontrun{
#' parseBranchingLogic("[age] > 30")
#' parseBranchingLogic("[dropdown_test] = 'd'")
#' parseBranchingLogic(c("[age] > 30", 
#'                       "[dropdown_test] = 'd'"))
#' }
#' 

parseBranchingLogic <- function(l){
  l <- gsub("\\n", " ", l)
  l <- gsub(" or ", " | ", l, ignore.case = TRUE)
  l <- gsub(" and ", " & ", l, ignore.case = TRUE)
  l <- gsub("([a-z,0-9,_])\\((?<=\\()(.*?)(?=\\))\\)", 
            "\\1___\\L\\2", 
            l, 
            perl = TRUE)
  l <- gsub("([[]|[]])", "", l)
  l <- gsub("[=]", " == ", l)
  l <- gsub("[!] [=]", " !", l)
  l <- gsub("[<] [=]", " <", l)
  l <- gsub("[>] [=]", " >", l)
  l <- gsub("[<][>]", "!=", l)
  lapply(l, function(x) ifelse(x=="", NA, parse(text=x)))
}