Added "format.args" argument to "print.xtable" that can be used to pass arguments...

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

diff --git a/pkg/NEWS b/pkg/NEWS
index 97aa43fef74a79b1278ccaeb29dfbef3dba659ff..25520a5806884552700bb4d91eaa22256bc3ab5d 100644 (file)
--- a/pkg/NEWS
+++ b/pkg/NEWS
@@ -8,6 +8,8 @@
   * Added an "is.null()" check on the "table.placement" argument.
   * Added an example of header and footer specification with longtable
     to the vignette.  
+  * Added "format.args" argument to "print" that can be used to
+    pass additional arguments such as "big.marks" to "formatC()".
 
 1.6-0 (2011-10-07)
   * Allow "table*" as a value for "floating.environment" in print.xtable().

diff --git a/pkg/R/print.xtable.R b/pkg/R/print.xtable.R
index 2d7426787c1c6ec5e17a65010736998447fb5fc9..aadbc62ea554e85b9d79693814ddd03612baa331 100644 (file)
--- a/pkg/R/print.xtable.R
+++ b/pkg/R/print.xtable.R
@@ -45,6 +45,7 @@ print.xtable <- function(
   math.style.negative=FALSE,\r
   html.table.attributes="border=1",\r
   print.results=TRUE,\r
+  format.args=NULL,\r
   ...) {\r
   # Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 hline.after\r
   # By default it print an \hline before and after the columns names independently they are printed or not and at the end of the table\r
@@ -354,23 +355,34 @@ print.xtable <- function(
     ina <- is.na(xcol)\r
     is.numeric.column <- is.numeric(xcol)\r
 \r
-       if(is.character(xcol))\r
+       if(is.character(xcol)) {\r
                cols[,i+pos] <- xcol\r
-       else if(!varying.digits){\r
-               cols[,i+pos] <-\r
-                       formatC( xcol,\r
+       } else {\r
+         if (is.null(format.args)){\r
+           format.args <- list()\r
+         }\r
+         if (is.null(format.args$decimal.mark)){\r
+           format.args$decimal.mark <- options()$OutDec\r
+         }\r
+         if(!varying.digits){\r
+               curFormatArgs <- c(list( \r
+                   x = xcol,\r
                        format = ifelse( attr( x, "digits",exact=TRUE )[i+1] < 0, "E", \r
-                       attr( x, "display",exact=TRUE )[i+1] ), \r
-                       digits = abs( attr( x, "digits",exact=TRUE )[i+1] ), \r
-                       decimal.mark=options()$OutDec)\r
-    }else{\r
+                         attr( x, "display",exact=TRUE )[i+1] ), \r
+                       digits = abs( attr( x, "digits",exact=TRUE )[i+1] )),\r
+                       format.args)\r
+           cols[,i+pos] <- do.call("formatC", curFormatArgs)\r
+      }else{\r
                for( j in 1:nrow( cols ) ) {\r
-               ### modified Claudio Agostinelli <claudio@unive.it> dated 2009-09-14\r
-               ### add decimal.mark=options()$OutDec\r
-               cols[j,i+pos] <-\r
-                       formatC( xcol[j],\r
-                       format = ifelse( attr( x, "digits",exact=TRUE )[j,i+1] < 0, "E", attr( x, "display",exact=TRUE )[i+1] ), digits = abs( attr( x, "digits",exact=TRUE )[j,i+1] ), decimal.mark=options()$OutDec)\r
+                 curFormatArgs <- c(list( \r
+            x = xcol[j],\r
+                       format = ifelse( attr( x, "digits",exact=TRUE )[j,i+1] < 0, "E", \r
+              attr( x, "display",exact=TRUE )[i+1] ), \r
+            digits = abs( attr( x, "digits",exact=TRUE )[j,i+1] )),\r
+                       format.args)\r
+                 cols[j,i+pos] <- do.call("formatC", curFormatArgs)                    \r
                }\r
+      }        \r
        }\r
        ## End Ian Fellows changes\r
        \r

diff --git a/pkg/man/print.xtable.Rd b/pkg/man/print.xtable.Rd
index f11aa7e525ac6172c832adb001dac77144c8e466..5d1ffd5f5ae9149a50e2a865cfc9b9ceb394d1ae 100644 (file)
--- a/pkg/man/print.xtable.Rd
+++ b/pkg/man/print.xtable.Rd
@@ -11,7 +11,8 @@
                sanitize.text.function=NULL, sanitize.rownames.function=sanitize.text.function,
                sanitize.colnames.function=sanitize.text.function, math.style.negative=FALSE, 
                html.table.attributes="border=1", 
-               print.results=TRUE, ...)}
+               print.results=TRUE, 
+        format.args=NULL, ...)}
 \arguments{
   \item{x}{An object of class \code{"xtable"}.}
   \item{type}{Type of table to produce.  Possible values for \code{type} are \code{"latex"} or \code{"html"}.
@@ -45,6 +46,7 @@
   \item{math.style.negative}{In a LaTeX table, if \code{TRUE}, then use $-$ for the negative sign (as was the behavior prior to version 1.5-3).  Default value is \code{FALSE}.}
   \item{html.table.attributes}{In an HTML table, attributes associated with the \code{<TABLE>} tag.  Default value is \code{border=1}.}
   \item{print.results}{If \code{TRUE}, the generated table is printed to standard output.  Set this to \code{FALSE} if you will just be using the character vector that is returned invisibly.}
+  \item{format.args}{List of arguments for the \code{formatC} function.  For example, standard German number separators can be specified as \code{format.args=list(big.mark = "'", decimal.mark = ","))}.}
   \item{...}{Additional arguments.  (Currently ignored.)}
 }
 \details{

diff --git a/pkg/man/xtable.Rd b/pkg/man/xtable.Rd
index 4122518eb7470021d5efd57aaf191216f386ebce..60736f81938c18cb4d523b32ce5d0fe43e1a860e 100644 (file)
--- a/pkg/man/xtable.Rd
+++ b/pkg/man/xtable.Rd
@@ -193,6 +193,9 @@ glm.D93 <- glm(counts ~ outcome + treatment, family=poisson())
 print(xtable(glm.D93,align="r|llrc"))
 print(xtable(anova(glm.D93)),hline.after=c(1),size="small")
 
+## Demonstration of additional formatC() arguments.
+print(fm1.table, format.args=list(big.mark = "'", decimal.mark = ","))
+
 ## Demonstration of longtable support.
 ## Remember to insert \usepackage{longtable} on your LaTeX preamble
 x <- matrix(rnorm(1000), ncol = 10)