###\r
### Produce LaTeX and HTML tables from R objects.\r
###\r
-### Copyright 2000-2012 David B. Dahl <dahl@stat.tamu.edu>\r
+### Copyright 2000-2013 David B. Dahl <dahl@stat.tamu.edu>\r
###\r
### Maintained by Charles Roosen <croosen@mango-solutions.com>\r
###\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
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
...)\r
{\r
## If caption is length 2, treat the second value as the "short caption"\r
## Original code before changes in version 1.6-1\r
## PHEADER <- "\\hline\n"\r
\r
- ## booktabs code from Matthieu Stigler <matthieu.stigler@gmail.com>,\r
+ ## booktabs code from Matthieu Stigler <matthieu.stigler@gmail.com>,\r
## 1 Feb 2012\r
if(!booktabs){\r
PHEADER <- "\\hline\n"\r
- } else {\r
+ } else {\r
PHEADER <- ifelse(-1%in%hline.after, "\\toprule\n", "")\r
if(0%in%hline.after) {\r
PHEADER <- c(PHEADER, "\\midrule\n")\r
if (!is.null(hline.after)) {\r
## booktabs change - Matthieu Stigler: fill the hline arguments\r
## separately, 1 Feb 2012\r
- ##\r
+ ##\r
## Code before booktabs change was:\r
- ## add.to.row$pos[[npos+1]] <- hline.after\r
+ ## add.to.row$pos[[npos+1]] <- hline.after\r
\r
if (!booktabs){\r
add.to.row$pos[[npos+1]] <- hline.after\r
- } else {\r
+ } else {\r
for(i in 1:length(hline.after)) {\r
add.to.row$pos[[npos+i]] <- hline.after[i]\r
}\r
lastcol[addpos[j]+2] <- paste(lastcol[addpos[j]+2],\r
paste(rep(add.to.row$command[i],\r
freq[j]),\r
- sep = "", collapse = ""),\r
+ sep = "", collapse = ""),\r
sep = " ")\r
}\r
}\r
if (!all(!is.na(match(type, c("latex","html"))))) {\r
stop("\"type\" must be in {\"latex\", \"html\"}")\r
}\r
- if (!all(!is.na(match(floating.environment,\r
- c("table","table*","sidewaystable",\r
- "margintable"))))) {\r
- stop("\"type\" must be in {\"table\", \"table*\", \"sidewaystable\", \"margintable\"}")\r
- }\r
- if ((match(floating.environment,\r
- c("table","table*","sidewaystable","margintable"))\r
- == "margintable") & (!is.null(table.placement))) {\r
+ ## Disabling the check on known floating environments as many users\r
+ ## want to use additional environments.\r
+ # if (!all(!is.na(match(floating.environment,\r
+ # c("table","table*","sidewaystable",\r
+ # "margintable"))))) {\r
+ # stop("\"type\" must be in {\"table\", \"table*\", \"sidewaystable\", \"margintable\"}")\r
+ # }\r
+ if (("margintable" %in% floating.environment)\r
+ & (!is.null(table.placement))) {\r
warning("margintable does not allow for table placement; setting table.placement to NULL")\r
table.placement <- NULL\r
}\r
tmp.index.start <- tmp.index.start + 1\r
tmp.index.start <- tmp.index.start + 1\r
}\r
- ## Added "width" argument for use with "tabular*" or\r
+ ## Added "width" argument for use with "tabular*" or\r
## "tabularx" environments - CR, 7/2/12\r
- if (is.null(width)){\r
+ if (is.null(width)){\r
WIDTH <-""\r
- } else if (is.element(tabular.environment,\r
+ } else if (is.element(tabular.environment,\r
c("tabular", "longtable"))){\r
warning("Ignoring 'width' argument. The 'tabular' and 'longtable' environments do not support a width specification. Use another environment such as 'tabular*' or 'tabularx' to specify the width.")\r
WIDTH <- ""\r
- } else {\r
+ } else {\r
WIDTH <- paste("{", width, "}", sep = "")\r
- }\r
+ }\r
\r
BTABULAR <-\r
paste("\\begin{", tabular.environment, "}",\r
## the \hline at the end, if present, is set in full matrix\r
ETABULAR <- paste("\\end{", tabular.environment, "}\n", sep = "")\r
\r
- ## Add scalebox - CR, 7/2/12\r
- if (!is.null(scalebox)){\r
+ ## Add scalebox - CR, 7/2/12\r
+ if (!is.null(scalebox)){\r
BTABULAR <- paste("\\scalebox{", scalebox, "}{\n", BTABULAR,\r
sep = "")\r
ETABULAR <- paste(ETABULAR, "}\n", sep = "")\r
- }\r
+ }\r
\r
## BSIZE contributed by Benno <puetz@mpipsykl.mpg.de> in e-mail\r
## dated Wednesday, December 01, 2004\r
}\r
BLABEL <- "\\label{"\r
ELABEL <- "}\n"\r
- if (is.null(short.caption)){\r
- BCAPTION <- "\\caption{"\r
- } else {\r
- BCAPTION <- paste("\\caption[", short.caption, "]{", sep = "")\r
- }\r
- ECAPTION <- "}\n"\r
+ ## Added caption width (jeff.laake@nooa.gov)\r
+ if(!is.null(caption.width)){\r
+ BCAPTION <- paste("\\parbox{",caption.width,"}{",sep="")\r
+ ECAPTION <- "}"\r
+ } else {\r
+ BCAPTION <- NULL\r
+ ECAPTION <- NULL\r
+ }\r
+ if (is.null(short.caption)){\r
+ BCAPTION <- paste(BCAPTION,"\\caption{",sep="")\r
+ } else {\r
+ BCAPTION <- paste(BCAPTION,"\\caption[", short.caption, "]{", sep="")\r
+ }\r
+ ECAPTION <- paste(ECAPTION,"} \n",sep="")\r
BROW <- ""\r
EROW <- " \\\\ \n"\r
BTH <- ""\r
ETD <- " </TD>"\r
sanitize <- function(str) {\r
result <- str\r
- result <- gsub("&", "& ", result, fixed = TRUE)\r
- result <- gsub(">", "> ", result, fixed = TRUE)\r
- result <- gsub("<", "< ", result, fixed = TRUE)\r
+ ## Changed as suggested in bug report #2795\r
+ ## That is replacement of "&" is "&"\r
+ ## instead of previous "&" etc\r
+ ## result <- gsub("&", "& ", result, fixed = TRUE)\r
+ ## result <- gsub(">", "> ", result, fixed = TRUE)\r
+ ## result <- gsub("<", "< ", result, fixed = TRUE)\r
+ result <- gsub("&", "&", result, fixed = TRUE)\r
+ result <- gsub(">", ">", result, fixed = TRUE)\r
+ result <- gsub("<", "<", result, fixed = TRUE)\r
## Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> on 2006/10/05\r
## recommended not escaping underscores.\r
## result <- gsub("_", "\\_", result, fixed=TRUE)\r
info <- R.Version()\r
## modified Claudio Agostinelli <claudio@unive.it> dated 2006-07-28\r
## to set automatically the package version\r
- result <- result + BCOMMENT + type + " table generated in " +\r
+ if (comment){\r
+ result <- result + BCOMMENT + type + " table generated in " +\r
info$language + " " + info$major + "." + info$minor +\r
" by xtable " + packageDescription('xtable')$Version +\r
" package" + ECOMMENT\r
- result <- result + BCOMMENT + date() + ECOMMENT\r
+ if (!is.null(timestamp)){\r
+ result <- result + BCOMMENT + timestamp + ECOMMENT\r
+ }\r
+ }\r
## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 only.contents\r
if (!only.contents) {\r
result <- result + BTABLE\r
format.args$decimal.mark <- options()$OutDec\r
}\r
if(!varying.digits){\r
- curFormatArgs <- c(list(\r
- x = xcol,\r
- format = ifelse( attr( x, "digits",\r
- exact = TRUE )[i+1] < 0, "E",\r
- attr( x, "display", exact = TRUE )[i+1] ),\r
- digits = abs( attr( x, "digits",\r
- exact = TRUE )[i+1] )),\r
- format.args)\r
+ curFormatArgs <-\r
+ c(list(\r
+ x = xcol,\r
+ format =\r
+ ifelse(attr(x, "digits", exact = TRUE )[i+1] < 0, "E",\r
+ attr(x, "display", exact = TRUE )[i+1]),\r
+ digits = abs(attr(x, "digits", exact = TRUE )[i+1])),\r
+ format.args)\r
cols[, i+pos] <- do.call("formatC", curFormatArgs)\r
}else{\r
for( j in 1:nrow( cols ) ) {\r
- curFormatArgs <- c(list(\r
- x = xcol[j],\r
- format = ifelse( attr( x, "digits",\r
- exact = TRUE )[j, i+1] < 0, "E",\r
- attr( x, "display",\r
- exact = TRUE )[i+1] ),\r
- digits = abs( attr( x, "digits",\r
- exact = TRUE )[j, i+1] )),\r
- format.args)\r
+ curFormatArgs <-\r
+ c(list(\r
+ x = xcol[j],\r
+ format =\r
+ ifelse(attr(x, "digits", exact = TRUE )[j, i+1] < 0,\r
+ "E", attr(x, "display", exact = TRUE )[i+1]),\r
+ digits =\r
+ abs(attr(x, "digits", exact = TRUE )[j, i+1])),\r
+ format.args)\r
cols[j, i+pos] <- do.call("formatC", curFormatArgs)\r
}\r
}\r
switch(data.class(x),\r
character = return(string(x, file, append)),\r
numeric = return(string(as.character(x), file, append)),\r
- stop("Cannot coerse argument to a string"))\r
+ stop("Cannot coerce argument to a string"))\r
if (class(x) == "string")\r
return(x)\r
- stop("Cannot coerse argument to a string")\r
+ stop("Cannot coerce argument to a string")\r
}\r
\r
is.string <- function(x) {\r
projects / xtable.git / blobdiff