###\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
}\r
\r
## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 hline.after\r
- ## By default it print an \hline before and after the columns names independently they are printed or not and at the end of the table\r
- ## Old code that set hline.after should include c(-1, 0, nrow(x)) in the hline.after vector\r
+ ## By default it print an \hline before and after the columns names\r
+ ## independently they are printed or not and at the end of the table\r
+ ## Old code that set hline.after should include c(-1, 0, nrow(x)) in the\r
+ ## hline.after vector\r
## If you do not want any \hline inside the data, set hline.after to NULL\r
## PHEADER instead the string '\\hline\n' is used in the code\r
## Now hline.after counts how many time a position appear\r
## I left an automatic PHEADER in the longtable is this correct?\r
\r
- ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 include.rownames, include.colnames\r
+ ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 include.rownames,\r
+ ## include.colnames\r
pos <- 0\r
if (include.rownames) pos <- 1\r
\r
- ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 hline.after checks\r
+ ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28\r
+ ## hline.after checks\r
if (any(hline.after < -1) | any(hline.after > nrow(x))) {\r
stop("'hline.after' must be inside [-1, nrow(x)]")\r
}\r
\r
- ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 add.to.row checks\r
+ ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28\r
+ ## add.to.row checks\r
if (!is.null(add.to.row)) {\r
if (is.list(add.to.row) && length(add.to.row) == 2) {\r
if (is.null(names(add.to.row))) {\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>, 1 Feb 2012\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
\r
lastcol <- rep(" ", nrow(x)+2)\r
if (!is.null(hline.after)) {\r
- ## booktabs change - Matthieu Stigler: fill the hline arguments separately, 1 Feb 2012\r
- ##\r
+ ## booktabs change - Matthieu Stigler: fill the hline arguments\r
+ ## separately, 1 Feb 2012\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
- stop("\"type\" must be in {\"table\", \"table*\", \"sidewaystable\"}")\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
if (!is.null(table.placement) &&\r
!all(!is.na(match(unlist(strsplit(table.placement, split = "")),\r
if (type == "latex") {\r
BCOMMENT <- "% "\r
ECOMMENT <- "\n"\r
- ## See e-mail from "John S. Walker <jsw9c@uic.edu>" dated 5-19-2003 regarding "texfloat"\r
- ## See e-mail form "Fernando Henrique Ferraz P. da Rosa" <academic@feferraz.net>" dated 10-28-2005 regarding "longtable"\r
+ ## See e-mail from "John S. Walker <jsw9c@uic.edu>" dated 5-19-2003\r
+ ## regarding "texfloat"\r
+ ## See e-mail form "Fernando Henrique Ferraz P. da Rosa"\r
+ ## <academic@feferraz.net>" dated 10-28-2005 regarding "longtable"\r
if ( tabular.environment == "longtable" & floating == TRUE ) {\r
warning("Attempt to use \"longtable\" with floating = TRUE. Changing to FALSE.")\r
floating <- FALSE\r
}\r
if ( floating == TRUE ) {\r
- ## See e-mail from "Pfaff, Bernhard <Bernhard.Pfaff@drkw.com>" dated 7-09-2003 regarding "suggestion for an amendment of the source"\r
- ## See e-mail from "Mitchell, David" <David.Mitchell@dotars.gov.au>" dated 2003-07-09 regarding "Additions to R xtable package"\r
- ## See e-mail from "Garbade, Sven" <Sven.Garbade@med.uni-heidelberg.de> dated 2006-05-22 regarding the floating environment.\r
+ ## See e-mail from "Pfaff, Bernhard <Bernhard.Pfaff@drkw.com>"\r
+ ## dated 7-09-2003 regarding "suggestion for an amendment of\r
+ ## the source"\r
+ ## See e-mail from "Mitchell, David"\r
+ ## <David.Mitchell@dotars.gov.au>" dated 2003-07-09 regarding\r
+ ## "Additions to R xtable package"\r
+ ## See e-mail from "Garbade, Sven"\r
+ ## <Sven.Garbade@med.uni-heidelberg.de> dated 2006-05-22\r
+ ## regarding the floating environment.\r
BTABLE <- paste("\\begin{", floating.environment, "}",\r
ifelse(!is.null(table.placement),\r
paste("[", table.placement, "]", sep = ""),\r
} else {\r
BENVIRONMENT <- ""\r
EENVIRONMENT <- ""\r
- for ( i in 1:length(latex.environments) ) {\r
- if ( latex.environments[i] == "" ) next\r
- BENVIRONMENT <- paste(BENVIRONMENT,\r
- "\\begin{", latex.environments[i],\r
- "}\n", sep = "")\r
- EENVIRONMENT <- paste("\\end{", latex.environments[i],\r
- "}\n", EENVIRONMENT, sep = "")\r
+ if ("center" %in% latex.environments){\r
+ BENVIRONMENT <- paste(BENVIRONMENT, "\\centering\n",\r
+ sep = "")\r
+ }\r
+ for (i in 1:length(latex.environments)) {\r
+ if (latex.environments[i] == "") next\r
+ if (latex.environments[i] != "center"){\r
+ BENVIRONMENT <- paste(BENVIRONMENT,\r
+ "\\begin{", latex.environments[i],\r
+ "}\n", sep = "")\r
+ EENVIRONMENT <- paste("\\end{", latex.environments[i],\r
+ "}\n", EENVIRONMENT, sep = "")\r
+ }\r
}\r
}\r
ETABLE <- paste("\\end{", floating.environment, "}\n", sep = "")\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 "tabularx" environments - CR, 7/2/12\r
- if (is.null(width)){\r
+ ## Added "width" argument for use with "tabular*" or\r
+ ## "tabularx" environments - CR, 7/2/12\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
sep = "", collapse = ""),\r
sep = "")\r
\r
- ## fix 10-26-09 (robert.castelo@upf.edu) the following 'if' condition is added here to support\r
+ ## fix 10-26-09 (robert.castelo@upf.edu) the following\r
+ ## 'if' condition is added here to support\r
## a caption on the top of a longtable\r
if (tabular.environment == "longtable" && caption.placement == "top") {\r
if (is.null(short.caption)){\r
sep = "")\r
}\r
}\r
- ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 add.to.row position -1\r
+ ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28\r
+ ## add.to.row position -1\r
BTABULAR <- paste(BTABULAR, lastcol[1], sep = "")\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 dated Wednesday, December 01, 2004\r
+ ## BSIZE contributed by Benno <puetz@mpipsykl.mpg.de> in e-mail\r
+ ## dated Wednesday, December 01, 2004\r
if (is.null(size) || !is.character(size)) {\r
BSIZE <- ""\r
ESIZE <- ""\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
BTD2 <- ""\r
BTD3 <- ""\r
ETD <- ""\r
- ## Based on contribution from Jonathan Swinton <jonathan@swintons.net> in e-mail dated Wednesday, January 17, 2007\r
+ ## Based on contribution from Jonathan Swinton\r
+ ## <jonathan@swintons.net> in e-mail dated Wednesday, January 17, 2007\r
sanitize <- function(str) {\r
result <- str\r
result <- gsub("\\\\", "SANITIZE.BACKSLASH", result)\r
sanitize.numbers <- function(x) {\r
result <- x\r
if ( math.style.negative ) {\r
- ## Jake Bowers <jwbowers@illinois.edu> in e-mail from 2008-08-20 suggested\r
- ## disabling this feature to avoid problems with LaTeX's dcolumn package.\r
- ## by Florian Wickelmaier <florian.wickelmaier@uni-tuebingen.de> in e-mail\r
- ## from 2008-10-03 requested the ability to use the old behavior.\r
+ ## Jake Bowers <jwbowers@illinois.edu> in e-mail\r
+ ## from 2008-08-20 suggested disabling this feature to avoid\r
+ ## problems with LaTeX's dcolumn package.\r
+ ## by Florian Wickelmaier <florian.wickelmaier@uni-tuebingen.de>\r
+ ## in e-mail from 2008-10-03 requested the ability to use the\r
+ ## old behavior.\r
for(i in 1:length(x)) {\r
result[i] <- gsub("-", "$-$", result[i], fixed = TRUE)\r
}\r
align.tmp <- align.tmp[align.tmp!="|"]\r
BTD2 <- matrix(align.tmp[(2-pos):(ncol(x)+1)],\r
nrow = nrow(x), ncol = ncol(x)+pos, byrow = TRUE)\r
- ## Based on contribution from Jonathan Swinton <jonathan@swintons.net> in e-mail dated Wednesday, January 17, 2007\r
+ ## Based on contribution from Jonathan Swinton <jonathan@swintons.net>\r
+ ## in e-mail dated Wednesday, January 17, 2007\r
BTD2[regexpr("^p", BTD2)>0] <- "left"\r
BTD2[BTD2 == "r"] <- "right"\r
BTD2[BTD2 == "l"] <- "left"\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
- ## Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> on 2006/10/05 recommended not escaping underscores.\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
return(result)\r
}\r
return(x)\r
}\r
sanitize.final <- function(result) {\r
- ## Suggested by Uwe Ligges <ligges@statistik.uni-dortmund.de> in e-mail dated 2005-07-30.\r
+ ## Suggested by Uwe Ligges <ligges@statistik.uni-dortmund.de>\r
+ ## in e-mail dated 2005-07-30.\r
result$text <- gsub(" *", " ", result$text, fixed = TRUE)\r
result$text <- gsub(' align="left"', "", result$text,\r
fixed = TRUE)\r
\r
result <- string("", file = file, append = append)\r
info <- R.Version()\r
- ## modified Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 to set automatically the package version\r
- result <- result + BCOMMENT + type + " table generated in " +\r
- info$language + " " + info$major + "." + info$minor + " by xtable " + packageDescription('xtable')$Version + " package" + ECOMMENT\r
- result <- result + BCOMMENT + date() + ECOMMENT\r
- ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 only.contents\r
+ ## modified Claudio Agostinelli <claudio@unive.it> dated 2006-07-28\r
+ ## to set automatically the package version\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
+ 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
result <- result + BENVIRONMENT\r
result <- result + BSIZE\r
result <- result + BTABULAR\r
}\r
- ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 include.colnames, include.rownames\r
+ ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28\r
+ ## include.colnames, include.rownames\r
if (include.colnames) {\r
result <- result + BROW + BTH\r
if (include.rownames) {\r
## return(y)\r
## }\r
varying.digits <- is.matrix( attr( x, "digits", exact = TRUE ) )\r
- ## Code for letting "digits" be a matrix was provided by Arne Henningsen <ahenningsen@agric-econ.uni-kiel.de> in e-mail dated 2005-06-04.\r
+ ## Code for letting "digits" be a matrix was provided by\r
+ ## Arne Henningsen <ahenningsen@agric-econ.uni-kiel.de>\r
+ ## in e-mail dated 2005-06-04.\r
##if( !varying.digits ) {\r
## modified Claudio Agostinelli <claudio@unive.it> dated 2006-07-28\r
- ## attr(x,"digits") <- matrix( attr( x, "digits",exact=TRUE ), nrow = nrow(x), ncol = ncol(x)+1, byrow = TRUE )\r
- ##}\r
+ ## attr(x,"digits") <- matrix( attr( x, "digits",exact=TRUE ),\r
+ ## nrow = nrow(x), ncol = ncol(x)+1, byrow = TRUE )\r
+ ##}\r
for(i in 1:ncol(x)) {\r
xcol <- x[, i]\r
if(is.factor(xcol))\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
## End Ian Fellows changes\r
\r
if ( any(ina) ) cols[ina, i+pos] <- NA.string\r
- ## Based on contribution from Jonathan Swinton <jonathan@swintons.net> in e-mail dated Wednesday, January 17, 2007\r
+ ## Based on contribution from Jonathan Swinton <jonathan@swintons.net>\r
+ ## in e-mail dated Wednesday, January 17, 2007\r
if ( is.numeric.column ) {\r
cols[, i+pos] <- sanitize.numbers(cols[, i+pos])\r
} else {\r
result <- result + PHEADER\r
}\r
\r
- ## fix 10-27-09 Liviu Andronic (landronimirc@gmail.com) the following 'if' condition is inserted in order to avoid\r
+ ## fix 10-27-09 Liviu Andronic (landronimirc@gmail.com) the\r
+ ## following 'if' condition is inserted in order to avoid\r
## that bottom caption interferes with a top caption of a longtable\r
if(caption.placement == "bottom"){\r
if ((!is.null(caption)) && (type == "latex")) {\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