From ccdd992fb0e97568f2ebddd7e43d6f414a426f28 Mon Sep 17 00:00:00 2001 From: dscott Date: Fri, 26 Sep 2014 01:50:07 +0000 Subject: [PATCH] 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. git-svn-id: svn://scm.r-forge.r-project.org/svnroot/xtable@53 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- pkg/DESCRIPTION | 2 +- pkg/NAMESPACE | 4 +- pkg/NEWS | 7 +++ pkg/R/formatHelpers.R | 46 +++++++++++++++++ pkg/man/formatHelpers.Rd | 56 +++++++++++++++++++++ pkg/tests/test.xalign.xdigits.xdisplay.R | 2 +- pkg/vignettes/xtableGallery.snw | 64 ++++++++++++++++-------- 7 files changed, 157 insertions(+), 24 deletions(-) create mode 100644 pkg/R/formatHelpers.R create mode 100644 pkg/man/formatHelpers.Rd diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION index 2d8b9f5..a52ecee 100644 --- a/pkg/DESCRIPTION +++ b/pkg/DESCRIPTION @@ -1,5 +1,5 @@ Package: xtable -Version: 1.7-4 +Version: 1.7-5 Date: 2014/09/11 Title: Export tables to LaTeX or HTML Author: David B. Dahl diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE index 52dbdd6..69f9231 100644 --- a/pkg/NAMESPACE +++ b/pkg/NAMESPACE @@ -1,3 +1,4 @@ + # NAMESPACE work by Robert Gentleman # in e-mail on July 30, 2007. # @@ -7,7 +8,8 @@ importFrom("utils", toLatex) export("caption<-", "caption", "label", "label<-", "align<-", "align", "digits<-", "digits", "display<-", - "display", "xtable", "print.xtable", "toLatex.xtable") + "display", "xtable", "print.xtable", "toLatex.xtable", + "xalign", "xdigits", "xdisplay") S3method("print", "xtable") S3method("toLatex", "xtable") diff --git a/pkg/NEWS b/pkg/NEWS index ab5c41e..76d9345 100644 --- a/pkg/NEWS +++ b/pkg/NEWS @@ -1,3 +1,10 @@ +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. + 1.7-4 (2014-09-11) * Released to CRAN * Changed tags in HTML to be all lower case, to be compatible with diff --git a/pkg/R/formatHelpers.R b/pkg/R/formatHelpers.R new file mode 100644 index 0000000..91691e4 --- /dev/null +++ b/pkg/R/formatHelpers.R @@ -0,0 +1,46 @@ +xalign <- function(x, pad = TRUE) { + lr <- function(v) if(is.numeric(v)) "r" else "l" + + is.2d <- length(dim(x)) == 2 + alignment <- if(is.2d) sapply(as.data.frame(x), lr) else lr(x) + output <- if(is.2d && pad) c("l", alignment) else alignment + + return(output) +} + +xdigits <- function(x, pad = TRUE, zap = getOption("digits")) { + dig <- function(v) { + if(is.numeric(v)) { + v <- na.omit(v) + v <- zapsmall(abs(v - floor(v)), zap) + dec <- if(any(v > 0)) max(nchar(v) - 2L) else 0L + } else { + dec <- 0L + } + return(dec) + } + + is.2d <- length(dim(x)) == 2 + decimals <- if(is.2d) sapply(as.data.frame(x), dig) else dig(x) + output <- if(is.2d && pad) c(0L, decimals) else decimals + + return(output) +} + +xdisplay <- function(x, pad = TRUE) { + type <- function(v) { + if(is.numeric(v)) { + tp <- if(xdigits(v) == 0) "d" else "f" + } else { + tp <- "s" + } + return(tp) + } + + is.2d <- length(dim(x)) == 2 + disp <- if(is.2d) sapply(as.data.frame(x), type) else type(x) + output <- if(is.2d && pad) c("s", disp) else disp + + return(output) +} + diff --git a/pkg/man/formatHelpers.Rd b/pkg/man/formatHelpers.Rd new file mode 100644 index 0000000..a990335 --- /dev/null +++ b/pkg/man/formatHelpers.Rd @@ -0,0 +1,56 @@ +\name{xalign} +\alias{xalign} +\alias{xdigits} +\alias{xdisplay} +\title{Suggest Appropriate Formatting} +\description{ + Suggest an appropriate \code{xtable} alignment, appropriate number of + digits, or display type for a vector, or each column of a matrix or + data frame. +} +\usage{ +xalign(x, pad = TRUE) +xdigits(x, pad = TRUE, zap = getOption("digits")) +xdisplay(x, pad = TRUE) +} +\arguments{ + \item{x}{a vector, matrix, or data frame.} + \item{pad}{when \code{x} is two-dimensional, \code{pad = TRUE} inserts + an extra \code{"l"} for the row names.} + \item{zap}{the number of digits passed to \code{zapsmall}.} + +} +\value{ + A character or a vector of characters, specifying the suggested + alignment, number of digits or display type. +} +\author{Arni Magnusson.} +\seealso{ + \code{\link{xtable}}. +} +\examples{ +## Vector +xalign(precip) +xdigits(precip) +xdisplay(precip) + +## Data frame +head(mtcars) +xalign(mtcars, pad = FALSE) +xalign(mtcars, pad = TRUE) +xtable(mtcars, align = xalign(mtcars)) +xdigits(mtcars, pad = FALSE) +xdigits(mtcars, pad = TRUE) +xtable(mtcars, digits = xdigits(mtcars)) +xdisplay(mtcars, pad = FALSE) +xdisplay(mtcars, pad = TRUE) +xtable(mtcars, display = xdisplay(mtcars)) + +## Postprocessing an xtable +state <- xtable(state.x77) +align(state) <- xalign(state) +digits(state) <- xdigits(state) +display(state) <- xdisplay(state) +} +\keyword{array} +\keyword{print} diff --git a/pkg/tests/test.xalign.xdigits.xdisplay.R b/pkg/tests/test.xalign.xdigits.xdisplay.R index 32297e4..70a3b1e 100644 --- a/pkg/tests/test.xalign.xdigits.xdisplay.R +++ b/pkg/tests/test.xalign.xdigits.xdisplay.R @@ -25,7 +25,7 @@ x ### Hmm, inappropriate alignment and digits. ### Now try suggestions from xalign, xdigits, and xdisplay: -source("http://www.hafro.is/~arnima/r/xtable_5686.R") +### source("http://www.hafro.is/~arnima/r/xtable_5686.R") align(x) <- xalign(x) digits(x) <- xdigits(x) display(x) <- xdisplay(x) diff --git a/pkg/vignettes/xtableGallery.snw b/pkg/vignettes/xtableGallery.snw index 2dfa32b..02aa797 100644 --- a/pkg/vignettes/xtableGallery.snw +++ b/pkg/vignettes/xtableGallery.snw @@ -25,7 +25,8 @@ makeme() \title{ The xtable gallery } -\author{Jonathan Swinton \\ with small contributions from others} +\author{Jonathan Swinton \\ + with small contributions from others} \usepackage{Sweave} \SweaveOpts{prefix.string=figdir/fig,debug=TRUE,eps=FALSE,echo=TRUE} @@ -129,7 +130,8 @@ P <- c(1,1,0,0,0,1,0,1,1,1,0,0,0,1,0,1,1,0,0,1,0,1,1,0) K <- c(1,0,0,1,0,1,1,0,0,1,0,1,0,1,1,0,0,0,1,1,1,0,1,0) yield <- c(49.5,62.8,46.8,57.0,59.8,58.5,55.5,56.0,62.8,55.8,69.5,55.0, 62.0,48.8,45.5,44.2,52.0,51.5,49.8,48.8,57.2,59.0,53.2,56.0) -npk <- data.frame(block=gl(6,4), N=factor(N), P=factor(P), K=factor(K), yield=yield) +npk <- data.frame(block=gl(6,4), N=factor(N), P=factor(P), K=factor(K), + yield=yield) npk.aov <- aov(yield ~ block + N*P*K, npk) op <- options(contrasts=c("contr.helmert", "contr.treatment")) npk.aovE <- aov(yield ~ N*P*K + Error(block), npk) @@ -244,11 +246,16 @@ temp.ts <- ts(cumsum(1+round(rnorm(100), 0)), start = c(1954, 7), frequency=12) if (FALSE) { for(i in c("latex","html")) { outFileName <- paste("xtable.",ifelse(i=="latex","tex",i),sep="") - print(xtable(lm.D9),type=i,file=outFileName,append=TRUE,latex.environments=NULL) - print(xtable(lm.D9),type=i,file=outFileName,append=TRUE,latex.environments="") - print(xtable(lm.D9),type=i,file=outFileName,append=TRUE,latex.environments="center") - print(xtable(anova(glm.D93,test="Chisq")),type=i,file=outFileName,append=TRUE) - print(xtable(anova(glm.D93)),hline.after=c(1),size="small",type=i,file=outFileName,append=TRUE) + print(xtable(lm.D9),type=i,file=outFileName,append=TRUE, + latex.environments=NULL) + print(xtable(lm.D9),type=i,file=outFileName,append=TRUE, + latex.environments="") + print(xtable(lm.D9),type=i,file=outFileName,append=TRUE, + latex.environments="center") + print(xtable(anova(glm.D93,test="Chisq")),type=i,file=outFileName, + append=TRUE) + print(xtable(anova(glm.D93)),hline.after=c(1),size="small",type=i, + file=outFileName,append=TRUE) # print(xtable(pr2),type=i,file=outFileName,append=TRUE) } } @@ -269,12 +276,14 @@ Sometimes you might want to have your own sanitization function wanttex <- xtable(data.frame( label=paste("Value_is $10^{-",1:3,"}$",sep=""))) @ <>= -print(wanttex,sanitize.text.function=function(str)gsub("_","\\_",str,fixed=TRUE)) +print(wanttex, + sanitize.text.function=function(str)gsub("_","\\_",str,fixed=TRUE)) @ \subsection{Markup in tables} -Markup can be kept in tables, including column and row names, by using a custom sanitize.text.function: +Markup can be kept in tables, including column and row names, by using +a custom sanitize.text.function: <<>>= mat <- round(matrix(c(0.9, 0.89, 200, 0.045, 2.0), c(1, 5)), 4) @@ -287,9 +296,14 @@ print(mat, sanitize.text.function = function(x){x}) @ % By David Dahl to demonstrate contribution from David Whitting, 2007-10-09. -You can also have sanitize functions that are specific to column or row names. In the table below, the row name is not sanitized but column names and table elements are: +You can also have sanitize functions that are specific to column or +row names. In the table below, the row name is not sanitized but +column names and table elements are: <<>>= -money <- matrix(c("$1,000","$900","$100"),ncol=3,dimnames=list("$\\alpha$",c("Income (US$)","Expenses (US$)","Profit (US$)"))) +money <- matrix(c("$1,000","$900","$100"),ncol=3, + dimnames=list("$\\alpha$", + c("Income (US$)","Expenses (US$)", + "Profit (US$)"))) @ <>= print(xtable(money),sanitize.rownames.function=function(x) {x}) @@ -298,9 +312,12 @@ print(xtable(money),sanitize.rownames.function=function(x) {x}) \section{Format examples} \subsection{Adding a centering environment } <>= - print(xtable(lm.D9,caption="\\tt latex.environments=NULL"),latex.environments=NULL) - print(xtable(lm.D9,caption="\\tt latex.environments=\"\""),latex.environments="") - print(xtable(lm.D9,caption="\\tt latex.environments=\"center\""),latex.environments="center") + print(xtable(lm.D9,caption="\\tt latex.environments=NULL"), + latex.environments=NULL) + print(xtable(lm.D9,caption="\\tt latex.environments=\"\""), + latex.environments="") + print(xtable(lm.D9,caption="\\tt latex.environments=\"center\""), + latex.environments="center") @ \subsection{Column alignment} @@ -382,12 +399,14 @@ print((tli.table),include.colnames=FALSE,floating=FALSE) \\ Note the doubled header lines which can be suppressed with, eg, <>= -print(tli.table,include.colnames=FALSE,floating=FALSE,hline.after=c(0,nrow(tli.table))) +print(tli.table,include.colnames=FALSE,floating=FALSE, + hline.after=c(0,nrow(tli.table))) @ \subsection{Suppress row and column names} <>= -print((tli.table),include.colnames=FALSE,include.rownames=FALSE,floating=FALSE) +print((tli.table),include.colnames=FALSE,include.rownames=FALSE, + floating=FALSE) @ \subsection{Rotate row and column names} @@ -402,7 +421,8 @@ print((tli.table),rotate.rownames=TRUE,rotate.colnames=TRUE) \subsubsection{Line locations} -Use the {\tt hline.after} argument to specify the position of the horizontal lines. +Use the {\tt hline.after} argument to specify the position of the +horizontal lines. <>= print(xtable(anova(glm.D93)),hline.after=c(1),floating=FALSE) @@ -507,9 +527,10 @@ print(x.big,tabular.environment='longtable',floating=FALSE) %@ \subsection{Sideways tables} -Remember to insert \verb|\usepackage{rotating}| in your LaTeX preamble. -Sideways tables can't be forced in place with the `H' specifier, but you can -use the \verb|\clearpage| command to get them fairly nearby. +Remember to insert \verb|\usepackage{rotating}| in your LaTeX +preamble. Sideways tables can't be forced in place with the `H' +specifier, but you can use the \verb|\clearpage| command to get them +fairly nearby. <<>>= x <- x[1:30,] @@ -577,7 +598,8 @@ x.ltx @ \section{Acknowledgements} -Most of the examples in this gallery are taken from the {\tt xtable} documentation. +Most of the examples in this gallery are taken from the {\tt xtable} +documentation. \section{R Session information} <>= toLatex(sessionInfo()) -- 2.39.5