3 ### Produce LaTeX and HTML tables from R objects.
\r
5 ### Copyright 2000-2012 David B. Dahl <dahl@stat.tamu.edu>
\r
7 ### Maintained by Charles Roosen <croosen@mango-solutions.com>
\r
9 ### This file is part of the `xtable' library for R and related languages.
\r
10 ### It is made available under the terms of the GNU General Public
\r
11 ### License, version 2, or at your option, any later version,
\r
12 ### incorporated herein by reference.
\r
14 ### This program is distributed in the hope that it will be
\r
15 ### useful, but WITHOUT ANY WARRANTY; without even the implied
\r
16 ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
\r
17 ### PURPOSE. See the GNU General Public License for more
\r
20 ### You should have received a copy of the GNU General Public
\r
21 ### License along with this program; if not, write to the Free
\r
22 ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
\r
23 ### MA 02111-1307, USA
\r
24 print.xtable <- function(x,
\r
25 type = getOption("xtable.type", "latex"),
\r
26 file = getOption("xtable.file", ""),
\r
27 append = getOption("xtable.append", FALSE),
\r
28 floating = getOption("xtable.floating", TRUE),
\r
29 floating.environment = getOption("xtable.floating.environment", "table"),
\r
30 table.placement = getOption("xtable.table.placement", "ht"),
\r
31 caption.placement = getOption("xtable.caption.placement", "bottom"),
\r
32 latex.environments = getOption("xtable.latex.environments", c("center")),
\r
33 tabular.environment = getOption("xtable.tabular.environment", "tabular"),
\r
34 size = getOption("xtable.size", NULL),
\r
35 hline.after = getOption("xtable.hline.after", c(-1,0,nrow(x))),
\r
36 NA.string = getOption("xtable.NA.string", ""),
\r
37 include.rownames = getOption("xtable.include.rownames", TRUE),
\r
38 include.colnames = getOption("xtable.include.colnames", TRUE),
\r
39 only.contents = getOption("xtable.only.contents", FALSE),
\r
40 add.to.row = getOption("xtable.add.to.row", NULL),
\r
41 sanitize.text.function = getOption("xtable.sanitize.text.function", NULL),
\r
42 sanitize.rownames.function = getOption("xtable.sanitize.rownames.function",
\r
43 sanitize.text.function),
\r
44 sanitize.colnames.function = getOption("xtable.sanitize.colnames.function",
\r
45 sanitize.text.function),
\r
46 math.style.negative = getOption("xtable.math.style.negative", FALSE),
\r
47 html.table.attributes = getOption("xtable.html.table.attributes", "border=1"),
\r
48 print.results = getOption("xtable.print.results", TRUE),
\r
49 format.args = getOption("xtable.format.args", NULL),
\r
50 rotate.rownames = getOption("xtable.rotate.rownames", FALSE),
\r
51 rotate.colnames = getOption("xtable.rotate.colnames", FALSE),
\r
52 booktabs = getOption("xtable.booktabs", FALSE),
\r
53 scalebox = getOption("xtable.scalebox", NULL),
\r
54 width = getOption("xtable.width", NULL),
\r
57 ## If caption is length 2, treat the second value as the "short caption"
\r
58 caption <- attr(x,"caption",exact = TRUE)
\r
59 short.caption <- NULL
\r
60 if (!is.null(caption) && length(caption) > 1){
\r
61 short.caption <- caption[2]
\r
62 caption <- caption[1]
\r
65 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 hline.after
\r
66 ## By default it print an \hline before and after the columns names
\r
67 ## independently they are printed or not and at the end of the table
\r
68 ## Old code that set hline.after should include c(-1, 0, nrow(x)) in the
\r
69 ## hline.after vector
\r
70 ## If you do not want any \hline inside the data, set hline.after to NULL
\r
71 ## PHEADER instead the string '\\hline\n' is used in the code
\r
72 ## Now hline.after counts how many time a position appear
\r
73 ## I left an automatic PHEADER in the longtable is this correct?
\r
75 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 include.rownames,
\r
78 if (include.rownames) pos <- 1
\r
80 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28
\r
81 ## hline.after checks
\r
82 if (any(hline.after < -1) | any(hline.after > nrow(x))) {
\r
83 stop("'hline.after' must be inside [-1, nrow(x)]")
\r
86 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28
\r
87 ## add.to.row checks
\r
88 if (!is.null(add.to.row)) {
\r
89 if (is.list(add.to.row) && length(add.to.row) == 2) {
\r
90 if (is.null(names(add.to.row))) {
\r
91 names(add.to.row) <- c('pos', 'command')
\r
92 } else if (any(sort(names(add.to.row))!= c('command', 'pos'))) {
\r
93 stop("the names of the elements of 'add.to.row' must be 'pos' and 'command'")
\r
95 if (is.list(add.to.row$pos) && is.vector(add.to.row$command,
\r
96 mode = 'character')) {
\r
97 if ((npos <- length(add.to.row$pos)) !=
\r
98 length(add.to.row$command)) {
\r
99 stop("the length of 'add.to.row$pos' must be equal to the length of 'add.to.row$command'")
\r
101 if (any(unlist(add.to.row$pos) < -1) |
\r
102 any(unlist(add.to.row$pos) > nrow(x))) {
\r
103 stop("the values in add.to.row$pos must be inside the interval [-1, nrow(x)]")
\r
106 stop("the first argument ('pos') of 'add.to.row' must be a list, the second argument ('command') must be a vector of mode character")
\r
109 stop("'add.to.row' argument must be a list of length 2")
\r
112 add.to.row <- list(pos = list(),
\r
113 command = vector(length = 0, mode = "character"))
\r
117 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 add.to.row
\r
118 ## Add further commands at the end of rows
\r
119 if (type == "latex") {
\r
120 ## Original code before changes in version 1.6-1
\r
121 ## PHEADER <- "\\hline\n"
\r
123 ## booktabs code from Matthieu Stigler <matthieu.stigler@gmail.com>,
\r
126 PHEADER <- "\\hline\n"
\r
128 PHEADER <- ifelse(-1%in%hline.after, "\\toprule\n", "")
\r
129 if(0%in%hline.after) {
\r
130 PHEADER <- c(PHEADER, "\\midrule\n")
\r
132 if(nrow(x)%in%hline.after) {
\r
133 PHEADER <- c(PHEADER, "\\bottomrule\n")
\r
140 lastcol <- rep(" ", nrow(x)+2)
\r
141 if (!is.null(hline.after)) {
\r
142 ## booktabs change - Matthieu Stigler: fill the hline arguments
\r
143 ## separately, 1 Feb 2012
\r
145 ## Code before booktabs change was:
\r
146 ## add.to.row$pos[[npos+1]] <- hline.after
\r
149 add.to.row$pos[[npos+1]] <- hline.after
\r
151 for(i in 1:length(hline.after)) {
\r
152 add.to.row$pos[[npos+i]] <- hline.after[i]
\r
155 add.to.row$command <- c(add.to.row$command, PHEADER)
\r
158 if ( length(add.to.row$command) > 0 ) {
\r
159 for (i in 1:length(add.to.row$command)) {
\r
160 addpos <- add.to.row$pos[[i]]
\r
161 freq <- table(addpos)
\r
162 addpos <- unique(addpos)
\r
163 for (j in 1:length(addpos)) {
\r
164 lastcol[addpos[j]+2] <- paste(lastcol[addpos[j]+2],
\r
165 paste(rep(add.to.row$command[i],
\r
167 sep = "", collapse = ""),
\r
173 if (length(type)>1) stop("\"type\" must have length 1")
\r
174 type <- tolower(type)
\r
175 if (!all(!is.na(match(type, c("latex","html"))))) {
\r
176 stop("\"type\" must be in {\"latex\", \"html\"}")
\r
178 if (!all(!is.na(match(floating.environment,
\r
179 c("table","table*","sidewaystable",
\r
180 "margintable"))))) {
\r
181 stop("\"type\" must be in {\"table\", \"table*\", \"sidewaystable\", \"margintable\"}")
\r
183 if ((match(floating.environment,
\r
184 c("table","table*","sidewaystable","margintable"))
\r
185 == "margintable") & (!is.null(table.placement))) {
\r
186 warning("margintable does not allow for table placement; setting table.placement to NULL")
\r
187 table.placement <- NULL
\r
189 if (!is.null(table.placement) &&
\r
190 !all(!is.na(match(unlist(strsplit(table.placement, split = "")),
\r
191 c("H","h","t","b","p","!"))))) {
\r
192 stop("\"table.placement\" must contain only elements of {\"h\",\"t\",\"b\",\"p\",\"!\"}")
\r
194 if (!all(!is.na(match(caption.placement, c("bottom","top"))))) {
\r
195 stop("\"caption.placement\" must be either {\"bottom\",\"top\"}")
\r
198 if (type == "latex") {
\r
201 ## See e-mail from "John S. Walker <jsw9c@uic.edu>" dated 5-19-2003
\r
202 ## regarding "texfloat"
\r
203 ## See e-mail form "Fernando Henrique Ferraz P. da Rosa"
\r
204 ## <academic@feferraz.net>" dated 10-28-2005 regarding "longtable"
\r
205 if ( tabular.environment == "longtable" & floating == TRUE ) {
\r
206 warning("Attempt to use \"longtable\" with floating = TRUE. Changing to FALSE.")
\r
209 if ( floating == TRUE ) {
\r
210 ## See e-mail from "Pfaff, Bernhard <Bernhard.Pfaff@drkw.com>"
\r
211 ## dated 7-09-2003 regarding "suggestion for an amendment of
\r
213 ## See e-mail from "Mitchell, David"
\r
214 ## <David.Mitchell@dotars.gov.au>" dated 2003-07-09 regarding
\r
215 ## "Additions to R xtable package"
\r
216 ## See e-mail from "Garbade, Sven"
\r
217 ## <Sven.Garbade@med.uni-heidelberg.de> dated 2006-05-22
\r
218 ## regarding the floating environment.
\r
219 BTABLE <- paste("\\begin{", floating.environment, "}",
\r
220 ifelse(!is.null(table.placement),
\r
221 paste("[", table.placement, "]", sep = ""),
\r
222 ""), "\n", sep = "")
\r
223 if ( is.null(latex.environments) ||
\r
224 (length(latex.environments) == 0) ) {
\r
230 if ("center" %in% latex.environments){
\r
231 BENVIRONMENT <- paste(BENVIRONMENT, "\\centering\n",
\r
234 for (i in 1:length(latex.environments)) {
\r
235 if (latex.environments[i] == "") next
\r
236 if (latex.environments[i] != "center"){
\r
237 BENVIRONMENT <- paste(BENVIRONMENT,
\r
238 "\\begin{", latex.environments[i],
\r
240 EENVIRONMENT <- paste("\\end{", latex.environments[i],
\r
241 "}\n", EENVIRONMENT, sep = "")
\r
245 ETABLE <- paste("\\end{", floating.environment, "}\n", sep = "")
\r
253 tmp.index.start <- 1
\r
254 if ( ! include.rownames ) {
\r
255 while ( attr(x, "align", exact = TRUE)[tmp.index.start] == '|' )
\r
256 tmp.index.start <- tmp.index.start + 1
\r
257 tmp.index.start <- tmp.index.start + 1
\r
259 ## Added "width" argument for use with "tabular*" or
\r
260 ## "tabularx" environments - CR, 7/2/12
\r
261 if (is.null(width)){
\r
263 } else if (is.element(tabular.environment,
\r
264 c("tabular", "longtable"))){
\r
265 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
268 WIDTH <- paste("{", width, "}", sep = "")
\r
272 paste("\\begin{", tabular.environment, "}",
\r
274 paste(c(attr(x, "align",
\r
276 tmp.index.start:length(attr(x, "align",
\r
279 sep = "", collapse = ""),
\r
282 ## fix 10-26-09 (robert.castelo@upf.edu) the following
\r
283 ## 'if' condition is added here to support
\r
284 ## a caption on the top of a longtable
\r
285 if (tabular.environment == "longtable" && caption.placement == "top") {
\r
286 if (is.null(short.caption)){
\r
287 BCAPTION <- "\\caption{"
\r
289 BCAPTION <- paste("\\caption[", short.caption, "]{", sep = "")
\r
291 ECAPTION <- "} \\\\ \n"
\r
292 if ((!is.null(caption)) && (type == "latex")) {
\r
293 BTABULAR <- paste(BTABULAR, BCAPTION, caption, ECAPTION,
\r
297 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28
\r
298 ## add.to.row position -1
\r
299 BTABULAR <- paste(BTABULAR, lastcol[1], sep = "")
\r
300 ## the \hline at the end, if present, is set in full matrix
\r
301 ETABULAR <- paste("\\end{", tabular.environment, "}\n", sep = "")
\r
303 ## Add scalebox - CR, 7/2/12
\r
304 if (!is.null(scalebox)){
\r
305 BTABULAR <- paste("\\scalebox{", scalebox, "}{\n", BTABULAR,
\r
307 ETABULAR <- paste(ETABULAR, "}\n", sep = "")
\r
310 ## BSIZE contributed by Benno <puetz@mpipsykl.mpg.de> in e-mail
\r
311 ## dated Wednesday, December 01, 2004
\r
312 if (is.null(size) || !is.character(size)) {
\r
316 if(length(grep("^\\\\", size)) == 0){
\r
317 size <- paste("\\", size, sep = "")
\r
319 BSIZE <- paste("{", size, "\n", sep = "")
\r
322 BLABEL <- "\\label{"
\r
324 if (is.null(short.caption)){
\r
325 BCAPTION <- "\\caption{"
\r
327 BCAPTION <- paste("\\caption[", short.caption, "]{", sep = "")
\r
339 ## Based on contribution from Jonathan Swinton
\r
340 ## <jonathan@swintons.net> in e-mail dated Wednesday, January 17, 2007
\r
341 sanitize <- function(str) {
\r
343 result <- gsub("\\\\", "SANITIZE.BACKSLASH", result)
\r
344 result <- gsub("$", "\\$", result, fixed = TRUE)
\r
345 result <- gsub(">", "$>$", result, fixed = TRUE)
\r
346 result <- gsub("<", "$<$", result, fixed = TRUE)
\r
347 result <- gsub("|", "$|$", result, fixed = TRUE)
\r
348 result <- gsub("{", "\\{", result, fixed = TRUE)
\r
349 result <- gsub("}", "\\}", result, fixed = TRUE)
\r
350 result <- gsub("%", "\\%", result, fixed = TRUE)
\r
351 result <- gsub("&", "\\&", result, fixed = TRUE)
\r
352 result <- gsub("_", "\\_", result, fixed = TRUE)
\r
353 result <- gsub("#", "\\#", result, fixed = TRUE)
\r
354 result <- gsub("^", "\\verb|^|", result, fixed = TRUE)
\r
355 result <- gsub("~", "\\~{}", result, fixed = TRUE)
\r
356 result <- gsub("SANITIZE.BACKSLASH", "$\\backslash$",
\r
357 result, fixed = TRUE)
\r
360 sanitize.numbers <- function(x) {
\r
362 if ( math.style.negative ) {
\r
363 ## Jake Bowers <jwbowers@illinois.edu> in e-mail
\r
364 ## from 2008-08-20 suggested disabling this feature to avoid
\r
365 ## problems with LaTeX's dcolumn package.
\r
366 ## by Florian Wickelmaier <florian.wickelmaier@uni-tuebingen.de>
\r
367 ## in e-mail from 2008-10-03 requested the ability to use the
\r
369 for(i in 1:length(x)) {
\r
370 result[i] <- gsub("-", "$-$", result[i], fixed = TRUE)
\r
375 sanitize.final <- function(result) {
\r
379 BCOMMENT <- "<!-- "
\r
380 ECOMMENT <- " -->\n"
\r
381 BTABLE <- paste("<TABLE ", html.table.attributes, ">\n", sep = "")
\r
382 ETABLE <- "</TABLE>\n"
\r
389 BLABEL <- "<A NAME="
\r
390 ELABEL <- "></A>\n"
\r
391 BCAPTION <- paste("<CAPTION ALIGN=\"", caption.placement, "\"> ",
\r
393 ECAPTION <- " </CAPTION>\n"
\r
398 STH <- " </TH> <TH> "
\r
399 BTD1 <- " <TD align=\""
\r
400 align.tmp <- attr(x, "align", exact = TRUE)
\r
401 align.tmp <- align.tmp[align.tmp!="|"]
\r
402 BTD2 <- matrix(align.tmp[(2-pos):(ncol(x)+1)],
\r
403 nrow = nrow(x), ncol = ncol(x)+pos, byrow = TRUE)
\r
404 ## Based on contribution from Jonathan Swinton <jonathan@swintons.net>
\r
405 ## in e-mail dated Wednesday, January 17, 2007
\r
406 BTD2[regexpr("^p", BTD2)>0] <- "left"
\r
407 BTD2[BTD2 == "r"] <- "right"
\r
408 BTD2[BTD2 == "l"] <- "left"
\r
409 BTD2[BTD2 == "c"] <- "center"
\r
412 sanitize <- function(str) {
\r
414 result <- gsub("&", "& ", result, fixed = TRUE)
\r
415 result <- gsub(">", "> ", result, fixed = TRUE)
\r
416 result <- gsub("<", "< ", result, fixed = TRUE)
\r
417 ## Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> on 2006/10/05
\r
418 ## recommended not escaping underscores.
\r
419 ## result <- gsub("_", "\\_", result, fixed=TRUE)
\r
422 sanitize.numbers <- function(x) {
\r
425 sanitize.final <- function(result) {
\r
426 ## Suggested by Uwe Ligges <ligges@statistik.uni-dortmund.de>
\r
427 ## in e-mail dated 2005-07-30.
\r
428 result$text <- gsub(" *", " ", result$text, fixed = TRUE)
\r
429 result$text <- gsub(' align="left"', "", result$text,
\r
435 result <- string("", file = file, append = append)
\r
436 info <- R.Version()
\r
437 ## modified Claudio Agostinelli <claudio@unive.it> dated 2006-07-28
\r
438 ## to set automatically the package version
\r
439 result <- result + BCOMMENT + type + " table generated in " +
\r
440 info$language + " " + info$major + "." + info$minor +
\r
441 " by xtable " + packageDescription('xtable')$Version +
\r
442 " package" + ECOMMENT
\r
443 result <- result + BCOMMENT + date() + ECOMMENT
\r
444 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 only.contents
\r
445 if (!only.contents) {
\r
446 result <- result + BTABLE
\r
447 result <- result + BENVIRONMENT
\r
448 if ( floating == TRUE ) {
\r
449 if ((!is.null(caption)) &&
\r
450 (type == "html" ||caption.placement == "top")) {
\r
451 result <- result + BCAPTION + caption + ECAPTION
\r
453 if (!is.null(attr(x, "label", exact = TRUE)) &&
\r
454 (type == "latex" && caption.placement == "top")) {
\r
455 result <- result + BLABEL +
\r
456 attr(x, "label", exact = TRUE) + ELABEL
\r
459 result <- result + BSIZE
\r
460 result <- result + BTABULAR
\r
462 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28
\r
463 ## include.colnames, include.rownames
\r
464 if (include.colnames) {
\r
465 result <- result + BROW + BTH
\r
466 if (include.rownames) {
\r
467 result <- result + STH
\r
469 ## David G. Whiting in e-mail 2007-10-09
\r
470 if (is.null(sanitize.colnames.function)) {
\r
471 CNAMES <- sanitize(names(x))
\r
473 CNAMES <- sanitize.colnames.function(names(x))
\r
475 if (rotate.colnames) {
\r
476 ##added by Markus Loecher, 2009-11-16
\r
477 CNAMES <- paste("\\begin{sideways}", CNAMES, "\\end{sideways}")
\r
479 result <- result + paste(CNAMES, collapse = STH)
\r
481 result <- result + ETH + EROW
\r
484 cols <- matrix("", nrow = nrow(x), ncol = ncol(x)+pos)
\r
485 if (include.rownames) {
\r
486 ## David G. Whiting in e-mail 2007-10-09
\r
487 if (is.null(sanitize.rownames.function)) {
\r
488 RNAMES <- sanitize(row.names(x))
\r
490 RNAMES <- sanitize.rownames.function(row.names(x))
\r
492 if (rotate.rownames) {
\r
493 ##added by Markus Loecher, 2009-11-16
\r
494 RNAMES <- paste("\\begin{sideways}", RNAMES, "\\end{sideways}")
\r
496 cols[, 1] <- RNAMES
\r
499 ## Begin vectorizing the formatting code by Ian Fellows [ian@fellstat.com]
\r
502 ## disp <- function(y) {
\r
503 ## if (is.factor(y)) {
\r
504 ## y <- levels(y)[y]
\r
506 ## if (is.list(y)) {
\r
511 varying.digits <- is.matrix( attr( x, "digits", exact = TRUE ) )
\r
512 ## Code for letting "digits" be a matrix was provided by
\r
513 ## Arne Henningsen <ahenningsen@agric-econ.uni-kiel.de>
\r
514 ## in e-mail dated 2005-06-04.
\r
515 ##if( !varying.digits ) {
\r
516 ## modified Claudio Agostinelli <claudio@unive.it> dated 2006-07-28
\r
517 ## attr(x,"digits") <- matrix( attr( x, "digits",exact=TRUE ),
\r
518 ## nrow = nrow(x), ncol = ncol(x)+1, byrow = TRUE )
\r
520 for(i in 1:ncol(x)) {
\r
522 if(is.factor(xcol))
\r
523 xcol <- as.character(xcol)
\r
525 xcol <- sapply(xcol, unlist)
\r
527 is.numeric.column <- is.numeric(xcol)
\r
529 if(is.character(xcol)) {
\r
530 cols[, i+pos] <- xcol
\r
532 if (is.null(format.args)){
\r
533 format.args <- list()
\r
535 if (is.null(format.args$decimal.mark)){
\r
536 format.args$decimal.mark <- options()$OutDec
\r
538 if(!varying.digits){
\r
539 curFormatArgs <- c(list(
\r
541 format = ifelse( attr( x, "digits",
\r
542 exact = TRUE )[i+1] < 0, "E",
\r
543 attr( x, "display", exact = TRUE )[i+1] ),
\r
544 digits = abs( attr( x, "digits",
\r
545 exact = TRUE )[i+1] )),
\r
547 cols[, i+pos] <- do.call("formatC", curFormatArgs)
\r
549 for( j in 1:nrow( cols ) ) {
\r
550 curFormatArgs <- c(list(
\r
552 format = ifelse( attr( x, "digits",
\r
553 exact = TRUE )[j, i+1] < 0, "E",
\r
554 attr( x, "display",
\r
555 exact = TRUE )[i+1] ),
\r
556 digits = abs( attr( x, "digits",
\r
557 exact = TRUE )[j, i+1] )),
\r
559 cols[j, i+pos] <- do.call("formatC", curFormatArgs)
\r
563 ## End Ian Fellows changes
\r
565 if ( any(ina) ) cols[ina, i+pos] <- NA.string
\r
566 ## Based on contribution from Jonathan Swinton <jonathan@swintons.net>
\r
567 ## in e-mail dated Wednesday, January 17, 2007
\r
568 if ( is.numeric.column ) {
\r
569 cols[, i+pos] <- sanitize.numbers(cols[, i+pos])
\r
571 if (is.null(sanitize.text.function)) {
\r
572 cols[, i+pos] <- sanitize(cols[, i+pos])
\r
574 cols[, i+pos] <- sanitize.text.function(cols[, i+pos])
\r
580 full <- matrix("", nrow = nrow(x), ncol = multiplier*(ncol(x)+pos)+2)
\r
582 full[, multiplier*(0:(ncol(x)+pos-1))+2] <- BTD1
\r
583 full[, multiplier*(0:(ncol(x)+pos-1))+3] <- BTD2
\r
584 full[, multiplier*(0:(ncol(x)+pos-1))+4] <- BTD3
\r
585 full[, multiplier*(0:(ncol(x)+pos-1))+5] <- cols
\r
586 full[, multiplier*(0:(ncol(x)+pos-1))+6] <- ETD
\r
588 full[, multiplier*(ncol(x)+pos)+2] <- paste(EROW, lastcol[-(1:2)],
\r
591 if (type == "latex") full[, 2] <- ""
\r
592 result <- result + lastcol[2] + paste(t(full), collapse = "")
\r
593 if (!only.contents) {
\r
594 if (tabular.environment == "longtable") {
\r
595 ## booktabs change added the if() - 1 Feb 2012
\r
597 result <- result + PHEADER
\r
600 ## fix 10-27-09 Liviu Andronic (landronimirc@gmail.com) the
\r
601 ## following 'if' condition is inserted in order to avoid
\r
602 ## that bottom caption interferes with a top caption of a longtable
\r
603 if(caption.placement == "bottom"){
\r
604 if ((!is.null(caption)) && (type == "latex")) {
\r
605 result <- result + BCAPTION + caption + ECAPTION
\r
608 if (!is.null(attr(x, "label", exact = TRUE))) {
\r
609 result <- result + BLABEL + attr(x, "label", exact = TRUE) +
\r
612 ETABULAR <- "\\end{longtable}\n"
\r
614 result <- result + ETABULAR
\r
615 result <- result + ESIZE
\r
616 if ( floating == TRUE ) {
\r
617 if ((!is.null(caption)) &&
\r
618 (type == "latex" && caption.placement == "bottom")) {
\r
619 result <- result + BCAPTION + caption + ECAPTION
\r
621 if (!is.null(attr(x, "label", exact = TRUE)) &&
\r
622 caption.placement == "bottom") {
\r
623 result <- result + BLABEL + attr(x, "label", exact = TRUE) +
\r
627 result <- result + EENVIRONMENT
\r
628 result <- result + ETABLE
\r
630 result <- sanitize.final(result)
\r
632 if (print.results){
\r
636 return(invisible(result$text))
\r
639 "+.string" <- function(x, y) {
\r
640 x$text <- paste(x$text, as.string(y)$text, sep = "")
\r
644 print.string <- function(x, ...) {
\r
645 cat(x$text, file = x$file, append = x$append)
\r
646 return(invisible())
\r
649 string <- function(text, file = "", append = FALSE) {
\r
650 x <- list(text = text, file = file, append = append)
\r
651 class(x) <- "string"
\r
655 as.string <- function(x, file = "", append = FALSE) {
\r
656 if (is.null(attr(x, "class", exact = TRUE)))
\r
657 switch(data.class(x),
\r
658 character = return(string(x, file, append)),
\r
659 numeric = return(string(as.character(x), file, append)),
\r
660 stop("Cannot coerse argument to a string"))
\r
661 if (class(x) == "string")
\r
663 stop("Cannot coerse argument to a string")
\r
666 is.string <- function(x) {
\r
667 return(class(x) == "string")
\r