Revised print.xtableFtable to allow sanitization of row and column

variable names. Added examples to the xtable Gallery to show how to
sanitize these and also to sanitize labels.

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

diff --git a/pkg/R/xtableFtable.R b/pkg/R/xtableFtable.R
index 4c5f70976beb117b642292f4a62cde8081d95afd..41870042cae3521a898d6ca396d15e135e88af88 100644 (file)
--- a/pkg/R/xtableFtable.R
+++ b/pkg/R/xtableFtable.R
@@ -108,6 +108,8 @@ print.xtableFtable <- function(x,
     lsep <- attr(x, "lsep")
     nCharRows <- attr(x, "nChars")[1]
     nCharCols <- attr(x, "nChars")[2]
+    nRowVars <- length(attr(x, "row.vars"))
+    nColVars <- length(attr(x, "col.vars"))
     fmtFtbl <- stats:::format.ftable(x, quote = quote, digits = digits,
                                      method = method, lsep = lsep)
     attr(fmtFtbl, "caption") <- caption
@@ -118,6 +120,24 @@ print.xtableFtable <- function(x,
     ##   if (rotate.colnames) rotate.rownames <- TRUE
     ## }
 
+    ## sanitization is possible for row names and/or column names
+    ## row names
+    if (is.null(sanitize.rownames.function)) {
+      fmtFtbl[nCharRows, 1:nRowVars] <-
+        sanitize(fmtFtbl[nCharRows, 1:nRowVars], type = type)
+    } else {
+      fmtFtbl[nCharRows, 1:nRowVars] <-
+        sanitize.rownames.function(fmtFtbl[nCharRows, 1:nRowVars])
+    }
+    ## column names
+    if (is.null(sanitize.colnames.function)) {
+      fmtFtbl[1:nColVars, nCharCols - 1] <-
+        sanitize(fmtFtbl[1:nColVars, nCharCols - 1],
+                 type = type)
+    } else {
+      fmtFtbl[1:nColVars, nCharCols - 1] <-
+        sanitize.colnames.function(fmtFtbl[1:nColVars, nCharCols - 1])
+    }    
     ## rotations are possible
     if (rotate.rownames){
       fmtFtbl[1:dim(fmtFtbl)[1], 1:(nCharCols - 1)] <-

diff --git a/pkg/vignettes/xtableGallery.Rnw b/pkg/vignettes/xtableGallery.Rnw
index f56fb74c7153c6a25fee8635e7395241fdc00ff9..14dbd6f72d2904734cb12a8fc8cf62f87086ccb1 100644 (file)
--- a/pkg/vignettes/xtableGallery.Rnw
+++ b/pkg/vignettes/xtableGallery.Rnw
@@ -169,41 +169,74 @@ mtcars$cyl <- factor(mtcars$cyl, levels = c("4","6","8"),
 tbl <- ftable(mtcars$cyl, mtcars$vs, mtcars$am, mtcars$gear,\r
               row.vars = c(2, 4),\r
               dnn = c("Cylinders", "V/S", "Transmission", "Gears"))\r
-\r
-\r
+tbl\r
 @ %def\r
 \r
-\p\r
+Here is the \LaTeX{} produced:\r
+\r
 <<ftablecheck>>=\r
 xftbl <- xtableFtable(tbl, method = "compact")\r
 print.xtableFtable(xftbl, booktabs = TRUE)\r
 @ %def\r
+\r
+And here is a basic flat table:\r
+\r
 <<ftable1, results = 'asis'>>=\r
 xftbl <- xtableFtable(tbl)\r
 print.xtableFtable(xftbl)\r
 @ %def\r
 \r
-\p\r
-<<ftable2, results = 'asis'>>=\r
-xftbl <- xtableFtable(tbl, method = "row.compact")\r
-print.xtableFtable(xftbl, rotate.colnames = TRUE,\r
-                   rotate.rownames = TRUE)\r
-@ %def\r
+This illustrates the \code{method} argument:\r
 \r
-\p\r
-<<ftable3, results = 'asis'>>=\r
+<<ftable2, results = 'asis'>>=\r
 xftbl <- xtableFtable(tbl, method = "col.compact")\r
 print.xtableFtable(xftbl, rotate.rownames = TRUE)\r
 @ %def\r
 \r
-\p\r
 Booktabs is incompatible with vertical lines in tables, so the\r
-vertical dividing line is removed.\r
+vertical dividing line is removed. The separator \code{lsep} may require special treatment.\r
+\r
+<<ftable3, results = 'asis'>>=\r
+xftbl <- xtableFtable(tbl, method = "compact", lsep = " $\\vert$ ")\r
+sanitize.text.function <- function(x){x}\r
+print.xtableFtable(xftbl, sanitize.text.function = sanitize.text.function,\r
+                   booktabs = TRUE)\r
+@ %def\r
+\p\r
+\r
+Row and column variable names can be formatted specially using\r
+sanitization, and row and column variable names and labels can be\r
+rotated.\r
+\r
+If special formatting is required for row and column labels, that can\r
+be done as a workaround by redefining the data and associated labels.\r
+\r
 <<ftable4, results = 'asis'>>=\r
-xftbl <- xtableFtable(tbl, method = "compact")\r
-print.xtableFtable(xftbl, booktabs = TRUE)\r
+italic <- function(x){\r
+  paste0('{\\emph{', x, '}}')\r
+}\r
+mtcars$cyl <- factor(mtcars$cyl, levels = c("four","six","eight"),\r
+                     labels = c("four",italic("six"),"eight"))\r
+large <- function(x){\r
+  paste0('{\\Large ', x, '}')\r
+}\r
+bold <- function(x){\r
+  paste0('{\\bfseries ', x, '}')\r
+}\r
+tbl <- ftable(mtcars$cyl, mtcars$vs, mtcars$am, mtcars$gear,\r
+              row.vars = c(2, 4),\r
+              dnn = c("Cylinders", "V/S", "Transmission", "Gears"))\r
+xftbl <- xtableFtable(tbl, method = "row.compact")\r
+sanitize.text.function <- function(x){x}\r
+print.xtableFtable(xftbl, sanitize.text.function = sanitize.text.function,\r
+                   sanitize.rownames.function = large,\r
+                   sanitize.colnames.function = bold,\r
+                   rotate.colnames = TRUE,\r
+                   rotate.rownames = TRUE)\r
 @ %def\r
 \r
+\r
+\r
 \newpage\r
 \r
 <<include=FALSE>>=\r