R/combinedLaTeXtableR.R

In enaY15/TabulationAutomation: Auomated analysis and tabulation of results

#' Combined LaTeX Table Maker
#'
#' @param analysis Analysis that produced data for regression analyses: "cfa", "bf", or "lca"
#' @param outcomes Vector of formal object names of outcome variables
#' @param outcomeNameVector Vector of full "pretty" outcome names
#' @param modelPredictorNamesList Vector of names that represent models with different sets of predictors (IDs names of results matrices)
#' @param stars Whether to substitute stars for numerical p-values
#' @param stats Statistics of interest from results, e.g., c('Estimate', 'Std. Error', 'Pr(>|t|)')
#' @param statsNames Vector: Specify if want syntax output to have prettier names than ones native to results output
#' @param shortCaption Just outcome name as table title? TRUE/FALSE
#' @param basic Combine columns so stars and estimates in single column? TRUE/FALSE
#' @param multiOutcome Multiple outcomes in same table? TRUE/FALSE
#' @param outcomeAbbreviationNote For table note (e.g. 'SF-12 = Short Form Health Survey.')
#' @param n.roundDigits Number of digits to round to
#' @param minDecimals Minimum number of decimal places to retain (to line up, in case trailing .00)
#' @param outcomeSet Name for group of outcome variables
#'
#' @return
#' @export
combinedLaTeXtableR <- function (analysis, # e.g. cfa, bcfa, bf
                                 outcomes, # vector of formal object names of outcome variables
                                 outcomeSet, # name of set
                                 outcomeNameVector = NULL, # vector of full "pretty" outcome names
                                 modelPredictorNamesList, # vector of names that represent models with different sets of predictors (IDs names of results matrices)
                                 stars = TRUE, # whether to substitute stars for numerical p-values
                                 stats, # stats of interest from results
                                 statsNames = NULL, # if want syntax output to have prettier names than ones native to results output
                                 basic = TRUE, # if want to combine columns so stars and estimates in single column
                                 multiOutcome = TRUE,
                                 outcomeAbbreviationNote = NULL,
                                 minDecimals = 2,
                                 n.roundDigits = 2) { # if want to round numerical values in output

  require('R.utils')

#### Set Up ####
  ## Warnings
    if (basic == TRUE & stars == FALSE) stop('INCONGRUENT ARGUMENTS. Basic = TRUE must be used in conjunction with stars for p-values.')
  ## Fill in NULL arguments
    if (is.null(n.roundDigits)) n.roundDigits <- minDecimals # if not otherwise specified, make rounding correspond to specified minimum decimal places
    if (is.null(statsNames)) statsNames <- stats # If not otherwise specified, leave as original stats names
    if (is.null(outcomeNameVector)) outcomeNameVector <- outcomes

######

    if (analysis == 'cfa') analysisName <- 'CFA Model'
    if (analysis == 'bf') analysisName <- 'Bifactor Model'
    modelMatrices <- matrix(nrow = length(modelPredictorNamesList), ncol = length(outcomes))
    for (y in 1:length(outcomes)) {
      dv <- outcomes[y]
      for (m in 1:length(modelPredictorNamesList)) {
        modelMatrices[m, y] <- paste0(dv, '_', analysis, '_', as.character(names(modelPredictorNamesList)[m]))
      }
    }

## Construct text of the table note
  if (stars == TRUE) tableNote <- ' * p < .05 ** p < .01 *** p < .001.' else tableNote <- paste0('')
  if (analysis == 'cfa') tableNote <- paste0(tableNote, ' CFA = Confirmatory Factor Analysis.')
  if (analysis == 'bcfa') tableNote <- paste0(tableNote, '  BCFA = Bayesian Confirmatory Factor Analysis.')
  if (!is.null(outcomeAbbreviationNote)) tableNote <- paste0(tableNote, ' ', outcomeAbbreviationNote)

  # if (multiOutcome == TRUE) {
  #   for (m in 1:length(modelPredictorNamesList)) {
  #
  #   }
  # }

  matListoLists <- vector(mode = 'list', length = length(outcomes)) # list (elements = outcomes) containing lists of matrices (elements = models)
  names(matListoLists) <- outcomes

  for (y in 1:length(outcomes)) {

    outcomeVar <- outcomes[y]
    outcomeVarFullName <- outcomeNameVector[y]

## Make table title
    caption <- paste0('Results for ', outcomeSet, ' and PTSD ', toupper(analysis), ' Factors ')

    matList <- vector(mode = 'list', length = length(modelPredictorNamesList))
    names(matList) <- names(modelPredictorNamesList) # names of matrices = model names

      for (m in 1:length(modelPredictorNamesList)) {

        eval(parse(text = paste0('mat <- ', modelMatrices[m, y])))
        predictors <- modelPredictorNamesList[[m]] # names of model predictors (e.g. factors)
        matModelName <- modelMatrices[m, y]
        #matModelName <- sub(pattern = '.*_', x = matModelName, replacement = '')
        matModelName <- paste0(R.utils::capitalize(matModelName), ' Model')
        matModelName <- paste0('\\textbf{', matModelName, '}')
        mat <- mat[, which(colnames(mat) %in% stats)]
        colnames(mat)[colnames(mat) == 'Pr(>|t|)' | colnames(mat) == 'Pr(>|z|)'] <- 'p.val' # Change p value name so can more easily index
        statsClean <- gsub(x = stats, pattern = 'Pr.*', replacement = 'p.val') # Change p value name so can more easily index
        #statsClean <- gsub(x = stats, pattern = '.* Error', replacement = 'SE') # Change so can more easily index

        mat <- data.frame(mat)

        for (s in 1:length(stats)) {
          eval(parse(text = paste0('mat$', statsClean[s], '<- matrix(as.character(mat$', statsClean[s], '), nrow = dim(mat)[1])'))) # Convert to character from factor so can...
          eval(parse(text = paste0('mat$', statsClean[s], '<- matrix(as.numeric(mat$', statsClean[s], '), nrow = dim(mat)[1])'))) # ...convert to numeric
        }

  ## Round numbers in matrix
        colnames(mat) <- statsClean
        force(n.roundDigits) # force evaluation of n.roundDigits argument so can work with eval(parse(...))
        for (s in 1:length(statsClean)) {
          if (is.numeric(mat[, statsClean[s]])) {
            eval(parse(text = paste0('mat$', statsClean[s], ' <- format(round(mat$', statsClean[s], ', digits = n.roundDigits), nsmall = minDecimals)')))
          }
        }
        #colnames(mat) <- statsNames
        #rownames <- rownames(mat)
        #if (basic == TRUE) mat <- paste0(mat[, 1], mat[, 2])
        #mat <- as.matrix(mat)
        #dimnames(mat)[[1]] <- rownames
        #dimnames(mat)[[2]][1] <- 'Estimate'

        if (m == 1) headerBuildeR(caption = caption, mat = mat, outcomeVar = outcomeVar, analysis = analysis, stats = stats) ## Only write header for first model


        matList[[names(modelPredictorNamesList)[m]]] <- mat
        rownames(matList[[m]]) <- c('Intercept', predictors)

        #bodyBuildeR(mat = mat, matModelName = matModelName, predictors = rownames, multiOutcome = multiOutcome, outcomeNames = outcomeNameVector, stars = stars)
        #bodyBuildeR(mat = mat, matModelName = matModelName, predictors = rownames, multiOutcome = multiOutcome, outcomeNames = outcomeNameVector, stars = stars)

      }

      #options(browser())

      matListoLists[[outcomes[y]]] <- matList

      if (multiOutcome == FALSE) bodyBuildeR(matList = matList, multiOutcome = FALSE, stars = stars)

  }

  for (dv in 1:length(matListoLists)) {
    # make row names (i.e. predictors) a the new first column of the data sets in the list of results for each dv and model
    matListoLists[[dv]] <- lapply(matListoLists[[dv]], function(x) x <- data.frame(cbind((attributes(x)$row.names), x), stringsAsFactors=FALSE))
    # name column with predictors after name of model
    # for (m in 1:length(matListoLists[[dv]])) colnames(matListoLists[[dv]][[m]])[1] <- names(matListoLists[[dv]])[m]
    for (m in 1:length(matListoLists[[dv]])) colnames(matListoLists[[dv]][[m]])[1] <- 'Predictors'
    # # make column names into first row of data frames in list
    # matListoLists[[dv]] <- lapply(matListoLists[[dv]], function(x) x <- rbind(as.character(colnames(x)), x))
    # for (m in 1:length(matListoLists[[dv]])) {
    #   matListoLists[[dv]][[m]][1, 1] <- names(matListoLists[[dv]])[m] # b/c model name (1st colname wasn't showing up using first line for some reason)
    # }
  }
options(browser())
  if (multiOutcome == TRUE) bodyBuildeR(matListoLists = matListoLists, multiOutcome = multiOutcome, stars = stars, outcomeNames = outcomeNameVector)

  footerBuildeR(tableNote = tableNote)

}