Skip to content

Instantly share code, notes, and snippets.

@jbryer
Last active November 21, 2020 19:51
Show Gist options
  • Star 3 You must be signed in to star a gist
  • Fork 3 You must be signed in to fork a gist
  • Save jbryer/4458674 to your computer and use it in GitHub Desktop.
Save jbryer/4458674 to your computer and use it in GitHub Desktop.
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
Copy link

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