Adding support for ftable objects---still incomplete

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

diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE
index 3e815f64e34a849dc0b9f6af80144526d2fd7eae..77c56f09145921edaac0f9479737cc4fbefb9d55 100644 (file)
--- a/pkg/NAMESPACE
+++ b/pkg/NAMESPACE
@@ -7,6 +7,7 @@ export("caption<-", "caption", "label", "label<-",
        "display", "xtable",
        "xtableMatharray","xtableList", "xtableLSMeans",
        "print.xtable", "print.xtableMatharray", "print.xtableList",
+       "xtableFtable", "print.xtableFtable",
        "toLatex.xtable",
        "autoformat", "xalign", "xdigits", "xdisplay",
        "sanitize", "sanitize.numbers", "sanitize.final")
@@ -14,6 +15,7 @@ export("caption<-", "caption", "label", "label<-",
 S3method("print", "xtable")
 S3method("print", "xtableMatharray")
 S3method("print", "xtableList")
+S3method("print", "xtableFtable")
 S3method("toLatex", "xtable")
 
 S3method("caption<-", "xtable")

diff --git a/pkg/R/xtableFtable.R b/pkg/R/xtableFtable.R
new file mode 100644 (file)
index 0000000..4294169
--- /dev/null
+++ b/pkg/R/xtableFtable.R
@@ -0,0 +1,54 @@
+### ftable objects, requested by Charles Roosen
+### Feature request #2248, 2/9/2012
+xtableFtable <- function(x, caption = NULL, label = NULL, align = NULL,
+                         digits = NULL, display = NULL, auto = FALSE,
+                         quote = TRUE,
+                         method = c("non.compact", "row.compact",
+                                    "col.compact", "compact"),
+                         lsep = " | ", ...) {
+  ftbl <- format.ftable(x, quote = quote, digits = digits,
+                        method = method, lsep = lsep)
+  xftbl <- xtable.matrix(ftbl,
+                         caption = caption, label = label, align = align,
+                         digits = digits, display = display, auto = auto)
+  class(xftbl) <- c("xtableFtable", "data.frame")
+  attributes(xftbl) <- list(attributes(xftbl), attributes(ftbl))
+  return(xftbl)
+}
+                         
+print.xtableFtable <- function(x,
+  type = getOption("xtable.type", "latex"),
+  file = getOption("xtable.file", ""),
+  append = getOption("xtable.append", FALSE),
+  floating = getOption("xtable.floating", TRUE),
+  floating.environment = getOption("xtable.floating.environment", "table"),
+  table.placement = getOption("xtable.table.placement", "ht"),
+  caption.placement = getOption("xtable.caption.placement", "bottom"),
+  caption.width = getOption("xtable.caption.width", NULL),
+  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))),
+  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),
+  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),
+  booktabs = getOption("xtable.booktabs", FALSE),
+  scalebox = getOption("xtable.scalebox", NULL),
+  width = getOption("xtable.width", NULL),
+  comment = getOption("xtable.comment", TRUE),
+  timestamp = getOption("xtable.timestamp", date()),
+  ...) {
+  if (type == "latex"){
+    if (is.null(align) {
+      align <- c(rep("r", nRowVars)
+    } else {
+    stop("print.xtableFtable not yet implemented for this type")
+  }
+}
+  

diff --git a/pkg/R/xtableList.R b/pkg/R/xtableList.R
index 10b2f26b2684beab28ddaa216a261d0385af58b6..775d5c75ab24ef25bb5b11fa2cd3597fa1810a9f 100644 (file)
--- a/pkg/R/xtableList.R
+++ b/pkg/R/xtableList.R
@@ -61,6 +61,7 @@ print.xtableList <- function(x,
     getOption("xtable.sanitize.message.function",\r
               sanitize.text.function),\r
   math.style.negative = getOption("xtable.math.style.negative", FALSE),\r
+  math.style.exponents = getOption("xtable.math.style.exponents", FALSE),\r
   html.table.attributes = getOption("xtable.html.table.attributes", "border=1"),\r
   print.results = getOption("xtable.print.results", TRUE),\r
   format.args = getOption("xtable.format.args", NULL),\r
@@ -192,6 +193,7 @@ print.xtableList <- function(x,
                  sanitize.rownames.function = sanitize.rownames.function,\r
                  sanitize.colnames.function = sanitize.colnames.function,\r
                  math.style.negative = math.style.negative,\r
+                 math.style.exponents = math.style.exponents,\r
                  html.table.attributes = html.table.attributes,\r
                  print.results = print.results,\r
                  format.args = format.args,\r

diff --git a/pkg/man/xtable-internal.Rd b/pkg/man/xtable-internal.Rd
index 671ec830ad171fd92f0179b992989331bc983d78..4d86df2334e2c487a88a5469f565a90572784b24 100644 (file)
--- a/pkg/man/xtable-internal.Rd
+++ b/pkg/man/xtable-internal.Rd
@@ -2,6 +2,8 @@
 \alias{xtableList}\r
 \alias{print.xtableList}\r
 \alias{xtableLSMeans}\r
+\alias{xtableFtable}\r
+\alias{print.xtableFtable}\r
 \r
 \title{Internal xtable Functions}\r
 \description{\r