Skip to content
Create a gist now

Instantly share code, notes, and snippets.

Prints a LaTeX table with numeric columns aligned on their decimal points. This function wraps the xtable and print.xtable functions in the xtable package so that numeric columns are aligned on their decimal place.
require(xtable)
#' Prints a LaTeX table with numeric columns aligned on their decimal points.
#'
#' This function wraps the \code{\link{xtable}} and \code{\link{print.xtable}}
#' functions in the \code{xtable} package so that numeric columns are aligned
#' on their decimal place.
#'
#' See \url{http://jason.bryer.org/posts/2013-01-04/xtable_with_aligned_decimals.html}
#' for more information.
#'
#' @author Jason Bryer <jason@@bryer.org>
#' @param x a data frame to create a LaTeX table from.
#' @param cols a numeric vector indicating which columns should be aligned on
#' decimal points. It defaults to all columns of type numeric.
#' @param colAlignment named character vector where each element name corresponds to a
# column name and the value is the LaTeX alignment (i.e. l, r, or c).
#' @param tocharFun the function used to convert the numeric vecotr to a character
#' vector. This defaults to \code{\link{prettyNum}}, but other possible
#' options are \code{\link{as.character}}, \code{\link{format}},
#' \code{\link{formatC}}, or some other custom function.
#' @param ... other parameters passed to \code{tocharFun}, \code{\link{xtable}},
#' and \code{\link{print.xtable}}.
#' @seealso xtable
#' @export
xtable.decimal <- function(x,
cols=which(lapply(x, class) == 'numeric'),
colAlignment,
tocharFun=prettyNum,
...) {
splitCol <- function(x, ...) {
s <- strsplit(tocharFun(x, ...), split='.', fixed=TRUE)
right <- sapply(s, FUN=function(x) { ifelse(length(x) == 2, x[2], '0') })
left <- sapply(s, FUN=function(x) { x[1] })
data.frame(left=left, right=right, stringsAsFactors=FALSE)
}
cols <- cols[order(cols, decreasing=TRUE)]
colnames <- names(x)
for(i in cols) {
if(i == 1) {
tmp <- cbind(splitCol(x[,1], ...), x[,2:ncol(x)])
names(tmp)[1:2] <- paste(names(tmp)[1], c('left','right'), sep='.')
names(tmp)[3:ncol(x)] <- names(x)[2:ncol(x)]
x <- tmp
} else if(i == ncol(x)) {
tmp <- cbind(x[,1:(ncol(x)-1)], splitCol(x[,ncol(x)], ...))
names(tmp)[1:(ncol(tmp)-2)] <- names(x)[1:(ncol(x)-1)]
names(tmp)[(ncol(tmp)-1):ncol(tmp)] <- paste(names(x)[ncol(x)],
c('left','right'), sep='.')
x <- tmp
} else {
tmp <- cbind(x[,1:(i-1)], splitCol(x[,i], ...), x[,(i+1):ncol(x)])
names(tmp)[1:(i-1)] <- names(x)[1:(i-1)]
names(tmp)[i:(i+1)] <- paste(names(x)[i], c('left','right'), sep='.')
names(tmp)[(i+2):ncol(tmp)] <- names(x)[(i+1):ncol(x)]
x <- tmp
}
}
colnames[cols] <- paste('\\multicolumn{2}{c}{', colnames[cols], '}', sep='')
colnames <- paste(colnames, collapse=' & ')
addtorow <- list()
addtorow$pos <- list()
addtorow$pos[[1]] <- c(0)
addtorow$command <- paste( colnames, ' \\\\ ', sep='')
align <- rep('l', ncol(x))
if(!missing(colAlignment)) {
for(i in seq_along(colAlignment)) {
align[names(x) == names(colAlignment)[i]] <- colAlignment[i]
}
}
align[grep('.left$', names(x), perl=TRUE)] <- 'r@{.}'
align <- c('l', align) #Add an alignment for row names
xtab <- xtable(x, align=align, ...)
print(xtab, add.to.row=addtorow, include.rownames=FALSE, include.colnames=FALSE, ...)
}
@jonathan-g

This is a great function. Thanks for posting it. But I had a few problems, and suggest some fixes:

Errors from where xtable.decimal calls splitCol, which then calls tocharFun (e.g., prettyNum):

Error in vapply(x, format, "", big.mark = big.mark, big.interval = big.interval,  : 
  values must be length 1,
 but FUN(X[[1]]) result is length 2

6 vapply(x, format, "", big.mark = big.mark, big.interval = big.interval, 
    small.mark = small.mark, small.interval = small.interval, 
    decimal.mark = decimal.mark, zero.print = zero.print, drop0trailing = drop0trailing, 
    ...) 
5 tocharFun(x, ...) 
4 strsplit(tocharFun(x, ...), split = ".", fixed = TRUE) at xtable_decimal.R#32
3 splitCol(x[, ncol(x)], ...) 
2 cbind(x[, 1:(ncol(x) - 1)], splitCol(x[, ncol(x)], ...)) at xtable_decimal.R#47
1 xtable.decimal(t) 

I can fix this by changing line 32 to

s <- strsplit(tocharFun(unlist(x), ...), split='.', fixed=TRUE)

And if I use a "caption" argument, it messes up print.xtable because of partial matching, so I replace line 79 with

  args <- list(...)
  args <- args[names(args) != 'caption']
  do.call(print, c(list(xtab, add.to.row=addtorow, include.rownames=FALSE, include.colnames=FALSE), args))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.