R/texify.R

In bdempe18/rchitex: Creates Nicely Format Text and Latex Tables

summary2tex <- function(stats_mat, note='') {
  # TODO Ensure that path is a valid .tex path
  preamble <- gen_preamble('Summary Statistics', ncol(stats_mat))
  col_names <- paste0(lapply(colnames(stats_mat),
                             function(x) paste0('\\multicolumn{1}{c}{',x,'} & ')),
                      collapse='')
  col_names <- paste0( 'Statistic & ', substr(col_names,
                                              1, nchar(col_names)-3),
                       '\\\\\n\\hline\\\\[-1.8ex]')

  col_len <- apply(stats_mat, 2, function(x) max(nchar(x)))
  body <- paste0(lapply(rownames(stats_mat), function(r) {
    paste0(escaped(r), ' & ',
           paste0(Map(function(el,d)  paste0(format(el, nsmall=max(d-1,0)), collapse=''),
                      stats_mat[r,], col_len), collapse=' & '),
           '\\\\',collapse='')
  }))
  post <- paste0('\\hline \\\\[-1.8ex] \n \\textit{Note:}', note,
                 '\n\\end{tabular}')
  paste0(preamble, col_names, paste0(body, collapse=''), post, collapse='')
}

to_tex_m <- function(reg_data, max_precision, fit_char, reporter, sig = list(),
                     path = NA, note='', title='', idn = NULL, sig_levels, dn,
                     grouped_label=NULL) {
  n_mods <- length(reg_data[[1]])
  col_names <- paste0(dn, sep=' & ', collapse='')
  col_names <- substr(col_names, 1, nchar(col_names) - 3)

  # grouped labels
  if (!is.null(grouped_label)) {
    gl_vector <- group_labels(grouped_label, n_mods, missing=1)
    temp <- names(gl_vector)
    gl_vector <- as.numeric(gl_vector)
    names(gl_vector) <- temp

    # labels
    gl <- lapply(names(gl_vector), function(lab) {
      if (is.na(lab)) return(' & ')

      paste0('\\multicolumn{', gl_vector[[lab]],'}{c}{\\textit{',
             lab,':}}\n & ')
    })
    gl <- paste0('&', paste0(gl, collapse=''), sep = '', collapse='')
    gl <- substr(gl, 1, nchar(gl) - 3)
    gl <-  paste0(gl, '\\\\\n', collapse='')

    # underlined portion
    dashes <- lapply(seq_along(gl_vector), function(i) {
      if (is.na(names(gl_vector)[i])) return('')
      lab <- names(gl_vector)[i]
      paste0('\\cline{', head(grouped_label[[lab]]+1, n=1),
             '-', tail(grouped_label[[lab]]+1, n=1), '}',
             collapse = '')
    })
    gl <- paste0(gl, paste0(dashes, collapse=''), sep='\n', collapse='')

  } else gl <- ''

  # Preamble
  preamble <- paste0(gen_preamble(title, n_mods),
                     gl,
                     '\\\\[-1.8ex] & ',
                     col_names, '\\\\',
                     '\\hline \\\\[-1.8ex]\n', sep='')

  ## Estimation
  body <- unlist(lapply(names(idn), function(r) {
    ests <- ifelse(is.na(reg_data[[r]]), '', paste0(reg_data[[r]],
                                                 '$^{', sig[[r]], '}$'))
    errs <- ifelse(is.na(reg_data[[r]]), '', paste('(', reporter[[r]], ')',
                                                   sep=''))
    paste(escaped(idn[[r]]), ' & ', paste0(ests, collapse=' & '), '\\\\\n',
          ' & ', paste0(errs, collapse='&'), '\\\\\n',
          strrep(' & ', n_mods), '\\\\\n')
  }))



  fit <- unlist(lapply(names(fit_char), function(fc) {
    paste(paste0(c(fc, fit_char[[fc]]),collapse = ' & '),'\\\\', collapse='')
  }))

  p_post <- unlist(lapply(names(sig_levels), function(s) {
    paste0('$^{', s, '}$p$<$', sig_levels[[s]], ' ', collapse='')
  }))

  fit <- paste('\\hline \\\\[-1.8ex]\n', paste(fit, collapse=''), collapse='')
  post <- paste0('\\hline\\hline \\\\[-1.8ex] \n \\textit{Note:', note,
                 '} & \\multicolumn{', n_mods,'}{r}{',
                 paste0(p_post, collapse=''), '} \\\\\n',
                 '\\end{tabular}', collapse='')

  paste0(preamble, paste0(body, collapse=''), fit, post, collapse='')

}

gen_table_header <- function(tex, cap, lbl) {
  c('\\begin{table}[!htb]\n',
        '\t\\centering\n',
        '\t\\caption{', cap, '}\n',
        '\t\\label{', lbl, '}\n',
        tex,
        '\\end{table}\n',
        sep = '')
}

escaped <- function(text) {
  gsub('_', '\\\\_', text)
}

gen_land_table <- function(tex, cap, lbl) {
  c('\\begin{landscape}', gen_table_header(tex, cap=cap, lbl=lbl), '\\end{landscape}')
}

gen_preamble <- function(title, n_cols) {
  paste0('\\begin{tabular}{@{\\extracolsep{5pt}}l ',
         strrep('c',n_cols),'}',
         '\\\\[-1.8ex]\\hline\\hline \\\\[-1.8ex]\n')
}

table_wrap <- function(tex, caption='Table', label='label') {
  paste0('\\begin{table}[!htb]\n',
         '\t\\centering\n',
         '\t\\caption{', caption, '}\n',
         '\t\\label{', label, '}\n',
         tex,
         '\\end{table}\n', collapse='')
}

lan_wrap <- function(tex) {
  message('Latex table has been landscaped. `lscape` package must be sourced in Latex preamble.')
  paste0('\\begin{landscape}\n',tex,'\\end{landscape}', collapse='')
}

header_wrap <- function(tex) {
  paste0('% Table generated by rchitex by Ben Dempe (2019) \n', tex)
}