R/extractModelInfo.R

In enaY15/TabulationAutomation: Auomated analysis and tabulation of results

#' Extract Model Info
#'
#' @param source Name of vector/list/etc. that contains the model information
#' @param what What do you want to extract?
#'                vectorElements = elements of vectors in a list whose own elements has standard endings
#'                mplusVariables = individual variables in a string of MPlus syntax
#'                       e.g., "a1 b2-b4 c3" becomes c("a1", "b2", "b3", "b4", "c3")
#' @param topElementsSharedEnding Pattern for an ending for the top level of the list
#'         (e.g., if all list elements are named in the form of
#'         XXXXX_outcomes, then input "_outcomes")
#'
#' @return
#' @export
extractModelInfo <- function(source, what = c("vectorElements", "mplusVariables"),
                             topElementsSharedEnding = NULL) {

  require(rlist)

  splitIndString <- function(indString) {
    spaceSplit <- strsplit(indString, '[[:blank:]]+', perl = TRUE)[[1]]
    # e.g. source = "d1 d1-d24      d53-d8754  d52" -> vector c("d1", "d1-d24", "d53-d8754", "d52" )
    spreadVec <- c()
    for (i in 1:length(spaceSplit)) {
      if (grepl('-', spaceSplit[i])) {
        expr <- gsub(spaceSplit[i], pattern = "([a-zA-z]+)([0-9]+)-[a-zA-z]+([0-9]+)",
                     # <letters...letters> <#s until dash> <-> <letters...letters> <rest of #s>
                     replacement = "'\\1', c(\\2:\\3)")
        eval(parse(text = paste0('spreadVec <- c(spreadVec, paste0(', expr, '))')))
      } else {
        spreadVec <- c(spreadVec, spaceSplit[i])
      }
    }
    return(spreadVec)
  }

  if (what == "vectorElements") {
    if (is.list(source)) {
      droppedFromName <- paste0(topElementsSharedEnding, '.*') # regex pattern to ID anything preceding topElementsSharedEnding
      unique(gsub(droppedFromName, '', unlist(outcomesList)))
      return(gsub(x = unlist(source),
                  pattern = paste0(".*", topElementsSharedEnding, "."),
                  replacement = ''))
    }
  }


  if (what == "mplusVariables") {

    if (is.list(source)) {
      listModelSpreadList <- vector(mode = "list", length = length(source))
      names(listModelSpreadList) <- names(source)

      for (m in 1:length(source)) { # for every list element
        modelSpreadList <- vector(mode = "list", length = length(source[[m]]))
        names(modelSpreadList) <- names(source[[m]])

        for (f in 1:length(source[[m]])) { # for every vector element
          modelSpreadList[[f]] <- splitIndString(source[[m]][[f]])
        }

        listModelSpreadList[[m]] <- modelSpreadList
      }

      return(listModelSpreadList) # list of model-specific list of factor-specific vectors of indicators

    } else {

      if (length(source) > 1) {
        # (e.g. if only splitting a vector of strings corresponding to each factor for one model)
        modelSpreadList <- vector(mode = "list")
        for (f in 1:length(source)) {
          # for every vector element
          factorSpreadVec <- splitIndString(source[f])
          modelSpreadList <- list.append(modelSpreadList, factorSpreadVec)
        }
        names(modelSpreadList) <- names(source)
        return(modelSpreadList)
      } else { splitIndString(source) }
    }

  }

}