From: dscott Date: Thu, 14 Jan 2016 22:06:54 +0000 (+0000) Subject: Incomplete version of xtableFtable.R X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=4005bb787e9db4fb77391660d5e4b867868dfc54;p=xtable.git 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 4294169..31e088b 100644 --- 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 index 0000000..f20b8bc --- /dev/null +++ b/pkg/tests/test.xtable.xtableFtable.R @@ -0,0 +1,36 @@ +### Test code for xtableFtable function +### David Scott, , 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)