From d871211ab0eee0bd7f965812ac1ba170507bb338 Mon Sep 17 00:00:00 2001
From: dscott <dscott@edb9625f-4e0d-4859-8d74-9fd3b1da38cb>
Date: Sat, 16 Jan 2016 12:09:33 +0000
Subject: [PATCH] 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
---
 pkg/R/xtableFtable.R            | 43 ++++++++++++++++++++++++++++++---
 pkg/vignettes/xtableGallery.Rnw | 15 +++++++++---
 2 files changed, 52 insertions(+), 6 deletions(-)

diff --git a/pkg/R/xtableFtable.R b/pkg/R/xtableFtable.R
index 1e9d72a..fd32d11 100644
--- 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 b5aa2a0..807e8f6 100644
--- a/pkg/vignettes/xtableGallery.Rnw
+++ b/pkg/vignettes/xtableGallery.Rnw
@@ -134,13 +134,20 @@ enable them to be printed using \pkg{xtable}
 
 <<ftable>>=
 data(mtcars)
+mtcars$cyl <- factor(mtcars$cyl, levels = c("4","6","8"),
+                     labels = c("four","six","eight"))
 tbl <- ftable(mtcars$cyl, mtcars$vs, mtcars$am, mtcars$gear,
               row.vars = c(2, 4),
               dnn = c("Cylinders", "V/S", "Transmission", "Gears"))
 
+
 @ %def
 
 \p
+<<ftablecheck>>=
+xftbl <- xtableFtable(tbl, method = "compact")
+print.xtableFtable(xftbl, booktabs = TRUE)
+@ %def
 <<ftable1, results = 'asis'>>=
 xftbl <- xtableFtable(tbl)
 print.xtableFtable(xftbl)
@@ -149,19 +156,21 @@ print.xtableFtable(xftbl)
 \p
 <<ftable2, results = 'asis'>>=
 xftbl <- xtableFtable(tbl, method = "row.compact")
-print.xtableFtable(xftbl)
+print.xtableFtable(xftbl, rotate.colnames = TRUE)
 @ %def
 
 \p
 <<ftable3, results = 'asis'>>=
 xftbl <- xtableFtable(tbl, method = "col.compact")
-print.xtableFtable(xftbl)
+print.xtableFtable(xftbl, rotate.rownames = TRUE)
 @ %def
 
 \p
+Booktabs is incompatible with vertical lines in tables, so the
+vertical dividing line is removed.
 <<ftable4, results = 'asis'>>=
 xftbl <- xtableFtable(tbl, method = "compact")
-print.xtableFtable(xftbl)
+print.xtableFtable(xftbl, booktabs = TRUE)
 @ %def
 
 \newpage
-- 
2.39.2