From: dscott <dscott@edb9625f-4e0d-4859-8d74-9fd3b1da38cb>
Date: Wed, 27 Jan 2016 05:16:22 +0000 (+0000)
Subject: Revised print.xtableFtable to allow sanitization of row and column
X-Git-Url: https://git.donarmstrong.com/?p=xtable.git;a=commitdiff_plain;h=155ef0765cb0c2f74648b3f4398d3ce897c6d09f

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