xalign, xdigits, xdisplay from Arni Magnusson (arnima@hafro.is) added along with...

git-svn-id: svn://scm.r-forge.r-project.org/svnroot/xtable@53 edb9625f-4e0d-4859-8d74-9fd3b1da38cb

diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION
index 2d8b9f51d545ef3c86d813a23dda3ff0525e3d80..a52eceecd3444ad1d6b22bc51393af45c3c1ee44 100644 (file)
--- 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 <dahl@stat.byu.edu>

diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE
index 52dbdd6096992d305412c97fc99d1ac339866b59..69f92318381fd5405aad1f069c23f84d56763988 100644 (file)
--- a/pkg/NAMESPACE
+++ b/pkg/NAMESPACE
@@ -1,3 +1,4 @@
+
 # NAMESPACE work by Robert Gentleman <rgentlem@fhcrc.org>
 # 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 ab5c41e07f4ac414aab59c4b1b4a8cd021aa16df..76d93459a19ccbcfb03070255cc71d868211f03c 100644 (file)
--- 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 (file)
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 (file)
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 32297e4905344be3be5917f097e554eef19d2a92..70a3b1e16fbddcb6a6105fccd2a15a36993fd737 100644 (file)
--- 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 2dfa32b7d2807d8ca87bec8f04127e7932ea1fc5..02aa797123fb7295384a396a0d85400144b68248 100644 (file)
--- a/pkg/vignettes/xtableGallery.snw
+++ b/pkg/vignettes/xtableGallery.snw
@@ -25,7 +25,8 @@ makeme()
 \title{
 The xtable gallery
 }
-\author{Jonathan Swinton <jonathan@swintons.net>\\ with small contributions from others}
+\author{Jonathan Swinton <jonathan@swintons.net>\\
+  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="")))
 @
 <<results=tex>>=
-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$)")))
 @
 <<results=tex>>=
 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 }
 <<results=tex>>=
-   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,
 <<results=tex>>=
-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}
 <<results=tex>>=
-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.
 
 <<results=tex>>=
 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}
 <<results=tex>>=
 toLatex(sessionInfo())