From 87821eee826318c605491f4e77e9cdb0a8c2106b Mon Sep 17 00:00:00 2001 From: arnima Date: Fri, 10 Oct 2014 11:02:28 +0000 Subject: [PATCH] Proposal: new function autoformat() and xtable argument auto=TRUE/FALSE git-svn-id: svn://scm.r-forge.r-project.org/svnroot/xtable@66 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- pkg/DESCRIPTION | 4 +- pkg/NAMESPACE | 8 +- pkg/NEWS | 21 ++--- pkg/R/{formatHelpers.R => autoformat.R} | 7 ++ pkg/R/xtable.R | 93 +++++++++++++-------- pkg/man/{formatHelpers.Rd => autoformat.Rd} | 28 +++++-- pkg/man/table.attributes.Rd | 6 +- pkg/man/xtable.Rd | 19 +++-- pkg/vignettes/xtableGallery.Rnw | 21 ++++- 9 files changed, 133 insertions(+), 74 deletions(-) rename pkg/R/{formatHelpers.R => autoformat.R} (85%) rename pkg/man/{formatHelpers.Rd => autoformat.Rd} (72%) diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION index 902300c..429af94 100644 --- a/pkg/DESCRIPTION +++ b/pkg/DESCRIPTION @@ -1,6 +1,6 @@ Package: xtable -Version: 1.7-5 -Date: 2014/09/11 +Version: 1.8-0 +Date: 2014/10/10 Title: Export tables to LaTeX or HTML Author: David B. Dahl Maintainer: David Scott diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE index 69f9231..b864e28 100644 --- a/pkg/NAMESPACE +++ b/pkg/NAMESPACE @@ -1,15 +1,9 @@ - -# NAMESPACE work by Robert Gentleman -# in e-mail on July 30, 2007. -# -# Extended by C Roosen, 30/01/2012 - importFrom("utils", toLatex) export("caption<-", "caption", "label", "label<-", "align<-", "align", "digits<-", "digits", "display<-", "display", "xtable", "print.xtable", "toLatex.xtable", - "xalign", "xdigits", "xdisplay") + "autoformat", "xalign", "xdigits", "xdisplay") S3method("print", "xtable") S3method("toLatex", "xtable") diff --git a/pkg/NEWS b/pkg/NEWS index 86e0413..80f04cb 100644 --- a/pkg/NEWS +++ b/pkg/NEWS @@ -1,26 +1,17 @@ -1.7-5 (26-09-2015 NOT YET RELEASED TO CRAN) - - * xalign, xdigits, xdisplay from Arni Magnusson (arnima@hafro.is) - added along with help file. Feature request #5686. R code for - these functions is in formatHelpers.R and man page is called - formatHelpers.Rd. - * xtableGallery.snw removed and replaced with - xtableGallery.Rnw. Both vignettes now use knitr instead of Sweave. - * Section added to xtableGallery showing use of xalign, xdigits, and - xdisplay - +1.8-0 (NOT YET RELEASED TO CRAN) + * autoformat, xalign, xdigits, xdisplay from Arni Magnusson, added + along with help file. Feature request #5686. + * New argument 'auto' in xtable(), to call xalign, xdigits, and + xdisplay at the time when xtable is created. + * Updated xtableGallery vignette, now with TOC and revised examples. 1.7-4 (2014-09-11) - * Released to CRAN * Changed tags in HTML to be all lower case, to be compatible with HTML5, part of feature request. (#5879) * Fixed booktabs bug (#2309), more of an enhancement really. Updated xtableGallery.snw to illustrate the change. - * Moved vignettes from inst/doc to vignettes as now required by CRAN. - * Changed email address of David Dahl to dahl@stat.byu.edu in 9 places 1.7-3 (2014-03-06) - * Released to CRAN * Dealt with format.args bug (#4770). No code changes, but the documentation of print.xtable was changed to warn of the problem and to give a workaround as an example. diff --git a/pkg/R/formatHelpers.R b/pkg/R/autoformat.R similarity index 85% rename from pkg/R/formatHelpers.R rename to pkg/R/autoformat.R index 91691e4..940ecdb 100644 --- a/pkg/R/formatHelpers.R +++ b/pkg/R/autoformat.R @@ -1,3 +1,10 @@ +autoformat <- function(xtab, zap = getOption("digits")) { + align(xtab) <- xalign(xtab) + digits(xtab) <- xdigits(xtab, zap = zap) + display(xtab) <- xdisplay(xtab) + return(xtab) +} + xalign <- function(x, pad = TRUE) { lr <- function(v) if(is.numeric(v)) "r" else "l" diff --git a/pkg/R/xtable.R b/pkg/R/xtable.R index 2afc43c..011179d 100644 --- a/pkg/R/xtable.R +++ b/pkg/R/xtable.R @@ -21,7 +21,7 @@ ### MA 02111-1307, USA xtable <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, ...) { UseMethod("xtable") } @@ -29,7 +29,8 @@ xtable <- function(x, caption = NULL, label = NULL, align = NULL, ## data.frame and matrix objects xtable.data.frame <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, + ...) { logicals <- unlist(lapply(x, is.logical)) ##x[, logicals] <- lapply(x[, logicals], as.character) ## Patch for logicals bug, no 1911 @@ -41,6 +42,9 @@ xtable.data.frame <- function(x, caption = NULL, label = NULL, align = NULL, class(x) <- c("xtable","data.frame") caption(x) <- caption label(x) <- label + if(auto && is.null(align)) align <- xalign(x) + if(auto && is.null(digits)) digits <- xdigits(x) + if(auto && is.null(display)) display <- xdisplay(x) align(x) <- switch(1+is.null(align), align, c("r",c("r","l")[(characters|factors)+1])) digits(x) <- switch(1+is.null(digits), digits, c(0,rep(2,ncol(x)))) @@ -56,28 +60,28 @@ xtable.data.frame <- function(x, caption = NULL, label = NULL, align = NULL, } xtable.matrix <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, ...) { return(xtable.data.frame(data.frame(x, check.names = FALSE), caption = caption, label = label, align = align, - digits = digits, display = display)) + digits = digits, display = display, auto = auto)) } ### table objects (of 1 or 2 dimensions) by Guido Gay, 9 Feb 2007 ### Fixed to pass R checks by DBD, 9 May 2007 xtable.table <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, ...) { if (length(dim(x)) == 1) { return(xtable.matrix(matrix(x, dimnames = list(rownames(x), names(dimnames(x)))), - caption = caption, label = label, - align = align, digits = digits, display = display)) + caption = caption, label = label, align = align, + digits = digits, display = display, auto = auto)) } else if (length(dim(x))==2) { return(xtable.matrix(matrix(x, ncol = dim(x)[2], nrow = dim(x)[1], dimnames = list(rownames(x), colnames(x))), - caption = caption, label = label, - align = align, digits = digits, display = display)) + caption = caption, label = label, align = align, + digits = digits, display = display, auto = auto)) } else { stop("xtable.table is not implemented for tables of > 2 dimensions") } @@ -87,7 +91,7 @@ xtable.table <- function(x, caption = NULL, label = NULL, align = NULL, ## anova objects xtable.anova <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, ...) { suggested.digits <- c(0,rep(2, ncol(x))) suggested.digits[grep("Pr\\(>", names(x))+1] <- 4 suggested.digits[grep("P\\(>", names(x))+1] <- 4 @@ -96,6 +100,9 @@ xtable.anova <- function(x, caption = NULL, label = NULL, align = NULL, class(x) <- c("xtable","data.frame") caption(x) <- caption label(x) <- label + if(auto && is.null(align)) align <- xalign(x) + if(auto && is.null(digits)) digits <- xdigits(x) + if(auto && is.null(display)) display <- xdisplay(x) align(x) <- switch(1+is.null(align), align, c("l",rep("r", ncol(x)))) digits(x) <- switch(1+is.null(digits), digits, suggested.digits) display(x) <- switch(1+is.null(display), display, c("s",rep("f", ncol(x)))) @@ -106,41 +113,44 @@ xtable.anova <- function(x, caption = NULL, label = NULL, align = NULL, ## aov objects xtable.aov <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, ...) { return(xtable.anova(anova(x, ...), caption = caption, label = label, - align = align, digits = digits, display = display)) + align = align, digits = digits, display = display, + auto = auto)) } xtable.summary.aov <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { - return(xtable.anova(x[[1]], caption = caption, label = label, - align = align, digits = digits, display = display)) + digits = NULL, display = NULL, auto = FALSE, + ...) { + return(xtable.anova(x[[1]], caption = caption, label = label, align = align, + digits = digits, display = display, auto = auto)) } xtable.summary.aovlist <- function(x, caption = NULL, label = NULL, - align = NULL, - digits = NULL, display = NULL, ...) { + align = NULL, digits = NULL, display = NULL, + auto = FALSE, ...) { for (i in 1:length(x)) { if (i == 1) { result <- xtable.summary.aov(x[[i]], caption = caption, label = label, align = align, digits = digits, - display = display) + display = display, auto = auto) } else { result <- rbind(result, xtable.anova(x[[i]][[1]], caption = caption, label = label, align = align, - digits = digits, display = display)) + digits = digits, display = display, + auto = auto)) } } return(result) } xtable.aovlist <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, ...) { return(xtable.summary.aovlist(summary(x), caption = caption, label = label, align = align, digits = digits, - display = display)) + display = display, auto = auto)) } @@ -148,18 +158,23 @@ xtable.aovlist <- function(x, caption = NULL, label = NULL, align = NULL, ## lm objects xtable.lm <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, ...) { return(xtable.summary.lm(summary(x), caption = caption, label = label, - align = align, digits = digits, display = display)) + align = align, digits = digits, display = display, + auto = auto)) } xtable.summary.lm <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, + ...) { x <- data.frame(x$coef, check.names = FALSE) class(x) <- c("xtable","data.frame") caption(x) <- caption label(x) <- label + if(auto && is.null(align)) align <- xalign(x) + if(auto && is.null(digits)) digits <- xdigits(x) + if(auto && is.null(display)) display <- xdisplay(x) align(x) <- switch(1+is.null(align), align, c("r","r","r","r","r")) digits(x) <- switch(1+is.null(digits), digits, c(0,4,4,2,4)) display(x) <- switch(1+is.null(display), display, c("s","f","f","f","f")) @@ -170,28 +185,32 @@ xtable.summary.lm <- function(x, caption = NULL, label = NULL, align = NULL, ## glm objects xtable.glm <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, ...) { return(xtable.summary.glm(summary(x), caption = caption, label = label, align = align, - digits = digits, display = display)) + digits = digits, display = display, auto = auto)) } xtable.summary.glm <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { - return(xtable.summary.lm(x, caption = caption, label = label, - align = align, digits = digits, display = display)) + digits = NULL, display = NULL, auto = FALSE, + ...) { + return(xtable.summary.lm(x, caption = caption, label = label, align = align, + digits = digits, display = display, auto = auto)) } ## prcomp objects xtable.prcomp <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, ...) { x <- data.frame(x$rotation, check.names = FALSE) class(x) <- c("xtable","data.frame") caption(x) <- caption label(x) <- label + if(auto && is.null(align)) align <- xalign(x) + if(auto && is.null(digits)) digits <- xdigits(x) + if(auto && is.null(display)) display <- xdisplay(x) align(x) <- switch(1+is.null(align), align, c("r",rep("r", ncol(x)))) digits(x) <- switch(1+is.null(digits), digits, c(0,rep(4, ncol(x)))) display(x) <- switch(1+is.null(display), display, c("s",rep("f", ncol(x)))) @@ -199,12 +218,16 @@ xtable.prcomp <- function(x, caption = NULL, label = NULL, align = NULL, } xtable.summary.prcomp <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, + ...) { x <- data.frame(x$importance, check.names = FALSE) class(x) <- c("xtable","data.frame") caption(x) <- caption label(x) <- label + if(auto && is.null(align)) align <- xalign(x) + if(auto && is.null(digits)) digits <- xdigits(x) + if(auto && is.null(display)) display <- xdisplay(x) align(x) <- switch(1+is.null(align), align, c("r",rep("r", ncol(x)))) digits(x) <- switch(1+is.null(digits), digits, c(0,rep(4, ncol(x)))) display(x) <- switch(1+is.null(display), display, c("s",rep("f", ncol(x)))) @@ -217,7 +240,7 @@ xtable.summary.prcomp <- function(x, caption = NULL, label = NULL, align = NULL, # From: Jun Yan # Subject: Re: [R] xtable for Cox model output xtable.coxph <- function (x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) + digits = NULL, display = NULL, auto = FALSE, ...) { cox <- x beta <- cox$coef @@ -234,14 +257,14 @@ xtable.coxph <- function (x, caption = NULL, label = NULL, align = NULL, c("coef", "exp(coef)", "robust se", "z", "p")) } return(xtable(tmp, caption = caption, label = label, align = align, - digits = digits, display = display)) + digits = digits, display = display, auto = auto)) } # Additional method: xtable.ts # Contributed by David Mitchell (davidm@netspeed.com.au) # Date: July 2003 xtable.ts <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { + digits = NULL, display = NULL, auto = FALSE, ...) { if (inherits(x, "ts") && !is.null(ncol(x))) { # COLNAMES <- paste(colnames(x)); tp.1 <- trunc(time(x)) @@ -274,7 +297,7 @@ xtable.ts <- function(x, caption = NULL, label = NULL, align = NULL, names(tmp) <- COLNAMES } return(xtable(tmp, caption = caption, label = label, align = align, - digits = digits, display = display)) + digits = digits, display = display, auto = auto)) } # Suggested by Ajay Narottam Shah in e-mail 2006/07/22 diff --git a/pkg/man/formatHelpers.Rd b/pkg/man/autoformat.Rd similarity index 72% rename from pkg/man/formatHelpers.Rd rename to pkg/man/autoformat.Rd index 20480d1..1e52242 100644 --- a/pkg/man/formatHelpers.Rd +++ b/pkg/man/autoformat.Rd @@ -1,24 +1,31 @@ -\name{xalign} +\name{autoformat} +\alias{autoformat} \alias{xalign} \alias{xdigits} \alias{xdisplay} -\title{Suggest Appropriate Formatting} +\title{Automatically Format Export Tables} \description{ Suggest an appropriate alignment, number of digits, and display type for \code{xtable}. } \usage{ +autoformat(xtab, zap = getOption("digits")) + xalign(x, pad = TRUE) xdigits(x, pad = TRUE, zap = getOption("digits")) xdisplay(x, pad = TRUE) } \arguments{ + \item{xtab}{an object of class \code{xtable}.} \item{x}{a vector, matrix, or data frame.} \item{pad}{whether to format row names, when \code{x} is two-dimensional.} \item{zap}{the number of digits passed to \code{zapsmall}.} } \value{ + \code{autoformat} returns a copy of \code{xtab}, after applying + \code{xalign}, \code{xdigits}, and \code{xdisplay}. + \code{xalign} returns a character vector consisting of \code{"l"} and \code{"r"} elements, for left/right alignment. @@ -33,27 +40,36 @@ xdisplay(x, pad = TRUE) \code{\link{display}} } \examples{ -## Vector +## 1 Vector xalign(precip) xdigits(precip) xdisplay(precip) -## Data frame + +## 2 Data frame head(mtcars) xdigits(mtcars, pad = FALSE) xdigits(mtcars, pad = TRUE) xalign(mtcars) xdisplay(mtcars) -## Autoformat when xtable is created + +## 3 Autoformat when xtable is created xtable(mtcars, align = xalign(mtcars), digits = xdigits(mtcars), display = xdisplay(mtcars)) -## Autoformat existing xtable +## equivalent shortcut +xtable(mtcars, auto = TRUE) + + +## 4 Autoformat existing xtable mt <- xtable(mtcars) align(mt) <- xalign(mt) digits(mt) <- xdigits(mt) display(mt) <- xdisplay(mt) + +## equivalent shortcut +mt <- autoformat(mt) } \keyword{array} \keyword{print} diff --git a/pkg/man/table.attributes.Rd b/pkg/man/table.attributes.Rd index ff2be41..7d0b6e3 100644 --- a/pkg/man/table.attributes.Rd +++ b/pkg/man/table.attributes.Rd @@ -44,7 +44,9 @@ } \author{David Dahl \email{dahl@stat.byu.edu} with contributions and suggestions from many others (see source code).} \seealso{ - \code{\link{xtable}}, \code{\link{print.xtable}}, - \code{\link{xalign}}, \code{\link{xdigits}}, \code{\link{xdisplay}} + \code{\link{xtable}}, \code{\link{print.xtable}} + + \code{\link{autoformat}}, \code{\link{xalign}}, \code{\link{xdigits}}, + \code{\link{xdisplay}} } \keyword{print} diff --git a/pkg/man/xtable.Rd b/pkg/man/xtable.Rd index dacc66a..ca29021 100644 --- a/pkg/man/xtable.Rd +++ b/pkg/man/xtable.Rd @@ -24,7 +24,7 @@ } \usage{ xtable(x, caption = NULL, label = NULL, align = NULL, digits = NULL, - display = NULL, ...) + display = NULL, auto = FALSE, ...) } \arguments{ \item{x}{An R object of class found among \code{methods(xtable)}. See @@ -79,6 +79,12 @@ xtable(x, caption = NULL, label = NULL, align = NULL, digits = NULL, but \code{digits} as number of \emph{significant} digits. Note that this can lead to quite long result strings. Default depends on the class of \code{x}.} + \item{auto}{ + Logical, indicating whether to apply automatic format when no value + is passed to \code{align}, \code{digits}, or \code{display}. This + \sQuote{autoformat} (based on \code{xalign}, \code{xdigits}, and + \code{xdisplay}) can be useful to quickly format a typical + \code{matrix} or \code{data.frame}. Default value is \code{FALSE}.} \item{...}{Additional arguments. (Currently ignored.)} } \details{ @@ -102,9 +108,7 @@ xtable(x, caption = NULL, label = NULL, align = NULL, digits = NULL, manipulated. All method functions should return an object whose class is \code{c("xtable","data.frame")}. The resulting object can have attributes \code{caption} and \code{label}, but must have - attributes \code{align}, \code{digits}, and \code{display}. It is - strongly recommened that you set these attributes through the provided - replacement functions as they perform validity checks. + attributes \code{align}, \code{digits}, and \code{display}. } \value{An object of class \code{"xtable"} which inherits the \code{data.frame} class and contains several additional attributes @@ -118,7 +122,8 @@ xtable(x, caption = NULL, label = NULL, align = NULL, digits = NULL, \code{\link{label}}, \code{\link{align}}, \code{\link{digits}}, \code{\link{display}} - \code{\link{xalign}}, \code{\link{xdigits}}, \code{\link{xdisplay}} + \code{\link{autoformat}}, \code{\link{xalign}}, \code{\link{xdigits}}, + \code{\link{xdisplay}} } \examples{ @@ -129,6 +134,8 @@ data(tli) tli.table <- xtable(tli[1:20, ]) print(tli.table) print(tli.table, type = "html") +xtable(mtcars) +xtable(mtcars, auto = TRUE) ## Demonstrate data.frame with different digits in cells tli.table <- xtable(tli[1:20, ]) @@ -139,7 +146,7 @@ print(tli.table, type = "html") ## Demonstrate matrix design.matrix <- model.matrix(~ sex*grade, data = tli[1:20, ]) -design.table <- xtable(design.matrix) +design.table <- xtable(design.matrix, auto = TRUE) print(design.table) print(design.table, type = "html") diff --git a/pkg/vignettes/xtableGallery.Rnw b/pkg/vignettes/xtableGallery.Rnw index cbab0d9..8491e12 100644 --- a/pkg/vignettes/xtableGallery.Rnw +++ b/pkg/vignettes/xtableGallery.Rnw @@ -143,7 +143,8 @@ temp.table # } @ -\section{Helper functions for formatting} +\section{Automatic formatting} +\subsection{Suggest alignment, digits, and display} The functions \code{xalign}, \code{xdigits}, and \code{xdisplay} are useful for formatting tables in a sensible way. Consider the output produced by the default formatting. @@ -166,6 +167,24 @@ display(x) <- xdisplay(x) x @ +\subsection{Shorthand notation} +For convenience, the three `autoformat' functions (\code{xalign}, +\code{xdigits}, and \code{xdisplay}) can be applied together when an +\code{xtable} is created, using the \code{auto} argument: + +<>= +xtable(dat, auto = TRUE) +@ + +\p +Similarly, the \code{autoformat} function can be used to postprocess an +existing \code{xtable}: + +<>= +x <- xtable(dat) +autoformat(x) +@ + \newpage \section{Sanitization} -- 2.39.5