Added support for rotation of row and column names, and for the use of booktabs.

Needs more work yet.

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

diff --git a/pkg/R/xtableFtable.R b/pkg/R/xtableFtable.R
index 1e9d72a07245de8c6f5d1a082703bae5a4469203..fd32d116c4859241170dc5e287d015800cc5edfa 100644 (file)
--- a/pkg/R/xtableFtable.R
+++ b/pkg/R/xtableFtable.R
@@ -11,14 +11,14 @@ xtableFtable <- function(x, caption = NULL, label = NULL, align = NULL,
   xDim <- dim(x)
   nRowVars <- length(attr(x, "row.vars"))
   nColVars <- length(attr(x, "col.vars"))
-  if (nRowVars ==0){
+  if (nRowVars == 0){
     if (method =="col.compact"){
       method <- "non.compact"
     } else if (method == "compact"){
       method <- "row.compact"
     }
   }
-  if (nColVars ==0){
+  if (nColVars == 0){
     if (method =="row.compact"){
       method <- "non.compact"
     } else if (method == "compact"){
@@ -78,6 +78,7 @@ print.xtableFtable <- function(x,
   NA.string = getOption("xtable.NA.string", ""),
   only.contents = getOption("xtable.only.contents", FALSE),
   add.to.row = getOption("xtable.add.to.row", NULL),
+  sanitize.text.function = getOption("xtable.sanitize.text.function", NULL),
   sanitize.rownames.function = getOption("xtable.sanitize.rownames.function",
                                          sanitize.text.function),
   sanitize.colnames.function = getOption("xtable.sanitize.colnames.function",
@@ -96,6 +97,7 @@ print.xtableFtable <- function(x,
   timestamp = getOption("xtable.timestamp", date()),
   ...) {
   if (type == "latex"){
+
     caption <- attr(x, "ftableCaption")
     label <- attr(x, "ftableLabel")
     align <- attr(x, "ftableAlign")
@@ -105,16 +107,51 @@ print.xtableFtable <- function(x,
     method <- attr(x, "method")
     lsep <- attr(x, "lsep")
     nCharRows <- attr(x, "nChars")[1]
+    nCharCols <- attr(x, "nChars")[2]
     fmtFtbl <- stats:::format.ftable(x, quote = quote, digits = digits,
                                      method = method, lsep = lsep)
     attr(fmtFtbl, "caption") <- caption
     attr(fmtFtbl, "label") <- label
+    ## if method is "compact", rotate both if either requested
+    if (method == "compact"){
+      if (rotate.rownames) rotate.colnames <- TRUE
+      if (rotate.colnames) rotate.rownames <- TRUE
+    }
+
+    ## rotations are possible
+    if (rotate.rownames){
+      fmtFtbl[nCharRows, 1:(nCharCols - 1)] <-
+        paste0("\\begin{sideways} ",
+               fmtFtbl[nCharRows, 1:(nCharCols - 1)],
+               "\\end{sideways}")
+    }
+    if (rotate.colnames){
+      fmtFtbl[1:(nCharRows), nCharCols - 1] <-
+        paste0("\\begin{sideways} ",
+               fmtFtbl[1:(nCharRows), nCharCols - 1],
+               "\\end{sideways}")
+    }
+
+
+    ## booktabs is incompatible with vertical lines in tables
+    if (booktabs) align <- gsub("|","", align, fixed = TRUE)
     attr(fmtFtbl, "align") <- align
     attr(fmtFtbl, "digits") <- digits
     attr(fmtFtbl, "quote") <- quote
     attr(fmtFtbl, "display") <- display
+
+    ## labels should be left aligned
+    for (i in 1:nCharRows){
+      fmtFtbl[i, nCharCols:dim(fmtFtbl)[2]] <-
+        paste0("\\multicolumn{1}{l}{ ",
+               fmtFtbl[i, nCharCols:dim(fmtFtbl)[2]], "}")
+    }
+
+
     print.xtable(fmtFtbl, hline.after = c(-1, nCharRows, dim(fmtFtbl)[1]),
-                 include.rownames = FALSE, include.colnames = FALSE)
+                 include.rownames = FALSE, include.colnames = FALSE,
+                 booktabs = booktabs,
+                 sanitize.text.function = function(x){x})
   } else {
     stop("print.xtableFtable not yet implemented for this type")
   }

diff --git a/pkg/vignettes/xtableGallery.Rnw b/pkg/vignettes/xtableGallery.Rnw
index b5aa2a01fd10e1d9a0f5221334ed28799b7384de..807e8f672d6b8fac2abac122b4b602d708dc02ac 100644 (file)
--- a/pkg/vignettes/xtableGallery.Rnw
+++ b/pkg/vignettes/xtableGallery.Rnw
@@ -134,13 +134,20 @@ enable them to be printed using \pkg{xtable}
 \r
 <<ftable>>=\r
 data(mtcars)\r
+mtcars$cyl <- factor(mtcars$cyl, levels = c("4","6","8"),\r
+                     labels = c("four","six","eight"))\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
 \r
+\r
 @ %def\r
 \r
 \p\r
+<<ftablecheck>>=\r
+xftbl <- xtableFtable(tbl, method = "compact")\r
+print.xtableFtable(xftbl, booktabs = TRUE)\r
+@ %def\r
 <<ftable1, results = 'asis'>>=\r
 xftbl <- xtableFtable(tbl)\r
 print.xtableFtable(xftbl)\r
@@ -149,19 +156,21 @@ print.xtableFtable(xftbl)
 \p\r
 <<ftable2, results = 'asis'>>=\r
 xftbl <- xtableFtable(tbl, method = "row.compact")\r
-print.xtableFtable(xftbl)\r
+print.xtableFtable(xftbl, rotate.colnames = TRUE)\r
 @ %def\r
 \r
 \p\r
 <<ftable3, results = 'asis'>>=\r
 xftbl <- xtableFtable(tbl, method = "col.compact")\r
-print.xtableFtable(xftbl)\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
 <<ftable4, results = 'asis'>>=\r
 xftbl <- xtableFtable(tbl, method = "compact")\r
-print.xtableFtable(xftbl)\r
+print.xtableFtable(xftbl, booktabs = TRUE)\r
 @ %def\r
 \r
 \newpage\r