### Function to create lists of tables\r
xtableList <- function(x, caption = NULL, label = NULL, align = NULL,\r
- digits = NULL, display = NULL, ...) {\r
+ digits = NULL, display = NULL, ...) {\r
if (is.null(digits)){\r
digitsList <- vector("list", length(x))\r
} else {\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
- ## Create headings for columns if multiple headings are needed\r
- if (colnames.format == "multiple"){\r
- if (is.null(sanitize.colnames.function)) {\r
- colHead <- names(x[[1]])\r
+ if (type == "latex"){\r
+ ## Special treatment if using booktabs\r
+ if (booktabs){\r
+ tRule <- "\\toprule"\r
+ mRule <- "\\midrule"\r
+ bRule <- "\\bottomrule"\r
} else {\r
- colHead <- sanitize.colnames.function(names(x[[1]]))\r
+ tRule <- "\\hline"\r
+ mRule <- "\\hline"\r
+ bRule <- "\\hline"\r
}\r
- if (rotate.colnames) {\r
- colHead <- paste("\\begin{sideways}", colHead, "\\end{sideways}")\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}{",\r
+ 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
- colHead <- paste0(colHead, collapse = " & ")\r
- if (include.rownames) {\r
- colHead <- paste0(" & ", colHead)\r
- }\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
+ ## Create headings for columns if multiple headings are needed\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
+ if (include.rownames) {\r
+ colHead <- paste0(" & ", colHead)\r
+ }\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}{",\r
+ 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
+ } else {\r
+ stop("print.xtableList not yet implemented for this type")\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
\r
\r
### Uses xtableList\r
xtableLSMeans <- function(x, caption = NULL, label = NULL,\r
- align = NULL, digits = NULL,\r
- display = NULL, auto = FALSE,\r
- ...){\r
+ align = NULL, digits = NULL,\r
+ display = NULL, auto = FALSE,\r
+ ...){\r
if (attr(x, "estName") == "lsmean"){\r
xList <- split(x, f = x[, 2])\r
for (i in 1:length(xList)){\r
} else {\r
xList <- x\r
xList <- xtable.data.frame(xList, caption = caption, label = label,\r
- align = align, digits = digits,\r
- display = display, auto = auto, ...)\r
+ align = align, digits = digits,\r
+ display = display, auto = auto, ...)\r
}\r
return(xList)\r
}\r
projects / xtable.git / blobdiff