1### xtable package 2### 3### Produce LaTeX and HTML tables from R objects. 4### 5### Copyright 2000-2013 David B. Dahl <dahl@stat.byu.edu> 6### 7### Maintained by David Scott <d.scott@auckland.ac.nz> 8### 9### This file is part of the `xtable' library for R and related languages. 10### It is made available under the terms of the GNU General Public 11### License, version 2, or at your option, any later version, 12### incorporated herein by reference. 13### 14### This program is distributed in the hope that it will be 15### useful, but WITHOUT ANY WARRANTY; without even the implied 16### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 17### PURPOSE. See the GNU General Public License for more 18### details. 19### 20### You should have received a copy of the GNU General Public 21### License along with this program; if not, write to the Free 22### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, 23### MA 02111-1307, USA 24print.xtable <- function(x, 25 type = getOption("xtable.type", "latex"), 26 file = getOption("xtable.file", ""), 27 append = getOption("xtable.append", FALSE), 28 floating = getOption("xtable.floating", TRUE), 29 floating.environment = getOption("xtable.floating.environment", "table"), 30 table.placement = getOption("xtable.table.placement", "ht"), 31 caption.placement = getOption("xtable.caption.placement", "bottom"), 32 caption.width = getOption("xtable.caption.width", NULL), 33 latex.environments = getOption("xtable.latex.environments", c("center")), 34 tabular.environment = getOption("xtable.tabular.environment", "tabular"), 35 size = getOption("xtable.size", NULL), 36 hline.after = getOption("xtable.hline.after", c(-1,0,nrow(x))), 37 NA.string = getOption("xtable.NA.string", ""), 38 include.rownames = getOption("xtable.include.rownames", TRUE), 39 include.colnames = getOption("xtable.include.colnames", TRUE), 40 only.contents = getOption("xtable.only.contents", FALSE), 41 add.to.row = getOption("xtable.add.to.row", NULL), 42 sanitize.text.function = getOption("xtable.sanitize.text.function", NULL), 43 sanitize.rownames.function = getOption("xtable.sanitize.rownames.function", 44 sanitize.text.function), 45 sanitize.colnames.function = getOption("xtable.sanitize.colnames.function", 46 sanitize.text.function), 47 math.style.negative = getOption("xtable.math.style.negative", FALSE), 48 math.style.exponents = getOption("xtable.math.style.exponents", FALSE), 49 html.table.attributes = getOption("xtable.html.table.attributes", "border=1"), 50 print.results = getOption("xtable.print.results", TRUE), 51 format.args = getOption("xtable.format.args", NULL), 52 rotate.rownames = getOption("xtable.rotate.rownames", FALSE), 53 rotate.colnames = getOption("xtable.rotate.colnames", FALSE), 54 booktabs = getOption("xtable.booktabs", FALSE), 55 scalebox = getOption("xtable.scalebox", NULL), 56 width = getOption("xtable.width", NULL), 57 comment = getOption("xtable.comment", TRUE), 58 timestamp = getOption("xtable.timestamp", date()), 59 ...) 60{ 61 ## If caption is length 2, treat the second value as the "short caption" 62 caption <- attr(x,"caption",exact = TRUE) 63 short.caption <- NULL 64 if (!is.null(caption) && length(caption) > 1){ 65 short.caption <- caption[2] 66 caption <- caption[1] 67 } 68 69 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 hline.after 70 ## By default it print an \hline before and after the columns names 71 ## independently they are printed or not and at the end of the table 72 ## Old code that set hline.after should include c(-1, 0, nrow(x)) in the 73 ## hline.after vector 74 ## If you do not want any \hline inside the data, set hline.after to NULL 75 ## PHEADER instead the string '\\hline\n' is used in the code 76 ## Now hline.after counts how many time a position appear 77 ## I left an automatic PHEADER in the longtable is this correct? 78 79 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 include.rownames, 80 ## include.colnames 81 pos <- 0 82 if (include.rownames) pos <- 1 83 84 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 85 ## hline.after checks 86 if (any(hline.after < -1) | any(hline.after > nrow(x))) { 87 stop("'hline.after' must be inside [-1, ", nrow(x), "]") 88 } 89 90 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 91 ## add.to.row checks 92 if (!is.null(add.to.row)) { 93 if (is.list(add.to.row) && length(add.to.row) == 2) { 94 if (is.null(names(add.to.row))) { 95 names(add.to.row) <- c('pos', 'command') 96 } else if (any(sort(names(add.to.row))!= c('command', 'pos'))) { 97 stop("the names of the elements of 'add.to.row' must be 'pos' and 'command'") 98 } 99 if (is.list(add.to.row$pos) && is.vector(add.to.row$command, 100 mode = 'character')) { 101 if ((npos <- length(add.to.row$pos)) != 102 length(add.to.row$command)) { 103 stop("the length of 'add.to.row$pos' must be equal to the length of 'add.to.row$command'") 104 } 105 if (any(unlist(add.to.row$pos) < -1) | 106 any(unlist(add.to.row$pos) > nrow(x))) { 107 stop("the values in add.to.row$pos must be inside the interval [-1, ", nrow(x), "]") 108 } 109 } else { 110 stop("the first argument ('pos') of 'add.to.row' must be a list, the second argument ('command') must be a vector of mode character") 111 } 112 } else { 113 stop("'add.to.row' argument must be a list of length 2") 114 } 115 } else { 116 add.to.row <- list(pos = list(), 117 command = vector(length = 0, mode = "character")) 118 npos <- 0 119 } 120 121 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 add.to.row 122 ## Add further commands at the end of rows 123 if (type == "latex") { 124 ## Original code before changes in version 1.6-1 125 ## PHEADER <- "\\hline\n" 126 127 ## booktabs code from Matthieu Stigler <matthieu.stigler@gmail.com>, 128 ## 1 Feb 2012 129 if(!booktabs){ 130 PHEADER <- "\\hline\n" 131 } else { 132 ## This code replaced to fix bug #2309, David Scott, 8 Jan 2014 133 ## PHEADER <- ifelse(-1%in%hline.after, "\\toprule\n", "") 134 ## if(0%in%hline.after) { 135 ## PHEADER <- c(PHEADER, "\\midrule\n") 136 ## } 137 ## if(nrow(x)%in%hline.after) { 138 ## PHEADER <- c(PHEADER, "\\bottomrule\n") 139 ## } 140 if (is.null(hline.after)){ 141 PHEADER <- "" 142 } else { 143 hline.after <- sort(hline.after) 144 PHEADER <- rep("\\midrule\n", length(hline.after)) 145 if (hline.after[1] == -1) { 146 PHEADER[1] <- "\\toprule\n" 147 } 148 if (hline.after[length(hline.after)] == nrow(x)) { 149 PHEADER[length(hline.after)] <- "\\bottomrule\n" 150 } 151 } 152 } 153 } else { 154 PHEADER <- "" 155 } 156 157 lastcol <- rep(" ", nrow(x)+2) 158 if (!is.null(hline.after)) { 159 ## booktabs change - Matthieu Stigler: fill the hline arguments 160 ## separately, 1 Feb 2012 161 ## 162 ## Code before booktabs change was: 163 ## add.to.row$pos[[npos+1]] <- hline.after 164 165 if (!booktabs){ 166 add.to.row$pos[[npos+1]] <- hline.after 167 } else { 168 for(i in 1:length(hline.after)) { 169 add.to.row$pos[[npos+i]] <- hline.after[i] 170 } 171 } 172 add.to.row$command <- c(add.to.row$command, PHEADER) 173 } 174 175 if ( length(add.to.row$command) > 0 ) { 176 for (i in 1:length(add.to.row$command)) { 177 addpos <- add.to.row$pos[[i]] 178 freq <- table(addpos) 179 addpos <- unique(addpos) 180 for (j in 1:length(addpos)) { 181 lastcol[addpos[j]+2] <- paste(lastcol[addpos[j]+2], 182 paste(rep(add.to.row$command[i], 183 freq[j]), 184 sep = "", collapse = ""), 185 sep = " ") 186 } 187 } 188 } 189 190 if (length(type)>1) stop("\"type\" must have length 1") 191 type <- tolower(type) 192 if (!all(!is.na(match(type, c("latex","html"))))) { 193 stop("\"type\" must be in {\"latex\", \"html\"}") 194 } 195 ## Disabling the check on known floating environments as many users 196 ## want to use additional environments. 197 ## if (!all(!is.na(match(floating.environment, 198 ## c("table","table*","sidewaystable", 199 ## "margintable"))))) { 200 ## stop("\"type\" must be in {\"table\", \"table*\", \"sidewaystable\", \"margintable\"}") 201 ## } 202 if (("margintable" %in% floating.environment) 203 & (!is.null(table.placement))) { 204 warning("margintable does not allow for table placement; setting table.placement to NULL") 205 table.placement <- NULL 206 } 207 if (!is.null(table.placement) && 208 !all(!is.na(match(unlist(strsplit(table.placement, split = "")), 209 c("H","h","t","b","p","!"))))) { 210 stop("\"table.placement\" must contain only elements of {\"h\",\"t\",\"b\",\"p\",\"!\"}") 211 } 212 if (!all(!is.na(match(caption.placement, c("bottom","top"))))) { 213 stop("\"caption.placement\" must be either {\"bottom\",\"top\"}") 214 } 215 216 if (type == "latex") { 217 BCOMMENT <- "% " 218 ECOMMENT <- "\n" 219 ## See e-mail from "John S. Walker <jsw9c@uic.edu>" dated 5-19-2003 220 ## regarding "texfloat" 221 ## See e-mail form "Fernando Henrique Ferraz P. da Rosa" 222 ## <academic@feferraz.net>" dated 10-28-2005 regarding "longtable" 223 if ( tabular.environment == "longtable" & floating == TRUE ) { 224 warning("Attempt to use \"longtable\" with floating = TRUE. Changing to FALSE.") 225 floating <- FALSE 226 } 227 if ( floating == TRUE ) { 228 ## See e-mail from "Pfaff, Bernhard <Bernhard.Pfaff@drkw.com>" 229 ## dated 7-09-2003 regarding "suggestion for an amendment of 230 ## the source" 231 ## See e-mail from "Mitchell, David" 232 ## <David.Mitchell@dotars.gov.au>" dated 2003-07-09 regarding 233 ## "Additions to R xtable package" 234 ## See e-mail from "Garbade, Sven" 235 ## <Sven.Garbade@med.uni-heidelberg.de> dated 2006-05-22 236 ## regarding the floating environment. 237 BTABLE <- paste("\\begin{", floating.environment, "}", 238 ifelse(!is.null(table.placement), 239 paste("[", table.placement, "]", sep = ""), 240 ""), "\n", sep = "") 241 if ( is.null(latex.environments) || 242 (length(latex.environments) == 0) ) { 243 BENVIRONMENT <- "" 244 EENVIRONMENT <- "" 245 } else { 246 BENVIRONMENT <- "" 247 EENVIRONMENT <- "" 248 if ("center" %in% latex.environments){ 249 BENVIRONMENT <- paste(BENVIRONMENT, "\\centering\n", 250 sep = "") 251 } 252 for (i in 1:length(latex.environments)) { 253 if (latex.environments[i] == "") next 254 if (latex.environments[i] != "center"){ 255 BENVIRONMENT <- paste(BENVIRONMENT, 256 "\\begin{", latex.environments[i], 257 "}\n", sep = "") 258 EENVIRONMENT <- paste("\\end{", latex.environments[i], 259 "}\n", EENVIRONMENT, sep = "") 260 } 261 } 262 } 263 ETABLE <- paste("\\end{", floating.environment, "}\n", sep = "") 264 } else { 265 BTABLE <- "" 266 ETABLE <- "" 267 BENVIRONMENT <- "" 268 EENVIRONMENT <- "" 269 } 270 271 tmp.index.start <- 1 272 if ( ! include.rownames ) { 273 while ( attr(x, "align", exact = TRUE)[tmp.index.start] == '|' ) 274 tmp.index.start <- tmp.index.start + 1 275 tmp.index.start <- tmp.index.start + 1 276 } 277 ## Added "width" argument for use with "tabular*" or 278 ## "tabularx" environments - CR, 7/2/12 279 if (is.null(width)){ 280 WIDTH <-"" 281 } else if (is.element(tabular.environment, 282 c("tabular", "longtable"))){ 283 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.") 284 WIDTH <- "" 285 } else { 286 WIDTH <- paste("{", width, "}", sep = "") 287 } 288 289 BTABULAR <- 290 paste("\\begin{", tabular.environment, "}", 291 WIDTH, "{", 292 paste(c(attr(x, "align", 293 exact = TRUE)[ 294 tmp.index.start:length(attr(x, "align", 295 exact = TRUE))], 296 "}\n"), 297 sep = "", collapse = ""), 298 sep = "") 299 300 ## fix 10-26-09 (robert.castelo@upf.edu) the following 301 ## 'if' condition is added here to support 302 ## a caption on the top of a longtable 303 if (tabular.environment == "longtable" && caption.placement == "top") { 304 if (is.null(short.caption)){ 305 BCAPTION <- "\\caption{" 306 } else { 307 BCAPTION <- paste("\\caption[", short.caption, "]{", sep = "") 308 } 309 ECAPTION <- "} \\\\ \n" 310 if ((!is.null(caption)) && (type == "latex")) { 311 BTABULAR <- paste(BTABULAR, BCAPTION, caption, ECAPTION, 312 sep = "") 313 } 314 } 315 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 316 ## add.to.row position -1 317 BTABULAR <- paste(BTABULAR, lastcol[1], sep = "") 318 ## the \hline at the end, if present, is set in full matrix 319 ETABULAR <- paste("\\end{", tabular.environment, "}\n", sep = "") 320 321 ## Add scalebox - CR, 7/2/12 322 if (!is.null(scalebox)){ 323 BTABULAR <- paste("\\scalebox{", scalebox, "}{\n", BTABULAR, 324 sep = "") 325 ETABULAR <- paste(ETABULAR, "}\n", sep = "") 326 } 327 328 ## BSIZE contributed by Benno <puetz@mpipsykl.mpg.de> in e-mail 329 ## dated Wednesday, December 01, 2004 330 if (is.null(size) || !is.character(size)) { 331 BSIZE <- "" 332 ESIZE <- "" 333 } else { 334 if(length(grep("^\\\\", size)) == 0){ 335 size <- paste("\\", size, sep = "") 336 } 337 ## Change suggested by Claudius Loehnert reported in Bug #6260 338 ## BSIZE <- paste("{", size, "\n", sep = "") 339 ## ESIZE <- "{\n" 340 BSIZE <- paste("\\begingroup", size, "\n", sep = "") 341 ESIZE <- "\\endgroup\n" 342 } 343 BLABEL <- "\\label{" 344 ELABEL <- "}\n" 345 ## Added caption width (jeff.laake@nooa.gov) 346 if(!is.null(caption.width)){ 347 BCAPTION <- paste("\\parbox{",caption.width,"}{",sep="") 348 ECAPTION <- "}" 349 } else { 350 BCAPTION <- NULL 351 ECAPTION <- NULL 352 } 353 if (is.null(short.caption)){ 354 BCAPTION <- paste(BCAPTION,"\\caption{",sep="") 355 } else { 356 BCAPTION <- paste(BCAPTION,"\\caption[", short.caption, "]{", sep="") 357 } 358 ECAPTION <- paste(ECAPTION,"} \n",sep="") 359 BROW <- "" 360 EROW <- " \\\\ \n" 361 BTH <- "" 362 ETH <- "" 363 STH <- " & " 364 BTD1 <- " & " 365 BTD2 <- "" 366 BTD3 <- "" 367 ETD <- "" 368 } else { 369 BCOMMENT <- "<!-- " 370 ECOMMENT <- " -->\n" 371 BTABLE <- paste("<table ", html.table.attributes, ">\n", sep = "") 372 ETABLE <- "</table>\n" 373 BENVIRONMENT <- "" 374 EENVIRONMENT <- "" 375 BTABULAR <- "" 376 ETABULAR <- "" 377 BSIZE <- "" 378 ESIZE <- "" 379 BLABEL <- "<a name=" 380 ELABEL <- "></a>\n" 381 BCAPTION <- paste("<caption align=\"", caption.placement, "\"> ", 382 sep = "") 383 ECAPTION <- " </caption>\n" 384 BROW <- "<tr>" 385 EROW <- " </tr>\n" 386 BTH <- " <th> " 387 ETH <- " </th> " 388 STH <- " </th> <th> " 389 BTD1 <- " <td align=\"" 390 align.tmp <- attr(x, "align", exact = TRUE) 391 align.tmp <- align.tmp[align.tmp!="|"] 392 if (nrow(x) == 0) { 393 BTD2 <- matrix(nrow = 0, ncol = ncol(x)+pos) 394 } else { 395 BTD2 <- matrix(align.tmp[(2-pos):(ncol(x)+1)], 396 nrow = nrow(x), ncol = ncol(x)+pos, byrow = TRUE) 397 } 398 ## Based on contribution from Jonathan Swinton <jonathan@swintons.net> 399 ## in e-mail dated Wednesday, January 17, 2007 400 BTD2[regexpr("^p", BTD2)>0] <- "left" 401 BTD2[BTD2 == "r"] <- "right" 402 BTD2[BTD2 == "l"] <- "left" 403 BTD2[BTD2 == "c"] <- "center" 404 BTD3 <- "\"> " 405 ETD <- " </td>" 406 } 407 408 result <- string("", file = file, append = append) 409 info <- R.Version() 410 ## modified Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 411 ## to set automatically the package version 412 if (comment){ 413 result <- result + BCOMMENT + type + " table generated in " + 414 info$language + " " + info$major + "." + info$minor + 415 " by xtable " + packageDescription('xtable')$Version + 416 " package" + ECOMMENT 417 if (!is.null(timestamp)){ 418 result <- result + BCOMMENT + timestamp + ECOMMENT 419 } 420 } 421 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 only.contents 422 if (!only.contents) { 423 result <- result + BTABLE 424 result <- result + BENVIRONMENT 425 if ( floating == TRUE ) { 426 if ((!is.null(caption)) && 427 (type == "html" ||caption.placement == "top")) { 428 result <- result + BCAPTION + caption + ECAPTION 429 } 430 if (!is.null(attr(x, "label", exact = TRUE)) && 431 (type == "latex" && caption.placement == "top")) { 432 result <- result + BLABEL + 433 attr(x, "label", exact = TRUE) + ELABEL 434 } 435 } 436 result <- result + BSIZE 437 result <- result + BTABULAR 438 } 439 ## Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 440 ## include.colnames, include.rownames 441 if (include.colnames) { 442 result <- result + BROW + BTH 443 if (include.rownames) { 444 result <- result + STH 445 } 446 ## David G. Whiting in e-mail 2007-10-09 447 if (is.null(sanitize.colnames.function)) { 448 CNAMES <- sanitize(names(x), type = type) 449 } else { 450 CNAMES <- sanitize.colnames.function(names(x)) 451 } 452 if (rotate.colnames) { 453 ##added by Markus Loecher, 2009-11-16 454 CNAMES <- paste("\\begin{sideways}", CNAMES, "\\end{sideways}") 455 } 456 result <- result + paste(CNAMES, collapse = STH) 457 458 result <- result + ETH + EROW 459 } 460 461 cols <- matrix("", nrow = nrow(x), ncol = ncol(x)+pos) 462 if (include.rownames) { 463 ## David G. Whiting in e-mail 2007-10-09 464 if (is.null(sanitize.rownames.function)) { 465 RNAMES <- sanitize(row.names(x), type = type) 466 } else { 467 RNAMES <- sanitize.rownames.function(row.names(x)) 468 } 469 if (rotate.rownames) { 470 ##added by Markus Loecher, 2009-11-16 471 RNAMES <- paste("\\begin{sideways}", RNAMES, "\\end{sideways}") 472 } 473 cols[, 1] <- RNAMES 474 } 475 476 ## Begin vectorizing the formatting code by Ian Fellows [ian@fellstat.com] 477 ## 06 Dec 2011 478 ## 479 ## disp <- function(y) { 480 ## if (is.factor(y)) { 481 ## y <- levels(y)[y] 482 ## } 483 ## if (is.list(y)) { 484 ## y <- unlist(y) 485 ## } 486 ## return(y) 487 ## } 488 varying.digits <- is.matrix( attr( x, "digits", exact = TRUE ) ) 489 ## Code for letting "digits" be a matrix was provided by 490 ## Arne Henningsen <ahenningsen@agric-econ.uni-kiel.de> 491 ## in e-mail dated 2005-06-04. 492 ##if( !varying.digits ) { 493 ## modified Claudio Agostinelli <claudio@unive.it> dated 2006-07-28 494 ## attr(x,"digits") <- matrix( attr( x, "digits",exact=TRUE ), 495 ## nrow = nrow(x), ncol = ncol(x)+1, byrow = TRUE ) 496 ##} 497 for(i in 1:ncol(x)) { 498 xcol <- x[, i] 499 if(is.factor(xcol)) 500 xcol <- as.character(xcol) 501 if(is.list(xcol)) 502 xcol <- sapply(xcol, unlist) 503 ina <- is.na(xcol) 504 is.numeric.column <- is.numeric(xcol) 505 506 if(is.character(xcol)) { 507 cols[, i+pos] <- xcol 508 } else { 509 if (is.null(format.args)){ 510 format.args <- list() 511 } 512 if (is.null(format.args$decimal.mark)){ 513 format.args$decimal.mark <- options()$OutDec 514 } 515 if(!varying.digits){ 516 curFormatArgs <- 517 c(list( 518 x = xcol, 519 format = 520 ifelse(attr(x, "digits", exact = TRUE )[i+1] < 0, "E", 521 attr(x, "display", exact = TRUE )[i+1]), 522 digits = abs(attr(x, "digits", exact = TRUE )[i+1])), 523 format.args) 524 cols[, i+pos] <- do.call("formatC", curFormatArgs) 525 }else{ 526 for( j in 1:nrow( cols ) ) { 527 curFormatArgs <- 528 c(list( 529 x = xcol[j], 530 format = 531 ifelse(attr(x, "digits", exact = TRUE )[j, i+1] < 0, 532 "E", attr(x, "display", exact = TRUE )[i+1]), 533 digits = 534 abs(attr(x, "digits", exact = TRUE )[j, i+1])), 535 format.args) 536 cols[j, i+pos] <- do.call("formatC", curFormatArgs) 537 } 538 } 539 } 540 ## End Ian Fellows changes 541 542 if ( any(ina) ) cols[ina, i+pos] <- NA.string 543 ## Based on contribution from Jonathan Swinton <jonathan@swintons.net> 544 ## in e-mail dated Wednesday, January 17, 2007 545 if ( is.numeric.column ) { 546 cols[, i+pos] <- 547 sanitize.numbers(cols[, i+pos], type = type, 548 math.style.negative = math.style.negative, 549 math.style.exponents = math.style.exponents) 550 } else { 551 if (is.null(sanitize.text.function)) { 552 cols[, i+pos] <- sanitize(cols[, i+pos], type = type) 553 } else { 554 cols[, i+pos] <- sanitize.text.function(cols[, i+pos]) 555 } 556 } 557 } 558 559 multiplier <- 5 560 full <- matrix("", nrow = nrow(x), ncol = multiplier*(ncol(x)+pos)+2) 561 full[, 1] <- BROW 562 full[, multiplier*(0:(ncol(x)+pos-1))+2] <- BTD1 563 full[, multiplier*(0:(ncol(x)+pos-1))+3] <- BTD2 564 full[, multiplier*(0:(ncol(x)+pos-1))+4] <- BTD3 565 full[, multiplier*(0:(ncol(x)+pos-1))+5] <- cols 566 full[, multiplier*(0:(ncol(x)+pos-1))+6] <- ETD 567 568 full[, multiplier*(ncol(x)+pos)+2] <- paste(EROW, lastcol[-(1:2)], 569 sep = " ") 570 571 if (type == "latex") full[, 2] <- "" 572 result <- result + lastcol[2] + paste(t(full), collapse = "") 573 if (!only.contents) { 574 if (tabular.environment == "longtable") { 575 ## booktabs change added the if() - 1 Feb 2012 576 if(!booktabs) { 577 result <- result + PHEADER 578 } 579 580 ## fix 10-27-09 Liviu Andronic (landronimirc@gmail.com) the 581 ## following 'if' condition is inserted in order to avoid 582 ## that bottom caption interferes with a top caption of a longtable 583 if(caption.placement == "bottom"){ 584 if ((!is.null(caption)) && (type == "latex")) { 585 result <- result + BCAPTION + caption + ECAPTION 586 } 587 } 588 if (!is.null(attr(x, "label", exact = TRUE))) { 589 result <- result + BLABEL + attr(x, "label", exact = TRUE) + 590 ELABEL 591 } 592 ETABULAR <- "\\end{longtable}\n" 593 } 594 result <- result + ETABULAR 595 result <- result + ESIZE 596 if ( floating == TRUE ) { 597 if ((!is.null(caption)) && 598 (type == "latex" && caption.placement == "bottom")) { 599 result <- result + BCAPTION + caption + ECAPTION 600 } 601 if (!is.null(attr(x, "label", exact = TRUE)) && 602 caption.placement == "bottom") { 603 result <- result + BLABEL + attr(x, "label", exact = TRUE) + 604 ELABEL 605 } 606 } 607 result <- result + EENVIRONMENT 608 result <- result + ETABLE 609 } 610 result <- sanitize.final(result, type = type) 611 612 if (print.results){ 613 print(result) 614 } 615 616 return(invisible(result$text)) 617} 618 619"+.string" <- function(x, y) { 620 x$text <- paste(x$text, as.string(y)$text, sep = "") 621 return(x) 622} 623 624print.string <- function(x, ...) { 625 cat(x$text, file = x$file, append = x$append) 626 return(invisible()) 627} 628 629string <- function(text, file = "", append = FALSE) { 630 x <- list(text = text, file = file, append = append) 631 class(x) <- "string" 632 return(x) 633} 634 635as.string <- function(x, file = "", append = FALSE) { 636 if (is.null(attr(x, "class", exact = TRUE))) 637 switch(data.class(x), 638 character = return(string(x, file, append)), 639 numeric = return(string(as.character(x), file, append)), 640 stop("Cannot coerce argument to a string")) 641 if (class(x) == "string") 642 return(x) 643 stop("Cannot coerce argument to a string") 644} 645 646is.string <- function(x) { 647 return(class(x) == "string") 648} 649 650