From ab84b5c02505bcf3b8ba7c25fd1bc676da446ea5 Mon Sep 17 00:00:00 2001 From: dscott Date: Thu, 24 Dec 2015 10:26:56 +0000 Subject: [PATCH] Changed functions dealing with mathematical arrays and lists from xtable methods to functions xtableMatharray and xtableList git-svn-id: svn://scm.r-forge.r-project.org/svnroot/xtable@78 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- pkg/NAMESPACE | 6 +- pkg/R/print.xtableMatharray.R | 20 ------ pkg/R/xtable.R | 71 +--------------------- pkg/R/{print.xtableList.R => xtableList.R} | 59 ++++++++++++++++++ pkg/R/xtableMatharray.R | 36 +++++++++++ pkg/man/print.xtableMatharray.Rd | 8 +-- pkg/man/xtable-internal.Rd | 5 +- pkg/man/xtable.Rd | 14 ++++- pkg/tests/test.matharray.R | 8 +-- pkg/vignettes/listOfTablesGallery.Rnw | 8 +-- 10 files changed, 124 insertions(+), 111 deletions(-) delete mode 100644 pkg/R/print.xtableMatharray.R rename pkg/R/{print.xtableList.R => xtableList.R} (72%) create mode 100644 pkg/R/xtableMatharray.R diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE index 92f5928..e316a48 100644 --- a/pkg/NAMESPACE +++ b/pkg/NAMESPACE @@ -4,7 +4,8 @@ importFrom("stats", "anova", "as.ts", "cycle", "end", "frequency", importFrom("utils", "packageDescription") export("caption<-", "caption", "label", "label<-", "align<-", "align", "digits<-", "digits", "display<-", - "display", "xtable", "xtable.xtableList", "xtable.lsmeans", + "display", "xtable", + "xtableMatharray","xtableList", "xtablelsmeans", "print.xtable", "print.xtableMatharray", "print.xtableList", "toLatex.xtable", "autoformat", "xalign", "xdigits", "xdisplay") @@ -27,8 +28,6 @@ S3method("display", "xtable") S3method("xtable", "data.frame") S3method("xtable", "matrix") -S3method("xtable", "xtableMatharray") -S3method("xtable", "xtableList") S3method("xtable", "table") S3method("xtable", "anova") S3method("xtable", "aov") @@ -44,4 +43,3 @@ S3method("xtable", "summary.prcomp") S3method("xtable", "coxph") S3method("xtable", "ts") S3method("xtable", "zoo") -S3method("xtable", "lsmeans") diff --git a/pkg/R/print.xtableMatharray.R b/pkg/R/print.xtableMatharray.R deleted file mode 100644 index 5c83175..0000000 --- a/pkg/R/print.xtableMatharray.R +++ /dev/null @@ -1,20 +0,0 @@ -print.xtableMatharray <- function(x, - print.results = TRUE, - format.args = getOption("xtable.format.args", NULL), - scalebox = getOption("xtable.scalebox", NULL), - comment = FALSE, - timestamp = NULL, - ...) -{ - class(x) <- c("xtableMatharray","data.frame") - print.xtable(x, floating = FALSE, - tabular.environment = 'array', - include.rownames = FALSE, include.colnames = FALSE, - hline.after = NULL, - print.results = print.results, - format.args = format.args, - scalebox = scalebox, - comment = comment, - timestamp = timestamp, - ...) -} diff --git a/pkg/R/xtable.R b/pkg/R/xtable.R index 396f6fe..f46da90 100644 --- a/pkg/R/xtable.R +++ b/pkg/R/xtable.R @@ -67,21 +67,7 @@ xtable.matrix <- function(x, caption = NULL, label = NULL, align = NULL, ...)) } -### xtableMatharray object -### To deal with numeric arrays such as a variance-covariance matrix -### From a request by James Curran, 16 October 2015 -xtable.xtableMatharray <- function(x, caption = NULL, label = NULL, - align = NULL, digits = NULL, - display = NULL, auto = FALSE, - ...) { - class(x) <- c("xtableMatharray","matrix") - xtbl <- xtable.matrix(x, - caption = caption, label = label, align = align, - digits = digits, display = display, auto = auto, - ...) - class(xtbl) <- c("xtableMatharray","xtable","data.frame") - return(xtbl) -} + ### table objects (of 1 or 2 dimensions) by Guido Gay, 9 Feb 2007 ### Fixed to pass R checks by DBD, 9 May 2007 @@ -319,59 +305,4 @@ xtable.zoo <- function(x, ...) { return(xtable(as.ts(x), ...)) } -### Function to create lists of tables -xtable.xtableList <- function(x, caption = NULL, label = NULL, align = NULL, - digits = NULL, display = NULL, ...) { - if (is.null(digits)){ - digitsList <- vector("list", length(x)) - } else { - if (!is.list(digits)){ - digitsList <- vector("list", length(x)) - for (i in 1:length(x)) digitsList[[i]] <- digits - } - } - if (is.null(display)){ - displayList <- vector("list", length(x)) - } else { - if (!is.list(display)){ - displayList <- vector("list", length(x)) - for (i in 1:length(x)) displayList[[i]] <- display - } - } - xList <- vector("list", length(x)) - for (i in 1:length(x)){ - xList[[i]] <- xtable(x[[i]], caption = caption, label = label, - align = align, digits = digitsList[[i]], - display = displayList[[i]], ...) - attr(xList[[i]], 'subheading') <- attr(x, 'subheadings')[[i]] - } - attr(xList, "message") <- attr(x, "message") - attr(xList, "caption") <- caption - attr(xList, "label") <- label - return(xList) -} -### Uses xtable.xtableList -xtable.lsmeans <- function(x, caption = NULL, label = NULL, - align = NULL, digits = NULL, - display = NULL, auto = FALSE, - ...){ - if (attr(x, "estName") == "lsmean"){ - xList <- split(x, f = x[, 2]) - for (i in 1:length(xList)){ - xList[[i]] <- as.data.frame(xList[[i]][, -2]) - } - attr(xList, "subheadings") <- - paste0(dimnames(x)[[2]][2], " = ", levels(x[[2]])) - attr(xList, "message") <- c("", attr(x, "mesg")) - xList <- xtable.xtableList(xList, caption =caption, label = label, - align = align, digits = digits, - display = display, auto = auto, ...) - } else { - xList <- x - xList <- xtable.data.frame(xList, caption =caption, label = label, - align = align, digits = digits, - display = display, auto = auto, ...) - } - return(xList) -} diff --git a/pkg/R/print.xtableList.R b/pkg/R/xtableList.R similarity index 72% rename from pkg/R/print.xtableList.R rename to pkg/R/xtableList.R index 30139c7..4ed695c 100644 --- a/pkg/R/print.xtableList.R +++ b/pkg/R/xtableList.R @@ -1,3 +1,36 @@ +### Function to create lists of tables +xtableList <- function(x, caption = NULL, label = NULL, align = NULL, + digits = NULL, display = NULL, ...) { + if (is.null(digits)){ + digitsList <- vector("list", length(x)) + } else { + if (!is.list(digits)){ + digitsList <- vector("list", length(x)) + for (i in 1:length(x)) digitsList[[i]] <- digits + } + } + if (is.null(display)){ + displayList <- vector("list", length(x)) + } else { + if (!is.list(display)){ + displayList <- vector("list", length(x)) + for (i in 1:length(x)) displayList[[i]] <- display + } + } + xList <- vector("list", length(x)) + for (i in 1:length(x)){ + xList[[i]] <- xtable(x[[i]], caption = caption, label = label, + align = align, digits = digitsList[[i]], + display = displayList[[i]], ...) + attr(xList[[i]], 'subheading') <- attr(x, 'subheadings')[[i]] + } + attr(xList, "message") <- attr(x, "message") + attr(xList, "caption") <- caption + attr(xList, "label") <- label + class(xList) <- c("xtableList", "data.frame") + return(xList) +} + print.xtableList <- function(x, type = getOption("xtable.type", "latex"), file = getOption("xtable.file", ""), @@ -144,3 +177,29 @@ print.xtableList <- function(x, ...) } + + +### Uses xtableList +xtablelsmeans <- function(x, caption = NULL, label = NULL, + align = NULL, digits = NULL, + display = NULL, auto = FALSE, + ...){ + if (attr(x, "estName") == "lsmean"){ + xList <- split(x, f = x[, 2]) + for (i in 1:length(xList)){ + xList[[i]] <- as.data.frame(xList[[i]][, -2]) + } + attr(xList, "subheadings") <- + paste0(dimnames(x)[[2]][2], " = ", levels(x[[2]])) + attr(xList, "message") <- c("", attr(x, "mesg")) + xList <- xtableList(xList, caption = caption, label = label, + align = align, digits = digits, + display = display, auto = auto, ...) + } else { + xList <- x + xList <- xtable.data.frame(xList, caption = caption, label = label, + align = align, digits = digits, + display = display, auto = auto, ...) + } + return(xList) +} diff --git a/pkg/R/xtableMatharray.R b/pkg/R/xtableMatharray.R new file mode 100644 index 0000000..c782f59 --- /dev/null +++ b/pkg/R/xtableMatharray.R @@ -0,0 +1,36 @@ +### xtableMatharray object +### To deal with numeric arrays such as a variance-covariance matrix +### From a request by James Curran, 16 October 2015 +xtableMatharray <- function(x, caption = NULL, label = NULL, + align = NULL, digits = NULL, + display = NULL, auto = FALSE, + ...) { + class(x) <- c("xtableMatharray","matrix") + xtbl <- xtable.matrix(x, + caption = caption, label = label, align = align, + digits = digits, display = display, auto = auto, + ...) + class(xtbl) <- c("xtableMatharray","xtable","data.frame") + return(xtbl) +} + +print.xtableMatharray <- function(x, + print.results = TRUE, + format.args = getOption("xtable.format.args", NULL), + scalebox = getOption("xtable.scalebox", NULL), + comment = FALSE, + timestamp = NULL, + ...) +{ + class(x) <- c("xtableMatharray","data.frame") + print.xtable(x, floating = FALSE, + tabular.environment = 'array', + include.rownames = FALSE, include.colnames = FALSE, + hline.after = NULL, + print.results = print.results, + format.args = format.args, + scalebox = scalebox, + comment = comment, + timestamp = timestamp, + ...) +} diff --git a/pkg/man/print.xtableMatharray.Rd b/pkg/man/print.xtableMatharray.Rd index e725f93..b521e26 100644 --- a/pkg/man/print.xtableMatharray.Rd +++ b/pkg/man/print.xtableMatharray.Rd @@ -70,21 +70,21 @@ class(V) <- c("xtableMatharray") class(V) ### Test without any additional arguments -mth <- xtable(V) +mth <- xtableMatharray(V) str(mth) print(mth) ### Test with arguments to xtable -mth <- xtable(V, display = rep("E", 4)) +mth <- xtableMatharray(V, display = rep("E", 4)) str(mth) print(mth) -mth <- xtable(V, digits = 6) +mth <- xtableMatharray(V, digits = 6) str(mth) print(mth) ### Test with additional print.xtableMatharray arguments -mth <- xtable(V, digits = 6) +mth <- xtableMatharray(V, digits = 6) str(mth) print(mth, format.args = list(decimal.mark = ",")) print(mth, scalebox = 0.5) diff --git a/pkg/man/xtable-internal.Rd b/pkg/man/xtable-internal.Rd index 3d5198b..67f479f 100644 --- a/pkg/man/xtable-internal.Rd +++ b/pkg/man/xtable-internal.Rd @@ -1,7 +1,8 @@ \name{xtable-internal} -\alias{xtable.xtableList} +\alias{xtableMatharray} +\alias{xtableList} \alias{print.xtableList} -\alias{xtable.lsmeans} +\alias{xtablelsmeans} \title{Internal xtable Functions} \description{ diff --git a/pkg/man/xtable.Rd b/pkg/man/xtable.Rd index 33bb8cd..f6a5af5 100644 --- a/pkg/man/xtable.Rd +++ b/pkg/man/xtable.Rd @@ -18,6 +18,7 @@ \alias{xtable.ts} \alias{xtable.table} \alias{xtable.zoo} +\alias{xtable.xtableList} \title{Create Export Tables} \description{ Convert an R object to an \code{xtable} object, which can @@ -111,9 +112,16 @@ xtable(x, caption = NULL, label = NULL, align = NULL, digits = NULL, have attributes \code{caption} and \code{label}, but must have attributes \code{align}, \code{digits}, and \code{display}. } -\value{An object of class \code{"xtable"} which inherits the - \code{data.frame} class and contains several additional attributes - specifying the table formatting options. +\value{ + For most \code{xtable} methods, an object of class \code{"xtable"} + which inherits the \code{data.frame} class and contains several + additional attributes specifying the table formatting options. + + In the case of the \code{xtableMatharray} method, an object of class + \code{xtableMatharray}, which the \code{xtable} and \code{data.frame} + classes and contains several additional attributes specifying the + table formatting options. + } \author{David Dahl \email{dahl@stat.byu.edu} with contributions and suggestions from many others (see source code). diff --git a/pkg/tests/test.matharray.R b/pkg/tests/test.matharray.R index 3f51aa2..172ff92 100644 --- a/pkg/tests/test.matharray.R +++ b/pkg/tests/test.matharray.R @@ -9,21 +9,21 @@ class(V) <- c("xtableMatharray") class(V) ### Test without any additional arguments -mth <- xtable(V) +mth <- xtableMatharray(V) str(mth) print(mth) ### Test with arguments to xtable -mth <- xtable(V, display = rep("E", 4)) +mth <- xtableMatharray(V, display = rep("E", 4)) str(mth) print(mth) -mth <- xtable(V, digits = 6) +mth <- xtableMatharray(V, digits = 6) str(mth) print(mth) ### Test with additional print.xtableMatharray arguments -mth <- xtable(V, digits = 6) +mth <- xtableMatharray(V, digits = 6) str(mth) print(mth, format.args = list(decimal.mark = ",")) print(mth, scalebox = 0.5) diff --git a/pkg/vignettes/listOfTablesGallery.Rnw b/pkg/vignettes/listOfTablesGallery.Rnw index 34fbd38..be627e6 100644 --- a/pkg/vignettes/listOfTablesGallery.Rnw +++ b/pkg/vignettes/listOfTablesGallery.Rnw @@ -72,7 +72,7 @@ Now create a list of \code{xtable} objects. <>= -xList <- xtable.xtableList(mtcarsList) +xList <- xtableList(mtcarsList) str(xList) @ %def @@ -81,12 +81,12 @@ for \code{digits}. <>= -xList1 <- xtable.xtableList(mtcarsList, digits = c(0,2,0,0,0,1,2)) +xList1 <- xtableList(mtcarsList, digits = c(0,2,0,0,0,1,2)) str(xList1) @ %def <>= -xList2 <- xtable.xtableList(mtcarsList, digits = c(0,2,0,0,0,1,2), +xList2 <- xtableList(mtcarsList, digits = c(0,2,0,0,0,1,2), caption = "Caption to List", label = "tbl:xtableList") str(xList2) @@ -197,7 +197,7 @@ library(lsmeans) warp.lm <- lm(breaks ~ wool*tension, data = warpbreaks) warp.lsm <- lsmeans(warp.lm, ~ tension | wool) warp.sum <- summary(warp.lsm, adjust = "mvt") -warp.xtblList <- xtable.lsmeans(warp.sum, digits = c(0,0,2,2,0,2,2)) +warp.xtblList <- xtablelsmeans(warp.sum, digits = c(0,0,2,2,0,2,2)) str(warp.xtblList) @ %def -- 2.39.5