Author: David B. Dahl <dahl@stat.byu.edu>
Maintainer: David Scott <d.scott@auckland.ac.nz>
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/
"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")
S3method("xtable", "data.frame")
S3method("xtable", "matrix")
S3method("xtable", "xtableMatharray")
+S3method("xtable", "xtableList")
S3method("xtable", "table")
S3method("xtable", "anova")
S3method("xtable", "aov")
S3method("xtable", "coxph")
S3method("xtable", "ts")
S3method("xtable", "zoo")
+S3method("xtable", "lsmeans")
--- /dev/null
+print.xtableList <- function(x,\r
+ type = getOption("xtable.type", "latex"),\r
+ file = getOption("xtable.file", ""),\r
+ append = getOption("xtable.append", FALSE),\r
+ floating = getOption("xtable.floating", TRUE),\r
+ floating.environment = getOption("xtable.floating.environment", "table"),\r
+ table.placement = getOption("xtable.table.placement", "ht"),\r
+ caption.placement = getOption("xtable.caption.placement", "bottom"),\r
+ caption.width = getOption("xtable.caption.width", NULL),\r
+ latex.environments = getOption("xtable.latex.environments", c("center")),\r
+ tabular.environment = getOption("xtable.tabular.environment", "tabular"),\r
+ size = getOption("xtable.size", NULL),\r
+ hline.after = NULL,\r
+ NA.string = getOption("xtable.NA.string", ""),\r
+ include.rownames = getOption("xtable.include.rownames", TRUE),\r
+ include.colnames = getOption("xtable.include.colnames", TRUE),\r
+ only.contents = getOption("xtable.only.contents", FALSE),\r
+ add.to.row = NULL,\r
+ sanitize.text.function = getOption("xtable.sanitize.text.function", NULL),\r
+ sanitize.rownames.function = getOption("xtable.sanitize.rownames.function",\r
+ sanitize.text.function),\r
+ sanitize.colnames.function = getOption("xtable.sanitize.colnames.function",\r
+ sanitize.text.function),\r
+ math.style.negative = getOption("xtable.math.style.negative", 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
+ rotate.rownames = getOption("xtable.rotate.rownames", FALSE),\r
+ rotate.colnames = getOption("xtable.rotate.colnames", FALSE),\r
+ booktabs = getOption("xtable.booktabs", FALSE),\r
+ scalebox = getOption("xtable.scalebox", NULL),\r
+ width = getOption("xtable.width", NULL),\r
+ comment = getOption("xtable.comment", TRUE),\r
+ timestamp = getOption("xtable.timestamp", date()),\r
+ colnames.format = "single",\r
+ ...)\r
+{\r
+ ## Get number of rows for each table in list of tables\r
+ if (booktabs){\r
+ tRule <- "\\toprule"\r
+ mRule <- "\\midrule"\r
+ bRule <- "\\bottomrule"\r
+ } else {\r
+ tRule <- "\\hline"\r
+ mRule <- "\\hline"\r
+ bRule <- "\\hline"\r
+ }\r
+ nCols <- dim(x[[1]])[2]\r
+ rowNums <- sapply(x, dim)[1,]\r
+ combinedRowNums <- cumsum(rowNums)\r
+ combined <- do.call(rbind, x)\r
+ if (colnames.format == "single"){\r
+ add.to.row <- list(pos = NULL, command = NULL)\r
+ add.to.row$pos <- as.list(c(0, combinedRowNums[-length(x)],\r
+ dim(combined)[1]))\r
+ command <- sapply(x, attr, "subheading")\r
+\r
+ add.to.row$command[1:length(x)] <-\r
+ paste0(mRule,"\n\\multicolumn{", nCols, "}{l}{", command, "}\\\\\n")\r
+ if ( (booktabs) & length(attr(x, "message") > 0) ){\r
+ attr(x, "message")[1] <-\r
+ paste0("\\rule{0em}{2.5ex}", attr(x, "message")[1])\r
+ }\r
+ add.to.row$command[length(x) + 1] <-\r
+ paste0("\n\\multicolumn{", nCols, "}{l}{", attr(x, "message"), "}\\\\\n",\r
+ collapse = "")\r
+ add.to.row$command[length(x) + 1] <-\r
+ paste0(bRule, add.to.row$command[length(x) + 1])\r
+\r
+ class(combined) <- c("xtableList", "data.frame")\r
+ hline.after <- c(-1)\r
+ include.colnames <- TRUE\r
+ }\r
+\r
+ if (colnames.format == "multiple"){\r
+ if (is.null(sanitize.colnames.function)) {\r
+ colHead <- names(x[[1]])\r
+ } else {\r
+ colHead <- sanitize.colnames.function(names(x[[1]]))\r
+ }\r
+ if (rotate.colnames) {\r
+ colHead <- paste("\\begin{sideways}", colHead, "\\end{sideways}")\r
+ }\r
+ colHead <- paste0(colHead, collapse = " & ")\r
+ colHead <- paste0(tRule, "\n", colHead, " \\\\", mRule, "\n")\r
+ add.to.row <- list(pos = NULL, command = NULL)\r
+ add.to.row$pos <- as.list(c(0, c(combinedRowNums[1:length(x)])))\r
+ command <- sapply(x, attr, "subheading")\r
+ add.to.row$command[1] <-\r
+ paste0("\n\\multicolumn{", nCols, "}{l}{", command[1], "}", " \\\\ \n",\r
+ colHead)\r
+ add.to.row$command[2:length(x)] <-\r
+ paste0(bRule,\r
+ "\\\\ \n\\multicolumn{", nCols, "}{l}{",\r
+ command[2:length(x)], "}",\r
+ "\\\\ \n",\r
+ colHead)\r
+ if ( (booktabs) & length(attr(x, "message") > 0) ){\r
+ attr(x, "message")[1] <-\r
+ paste0("\\rule{0em}{2.5ex}", attr(x, "message")[1])\r
+ }\r
+ add.to.row$command[length(x) + 1] <-\r
+ paste0("\n\\multicolumn{", nCols, "}{l}{", attr(x, "message"), "}\\\\\n",\r
+ collapse = "")\r
+ add.to.row$command[length(x) + 1] <-\r
+ paste0(bRule, add.to.row$command[length(x) + 1])\r
+\r
+ class(combined) <- c("xtableList", "data.frame")\r
+ hline.after <- NULL\r
+\r
+ include.colnames <- FALSE\r
+ }\r
+\r
+ print.xtable(combined,\r
+ type = type,\r
+ floating = floating,\r
+ floating.environment = floating.environment,\r
+ table.placement = table.placement,\r
+ caption.placement = caption.placement,\r
+ caption.width = caption.width,\r
+ latex.environments = latex.environments,\r
+ tabular.environment = tabular.environment,\r
+ size = size,\r
+ hline.after = hline.after,\r
+ NA.string = NA.string,\r
+ include.rownames = include.rownames,\r
+ include.colnames = include.colnames,\r
+ only.contents = only.contents,\r
+ add.to.row = add.to.row,\r
+ sanitize.text.function = sanitize.text.function,\r
+ sanitize.rownames.function = sanitize.rownames.function,\r
+ sanitize.colnames.function = sanitize.colnames.function,\r
+ math.style.negative = math.style.negative,\r
+ html.table.attributes = html.table.attributes,\r
+ print.results = print.results,\r
+ format.args = format.args,\r
+ rotate.rownames = rotate.rownames,\r
+ rotate.colnames = rotate.colnames,\r
+ booktabs = booktabs,\r
+ scalebox = scalebox,\r
+ width = width,\r
+ comment = comment,\r
+ timestamp = timestamp,\r
+ ...)\r
+\r
+}\r
digits = digits, display = display, auto = auto))
}
-# Suggested by Ajay Narottam Shah <ajayshah@mayin.org> in e-mail 2006/07/22
+#
## Suggested by Ajay Narottam Shah <ajayshah@mayin.org> 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)
+}
--- /dev/null
+\name{xtable-internal}\r
+\alias{xtable.xtableList}\r
+\alias{print.xtableList}\r
+\alias{xtable.lsmeans}\r
+\r
+\title{Internal xtable Functions}\r
+\description{\r
+ Internal functions for the package xtable\r
+}\r
+\details{\r
+ Functions which are either not intended to be called by the user or\r
+ are waiting to be documented.\r
+}\r
+\keyword{ internal }
\ No newline at end of file
--- /dev/null
+%\VignetteIndexEntry{xtable List of Tables Gallery}\r
+%\VignetteDepends{xtable, lsmeans}\r
+%\VignetteKeywords{LaTeX, HTML, table}\r
+%\VignettePackage{xtable}\r
+% !Rnw weave = knitr\r
+% \VignetteEngine{knitr::knitr}\r
+%**************************************************************************\r
+\documentclass{article}\r
+\usepackage[a4paper,height=24cm]{geometry} % geometry first\r
+\usepackage{array}\r
+\usepackage{booktabs}\r
+\usepackage{longtable}\r
+\usepackage{parskip}\r
+\usepackage{rotating}\r
+\usepackage{tabularx}\r
+\usepackage{titlesec}\r
+\usepackage{hyperref} % hyperref last\r
+\titleformat\subsubsection{\bfseries\itshape}{}{0pt}{}\r
+\newcommand\p{\vspace{2ex}}\r
+\newcommand\code[1]{\texttt{#1}}\r
+\newcommand\pkg[1]{\textbf{#1}}\r
+\setcounter{tocdepth}{2}\r
+\begin{document}\r
+\r
+\title{The \code{xtableList} Gallery}\r
+\author{David J. Scott}\r
+\maketitle\r
+\r
+\tableofcontents\r
+\r
+\newpage\r
+\r
+\section{Introduction}\r
+This document represents a test of the functions in \pkg{xtable} which\r
+deal with lists of dataframes.\r
+\r
+<<set, include=FALSE>>=\r
+library(knitr)\r
+opts_chunk$set(fig.path='Figures/list', debug=TRUE, echo=TRUE)\r
+opts_chunk$set(out.width='0.9\\textwidth')\r
+@\r
+\r
+The first step is to load the package and set some options for this document.\r
+<<package, results='asis'>>=\r
+library(xtable)\r
+options(xtable.floating = FALSE)\r
+options(xtable.timestamp = "")\r
+options(width = 60)\r
+@\r
+\r
+\r
+Next we create a list of dataframes with attributes.\r
+\r
+<<data>>=\r
+require(xtable)\r
+data(mtcars)\r
+mtcars <- mtcars[, 1:6]\r
+mtcarsList <- split(mtcars, f = mtcars$cyl)\r
+### Reduce the size of the list elements\r
+mtcarsList[[1]] <- mtcarsList[[1]][1,]\r
+mtcarsList[[2]] <- mtcarsList[[2]][1:2,]\r
+mtcarsList[[3]] <- mtcarsList[[3]][1:3,]\r
+attr(mtcarsList, "subheadings") <- paste0("Number of cylinders = ",\r
+ names(mtcarsList))\r
+attr(mtcarsList, "message") <- c("Line 1 of Message",\r
+ "Line 2 of Message")\r
+str(mtcarsList)\r
+attributes(mtcarsList)\r
+@ %def\r
+\r
+Now create a list of \code{xtable} objects.\r
+\r
+\r
+<<xtablelist>>=\r
+xList <- xtable.xtableList(mtcarsList)\r
+str(xList)\r
+@ %def\r
+\r
+Create an alternative version where the lists have different values\r
+for \code{digits}.\r
+\r
+\r
+<<xtablelist1>>=\r
+xList1 <- xtable.xtableList(mtcarsList, digits = c(0,2,0,0,0,1,2))\r
+str(xList1)\r
+@ %def\r
+\r
+<<xtablelist2>>=\r
+xList2 <- xtable.xtableList(mtcarsList, digits = c(0,2,0,0,0,1,2),\r
+ caption = "Caption to List",\r
+ label = "tbl:xtableList")\r
+str(xList2)\r
+@ %def\r
+\r
+\newpage\r
+\r
+\section{Single Column Names}\r
+\label{sec:single-column-names}\r
+\r
+Print the list of \code{xtable} objects with a single header of the\r
+column names.\r
+\r
+First the default.\r
+\r
+\r
+<<singledefault, results='asis'>>=\r
+print.xtableList(xList)\r
+@ %def\r
+\r
+Booktabs should work.\r
+<<singlebooktabs, results='asis'>>=\r
+print.xtableList(xList, booktabs = TRUE)\r
+@ %def\r
+\r
+With digits being specified.\r
+<<singlebooktabs1, results='asis'>>=\r
+print.xtableList(xList1, booktabs = TRUE)\r
+@ %def\r
+\r
+Row and column names can be sanitized.\r
+\r
+<<sanitize>>=\r
+large <- function(x){\r
+ paste0('{\\Large{\\bfseries ', x, '}}')\r
+}\r
+italic <- function(x){\r
+ paste0('{\\emph{ ', x, '}}')\r
+}\r
+@ %def\r
+\r
+\r
+<<sanitizesingle, results='asis'>>=\r
+print.xtableList(xList,\r
+ sanitize.rownames.function = italic,\r
+ sanitize.colnames.function = large,\r
+ booktabs = TRUE)\r
+@ %def\r
+\r
+A label and caption can be added.\r
+<<singlecaption, results='asis'>>=\r
+print.xtableList(xList2, floating = TRUE)\r
+@ %def\r
+\r
+Rotated column names?\r
+<<singlerotated, results='asis'>>=\r
+print.xtableList(xList, rotate.colnames = TRUE)\r
+@ %def\r
+\r
+\section{Multiple Column Names}\r
+\label{sec:multiple-column-names}\r
+\r
+Print the list of \code{xtable} objects with multiple headers of the\r
+column names.\r
+\r
+First the default with multiple column name headers.\r
+\r
+<<multipledefault, results='asis'>>=\r
+print.xtableList(xList, colnames.format = "multiple")\r
+@ %def\r
+\r
+Using booktabs:\r
+\r
+<<multiplebooktabs, results='asis'>>=\r
+print.xtableList(xList, colnames.format = "multiple",\r
+ booktabs = TRUE)\r
+@ %def\r
+\r
+With sanitization.\r
+<<sanitizemultiple, results='asis'>>=\r
+print.xtableList(xList, colnames.format = "multiple",\r
+ sanitize.rownames.function = italic,\r
+ sanitize.colnames.function = large,\r
+ booktabs = TRUE)\r
+@ %def\r
+\r
+A label and caption can be added.\r
+<<multiplecaption, results='asis'>>=\r
+print.xtableList(xList2, colnames.format = "multiple",\r
+ floating = TRUE)\r
+@ %def\r
+\r
+Rotated column names?\r
+<<multiplerotated, results='asis'>>=\r
+print.xtableList(xList, colnames.format = "multiple",\r
+ rotate.colnames = TRUE)\r
+@ %def\r
+\r
+\section{lsmeans}\r
+\label{sec:lsmeans}\r
+\r
+Summaries from the \code{lsmeans} function from the \pkg{lsmeans}\r
+package can easily be produced.\r
+\r
+\r
+<<lsmeans>>=\r
+library(lsmeans)\r
+warp.lm <- lm(breaks ~ wool*tension, data = warpbreaks)\r
+warp.lsm <- lsmeans(warp.lm, ~ tension | wool)\r
+warp.sum <- summary(warp.lsm, adjust = "mvt")\r
+warp.xtblList <- xtable.lsmeans(warp.sum, digits = c(0,0,2,2,0,2,2))\r
+str(warp.xtblList)\r
+@ %def\r
+\r
+<<lsmeansstr>>=\r
+print.xtableList(warp.xtblList, colnames.format = "multiple",\r
+ include.rownames = FALSE)\r
+@ %def\r
+<<lsmeanstable, results='asis'>>=\r
+print.xtableList(warp.xtblList, colnames.format = "multiple",\r
+ include.rownames = FALSE)\r
+@ %def\r
+\p\r
+<<lsmeansbooktabs, results='asis'>>=\r
+print.xtableList(warp.xtblList, colnames.format = "multiple",\r
+ booktabs = TRUE,\r
+ include.rownames = FALSE)\r
+@ %def\r
+\r
+\r
+\end{document}\r
projects / xtable.git / commitdiff