Incomplete version of xtableFtable.R

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

diff --git a/pkg/R/xtableFtable.R b/pkg/R/xtableFtable.R
index 4294169a605a2b2d03b5d508c1cf3a355a91681e..31e088bd36e2e2ee3108aab3c7c688bfac82b983 100644 (file)
--- a/pkg/R/xtableFtable.R
+++ b/pkg/R/xtableFtable.R
@@ -15,7 +15,7 @@ xtableFtable <- function(x, caption = NULL, label = NULL, align = NULL,
   attributes(xftbl) <- list(attributes(xftbl), attributes(ftbl))
   return(xftbl)
 }
-                         
+
 print.xtableFtable <- function(x,
   type = getOption("xtable.type", "latex"),
   file = getOption("xtable.file", ""),
@@ -28,16 +28,21 @@ print.xtableFtable <- function(x,
   latex.environments = getOption("xtable.latex.environments", c("center")),
   tabular.environment = getOption("xtable.tabular.environment", "tabular"),
   size = getOption("xtable.size", NULL),
-  hline.after = getOption("xtable.hline.after", c(-1,0,nrow(x))),
+  hline.after = getOption("xtable.hline.after", NULL),
   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",
+                                         sanitize.text.function),
   math.style.negative = getOption("xtable.math.style.negative", FALSE),
   math.style.exponents = getOption("xtable.math.style.exponents", FALSE),
   html.table.attributes = getOption("xtable.html.table.attributes", "border=1"),
   print.results = getOption("xtable.print.results", TRUE),
   format.args = getOption("xtable.format.args", NULL),
+  rotate.rownames = getOption("xtable.rotate.rownames", FALSE),
+  rotate.colnames = getOption("xtable.rotate.colnames", FALSE),
   booktabs = getOption("xtable.booktabs", FALSE),
   scalebox = getOption("xtable.scalebox", NULL),
   width = getOption("xtable.width", NULL),
@@ -51,4 +56,4 @@ print.xtableFtable <- function(x,
     stop("print.xtableFtable not yet implemented for this type")
   }
 }
-  
+

diff --git a/pkg/tests/test.xtable.xtableFtable.R b/pkg/tests/test.xtable.xtableFtable.R
new file mode 100644 (file)
index 0000000..f20b8bc
--- /dev/null
+++ b/pkg/tests/test.xtable.xtableFtable.R
@@ -0,0 +1,36 @@
+### Test code for xtableFtable function
+### David Scott, <d.scott@auckland.ac.nz>, 2016-01-14
+library(xtable)
+
+
+tbl <- ftable(mtcars$cyl, mtcars$vs, mtcars$am, mtcars$gear, row.vars = c(2, 4),
+              dnn = c("Cylinders", "V/S", "Transmission", "Gears"))
+xtableFtable <- function(x, caption = NULL, label = NULL, align = NULL,
+                         digits = NULL, quote = TRUE,
+                         method = c("non.compact", "row.compact",
+                                    "col.compact", "compact"),
+                         lsep = " | ", ...) {
+
+  ftbl <- stats:::format.ftable(x, quote = quote, digits = digits,
+                                method = method, lsep = lsep)
+  print(unclass(xftbl))
+  print(str(ftbl))
+  xftbl <- xtable:::xtable.matrix(ftbl,
+                         caption = caption, label = label, align = align,
+                         digits = digits, display = display, auto = auto)
+  print(unclass(ftbl))
+  print(str(xftbl))
+  xftblAttr <- attributes(xftbl)
+  class(xftbl) <- c("matrix")
+  print(attributes(xftbl))
+  print(attributes(ftbl))
+  attributes(xftbl) <- list(names = xftblAttr$names,
+                            row.names = xftblAttr$row.names,
+                            class = c("xtableFtable", "matrix"))
+
+  return(xftbl)
+}
+debug(xtableFtable)
+xftbl <- xtableFtable(tbl)
+str(xftbl)
+unclass(xftbl)