From e40b409036f6b7bb91b8903db3f8726049b7cdc8 Mon Sep 17 00:00:00 2001 From: dscott Date: Wed, 23 Dec 2015 07:04:20 +0000 Subject: [PATCH] Added capability for producing lists git-svn-id: svn://scm.r-forge.r-project.org/svnroot/xtable@77 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- pkg/DESCRIPTION | 2 +- pkg/NAMESPACE | 12 +- pkg/R/print.xtableList.R | 146 +++++++++++++++++ pkg/R/xtable.R | 58 ++++++- pkg/man/xtable-internal.Rd | 14 ++ pkg/vignettes/listOfTablesGallery.Rnw | 220 ++++++++++++++++++++++++++ 6 files changed, 446 insertions(+), 6 deletions(-) create mode 100644 pkg/R/print.xtableList.R create mode 100644 pkg/man/xtable-internal.Rd create mode 100644 pkg/vignettes/listOfTablesGallery.Rnw diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION index dca3e58..13199e9 100644 --- a/pkg/DESCRIPTION +++ b/pkg/DESCRIPTION @@ -5,7 +5,7 @@ Title: Export Tables to LaTeX or HTML Author: David B. Dahl Maintainer: David Scott Imports: stats, utils -Suggests: knitr +Suggests: knitr, lsmeans VignetteBuilder: knitr Description: Coerce data to LaTeX and HTML tables. URL: http://xtable.r-forge.r-project.org/ diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE index 46e2163..92f5928 100644 --- a/pkg/NAMESPACE +++ b/pkg/NAMESPACE @@ -3,13 +3,15 @@ importFrom("stats", "anova", "as.ts", "cycle", "end", "frequency", "na.omit", "pchisq", "start", "time") importFrom("utils", "packageDescription") export("caption<-", "caption", "label", "label<-", - "align<-", "align", "digits<-", "digits", "display<-", - "display", "xtable", - "print.xtable", "print.xtableMatharray","toLatex.xtable", - "autoformat", "xalign", "xdigits", "xdisplay") + "align<-", "align", "digits<-", "digits", "display<-", + "display", "xtable", "xtable.xtableList", "xtable.lsmeans", + "print.xtable", "print.xtableMatharray", "print.xtableList", + "toLatex.xtable", + "autoformat", "xalign", "xdigits", "xdisplay") S3method("print", "xtable") S3method("print", "xtableMatharray") +S3method("print", "xtableList") S3method("toLatex", "xtable") S3method("caption<-", "xtable") @@ -26,6 +28,7 @@ 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") @@ -41,3 +44,4 @@ S3method("xtable", "summary.prcomp") S3method("xtable", "coxph") S3method("xtable", "ts") S3method("xtable", "zoo") +S3method("xtable", "lsmeans") diff --git a/pkg/R/print.xtableList.R b/pkg/R/print.xtableList.R new file mode 100644 index 0000000..30139c7 --- /dev/null +++ b/pkg/R/print.xtableList.R @@ -0,0 +1,146 @@ +print.xtableList <- 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 = NULL, + NA.string = getOption("xtable.NA.string", ""), + include.rownames = getOption("xtable.include.rownames", TRUE), + include.colnames = getOption("xtable.include.colnames", TRUE), + only.contents = getOption("xtable.only.contents", FALSE), + 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), + 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), + comment = getOption("xtable.comment", TRUE), + timestamp = getOption("xtable.timestamp", date()), + colnames.format = "single", + ...) +{ + ## Get number of rows for each table in list of tables + if (booktabs){ + tRule <- "\\toprule" + mRule <- "\\midrule" + bRule <- "\\bottomrule" + } else { + tRule <- "\\hline" + mRule <- "\\hline" + bRule <- "\\hline" + } + nCols <- dim(x[[1]])[2] + rowNums <- sapply(x, dim)[1,] + combinedRowNums <- cumsum(rowNums) + combined <- do.call(rbind, x) + if (colnames.format == "single"){ + add.to.row <- list(pos = NULL, command = NULL) + add.to.row$pos <- as.list(c(0, combinedRowNums[-length(x)], + dim(combined)[1])) + command <- sapply(x, attr, "subheading") + + add.to.row$command[1:length(x)] <- + paste0(mRule,"\n\\multicolumn{", nCols, "}{l}{", command, "}\\\\\n") + if ( (booktabs) & length(attr(x, "message") > 0) ){ + attr(x, "message")[1] <- + paste0("\\rule{0em}{2.5ex}", attr(x, "message")[1]) + } + add.to.row$command[length(x) + 1] <- + paste0("\n\\multicolumn{", nCols, "}{l}{", attr(x, "message"), "}\\\\\n", + collapse = "") + add.to.row$command[length(x) + 1] <- + paste0(bRule, add.to.row$command[length(x) + 1]) + + class(combined) <- c("xtableList", "data.frame") + hline.after <- c(-1) + include.colnames <- TRUE + } + + if (colnames.format == "multiple"){ + if (is.null(sanitize.colnames.function)) { + colHead <- names(x[[1]]) + } else { + colHead <- sanitize.colnames.function(names(x[[1]])) + } + if (rotate.colnames) { + colHead <- paste("\\begin{sideways}", colHead, "\\end{sideways}") + } + colHead <- paste0(colHead, collapse = " & ") + colHead <- paste0(tRule, "\n", colHead, " \\\\", mRule, "\n") + add.to.row <- list(pos = NULL, command = NULL) + add.to.row$pos <- as.list(c(0, c(combinedRowNums[1:length(x)]))) + command <- sapply(x, attr, "subheading") + add.to.row$command[1] <- + paste0("\n\\multicolumn{", nCols, "}{l}{", command[1], "}", " \\\\ \n", + colHead) + add.to.row$command[2:length(x)] <- + paste0(bRule, + "\\\\ \n\\multicolumn{", nCols, "}{l}{", + command[2:length(x)], "}", + "\\\\ \n", + colHead) + if ( (booktabs) & length(attr(x, "message") > 0) ){ + attr(x, "message")[1] <- + paste0("\\rule{0em}{2.5ex}", attr(x, "message")[1]) + } + add.to.row$command[length(x) + 1] <- + paste0("\n\\multicolumn{", nCols, "}{l}{", attr(x, "message"), "}\\\\\n", + collapse = "") + add.to.row$command[length(x) + 1] <- + paste0(bRule, add.to.row$command[length(x) + 1]) + + class(combined) <- c("xtableList", "data.frame") + hline.after <- NULL + + include.colnames <- FALSE + } + + print.xtable(combined, + type = type, + floating = floating, + floating.environment = floating.environment, + table.placement = table.placement, + caption.placement = caption.placement, + caption.width = caption.width, + latex.environments = latex.environments, + tabular.environment = tabular.environment, + size = size, + hline.after = hline.after, + NA.string = NA.string, + include.rownames = include.rownames, + include.colnames = include.colnames, + only.contents = only.contents, + add.to.row = add.to.row, + sanitize.text.function = sanitize.text.function, + sanitize.rownames.function = sanitize.rownames.function, + sanitize.colnames.function = sanitize.colnames.function, + math.style.negative = math.style.negative, + html.table.attributes = html.table.attributes, + print.results = print.results, + format.args = format.args, + rotate.rownames = rotate.rownames, + rotate.colnames = rotate.colnames, + booktabs = booktabs, + scalebox = scalebox, + width = width, + comment = comment, + timestamp = timestamp, + ...) + +} diff --git a/pkg/R/xtable.R b/pkg/R/xtable.R index e3c1e04..396f6fe 100644 --- a/pkg/R/xtable.R +++ b/pkg/R/xtable.R @@ -314,8 +314,64 @@ xtable.ts <- function(x, caption = NULL, label = NULL, align = NULL, digits = digits, display = display, auto = auto)) } -# Suggested by Ajay Narottam Shah in e-mail 2006/07/22 +### Suggested by Ajay Narottam Shah in e-mail 2006/07/22 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/man/xtable-internal.Rd b/pkg/man/xtable-internal.Rd new file mode 100644 index 0000000..3d5198b --- /dev/null +++ b/pkg/man/xtable-internal.Rd @@ -0,0 +1,14 @@ +\name{xtable-internal} +\alias{xtable.xtableList} +\alias{print.xtableList} +\alias{xtable.lsmeans} + +\title{Internal xtable Functions} +\description{ + Internal functions for the package xtable +} +\details{ + Functions which are either not intended to be called by the user or + are waiting to be documented. +} +\keyword{ internal } \ No newline at end of file diff --git a/pkg/vignettes/listOfTablesGallery.Rnw b/pkg/vignettes/listOfTablesGallery.Rnw new file mode 100644 index 0000000..34fbd38 --- /dev/null +++ b/pkg/vignettes/listOfTablesGallery.Rnw @@ -0,0 +1,220 @@ +%\VignetteIndexEntry{xtable List of Tables Gallery} +%\VignetteDepends{xtable, lsmeans} +%\VignetteKeywords{LaTeX, HTML, table} +%\VignettePackage{xtable} +% !Rnw weave = knitr +% \VignetteEngine{knitr::knitr} +%************************************************************************** +\documentclass{article} +\usepackage[a4paper,height=24cm]{geometry} % geometry first +\usepackage{array} +\usepackage{booktabs} +\usepackage{longtable} +\usepackage{parskip} +\usepackage{rotating} +\usepackage{tabularx} +\usepackage{titlesec} +\usepackage{hyperref} % hyperref last +\titleformat\subsubsection{\bfseries\itshape}{}{0pt}{} +\newcommand\p{\vspace{2ex}} +\newcommand\code[1]{\texttt{#1}} +\newcommand\pkg[1]{\textbf{#1}} +\setcounter{tocdepth}{2} +\begin{document} + +\title{The \code{xtableList} Gallery} +\author{David J. Scott} +\maketitle + +\tableofcontents + +\newpage + +\section{Introduction} +This document represents a test of the functions in \pkg{xtable} which +deal with lists of dataframes. + +<>= +library(knitr) +opts_chunk$set(fig.path='Figures/list', debug=TRUE, echo=TRUE) +opts_chunk$set(out.width='0.9\\textwidth') +@ + +The first step is to load the package and set some options for this document. +<>= +library(xtable) +options(xtable.floating = FALSE) +options(xtable.timestamp = "") +options(width = 60) +@ + + +Next we create a list of dataframes with attributes. + +<>= +require(xtable) +data(mtcars) +mtcars <- mtcars[, 1:6] +mtcarsList <- split(mtcars, f = mtcars$cyl) +### Reduce the size of the list elements +mtcarsList[[1]] <- mtcarsList[[1]][1,] +mtcarsList[[2]] <- mtcarsList[[2]][1:2,] +mtcarsList[[3]] <- mtcarsList[[3]][1:3,] +attr(mtcarsList, "subheadings") <- paste0("Number of cylinders = ", + names(mtcarsList)) +attr(mtcarsList, "message") <- c("Line 1 of Message", + "Line 2 of Message") +str(mtcarsList) +attributes(mtcarsList) +@ %def + +Now create a list of \code{xtable} objects. + + +<>= +xList <- xtable.xtableList(mtcarsList) +str(xList) +@ %def + +Create an alternative version where the lists have different values +for \code{digits}. + + +<>= +xList1 <- xtable.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), + caption = "Caption to List", + label = "tbl:xtableList") +str(xList2) +@ %def + +\newpage + +\section{Single Column Names} +\label{sec:single-column-names} + +Print the list of \code{xtable} objects with a single header of the +column names. + +First the default. + + +<>= +print.xtableList(xList) +@ %def + +Booktabs should work. +<>= +print.xtableList(xList, booktabs = TRUE) +@ %def + +With digits being specified. +<>= +print.xtableList(xList1, booktabs = TRUE) +@ %def + +Row and column names can be sanitized. + +<>= +large <- function(x){ + paste0('{\\Large{\\bfseries ', x, '}}') +} +italic <- function(x){ + paste0('{\\emph{ ', x, '}}') +} +@ %def + + +<>= +print.xtableList(xList, + sanitize.rownames.function = italic, + sanitize.colnames.function = large, + booktabs = TRUE) +@ %def + +A label and caption can be added. +<>= +print.xtableList(xList2, floating = TRUE) +@ %def + +Rotated column names? +<>= +print.xtableList(xList, rotate.colnames = TRUE) +@ %def + +\section{Multiple Column Names} +\label{sec:multiple-column-names} + +Print the list of \code{xtable} objects with multiple headers of the +column names. + +First the default with multiple column name headers. + +<>= +print.xtableList(xList, colnames.format = "multiple") +@ %def + +Using booktabs: + +<>= +print.xtableList(xList, colnames.format = "multiple", + booktabs = TRUE) +@ %def + +With sanitization. +<>= +print.xtableList(xList, colnames.format = "multiple", + sanitize.rownames.function = italic, + sanitize.colnames.function = large, + booktabs = TRUE) +@ %def + +A label and caption can be added. +<>= +print.xtableList(xList2, colnames.format = "multiple", + floating = TRUE) +@ %def + +Rotated column names? +<>= +print.xtableList(xList, colnames.format = "multiple", + rotate.colnames = TRUE) +@ %def + +\section{lsmeans} +\label{sec:lsmeans} + +Summaries from the \code{lsmeans} function from the \pkg{lsmeans} +package can easily be produced. + + +<>= +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)) +str(warp.xtblList) +@ %def + +<>= +print.xtableList(warp.xtblList, colnames.format = "multiple", + include.rownames = FALSE) +@ %def +<>= +print.xtableList(warp.xtblList, colnames.format = "multiple", + include.rownames = FALSE) +@ %def +\p +<>= +print.xtableList(warp.xtblList, colnames.format = "multiple", + booktabs = TRUE, + include.rownames = FALSE) +@ %def + + +\end{document} -- 2.39.5