to_latex.R

   1 to.org <- function(x){
   2     sub("([0-9.-]+)([eE])\\+?(-?)0*([0-9]+)","$\\1\\\\times 10^{\\3\\4}$",
   3         x)
   4 }
   5 to.latex <- function(x){
   6   sub("([0-9]+)([eE])\\+?(-?)0*([0-9]+)","\\1\\\\ensuremath{\\\\times 10^{\\3\\4}}",
   7       x)
   8 }
   9 cleanup.tolatex <- function(output) {
  10   gsub("\\\\textrm\\{e\\}(-?)0*(\\d+)","\\\\ensuremath{\\\\times 10^{\\1\\2}}",output);
  11 }
  12
  13 trimws <- function(x,left=TRUE,right=TRUE){
  14   result <- x
  15   if(left)
  16     result <- gsub('^\\s+','',x,perl=TRUE)
  17   if(right)
  18     result <- gsub('\\s+$','',x,perl=TRUE)
  19
  20   return(result)
  21 }
  22
  23
  24 print.summary.glm.xtable <- function (x, digits = max(3, getOption("digits") - 3), symbolic.cor = x$symbolic.cor, signif.stars = getOption("show.signif.stars"), ...) {
  25
  26     cat("\\begin{verbatim}\n")
  27     cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"),
  28         "\n\n", sep = "")
  29     cat("Deviance Residuals: \n")
  30     if (x$df.residual > 5) {
  31         x$deviance.resid <- quantile(x$deviance.resid, na.rm = TRUE)
  32         names(x$deviance.resid) <- c("Min", "1Q", "Median", "3Q",
  33             "Max")
  34     }
  35     xx <- zapsmall(x$deviance.resid, digits + 1)
  36     cat("\\end{verbatim}\n")
  37     print(table.to.latex(xx,digits=digits))
  38     cat("\\begin{verbatim}\n")
  39     if (length(x$aliased) == 0L) {
  40         cat("\nNo Coefficients\n")
  41     }
  42     else {
  43         df <- if ("df" %in% names(x))
  44             x[["df"]]
  45         else NULL
  46         if (!is.null(df) && (nsingular <- df[3L] - df[1L]))
  47             cat("\nCoefficients: (", nsingular, " not defined because of singularities)\n",
  48                 sep = "")
  49         else cat("\nCoefficients:\n")
  50         coefs <- x$coefficients
  51         if (!is.null(aliased <- x$aliased) && any(aliased)) {
  52             cn <- names(aliased)
  53             coefs <- matrix(NA, length(aliased), 4L, dimnames = list(cn,
  54                 colnames(coefs)))
  55             coefs[!aliased, ] <- x$coefficients
  56         }
  57         cat("\\end{verbatim}\n")
  58         colnames(coefs) <- gsub("(Pr\\(>\\|z\\|\\))","$\\1$",colnames(coefs),perl=TRUE)
  59         if (nrow(coefs) > 15) {
  60           print(table.to.latex(coefs,longtable=TRUE))
  61         } else {
  62           print(table.to.latex(coefs))
  63         }
  64         cat("\\begin{verbatim}\n")
  65     }
  66     cat("\n(Dispersion parameter for ", x$family$family, " family taken to be ",
  67         format(x$dispersion), ")\n\n", apply(cbind(paste(format(c("Null",
  68             "Residual"), justify = "right"), "deviance:"), format(unlist(x[c("null.deviance",
  69             "deviance")]), digits = max(5, digits + 1)), " on",
  70             format(unlist(x[c("df.null", "df.residual")])), " degrees of freedom\n"),
  71             1L, paste, collapse = " "), sep = "")
  72     if (nzchar(mess <- naprint(x$na.action)))
  73         cat("  (", mess, ")\n", sep = "")
  74     cat("AIC: ", format(x$aic, digits = max(4, digits + 1)),
  75         "\n\n", "Number of Fisher Scoring iterations: ", x$iter,
  76         "\n", sep = "")
  77     correl <- x$correlation
  78     if (!is.null(correl)) {
  79         p <- NCOL(correl)
  80         if (p > 1) {
  81             cat("\nCorrelation of Coefficients:\n")
  82             if (is.logical(symbolic.cor) && symbolic.cor) {
  83                 print(symnum(correl, abbr.colnames = NULL))
  84             }
  85             else {
  86                 correl <- format(round(correl, 2), nsmall = 2,
  87                   digits = digits)
  88                 correl[!lower.tri(correl)] <- ""
  89                 print(correl[-1, -p, drop = FALSE], quote = FALSE)
  90             }
  91         }
  92     }
  93     cat("\\end{verbatim}\n")
  94     cat("\n")
  95     invisible(x)
  96 }
  97
  98
  99
 100 table.to.latex <- function(table,
 101                            digits=NULL,
 102                            format=NULL,
 103                            scientific=NA,
 104                            nsmall=0,
 105                            colspec="r",
 106                            useBooktabs=TRUE,
 107                            longtable=FALSE,
 108                            caption=NULL,
 109                            label=NULL,
 110                            rownames=TRUE,
 111                            centering=FALSE,
 112                            latex.pos="",
 113                            toprule=if(useBooktabs) "\\toprule" else "\\hline\\hline",
 114                            midrule=if(useBooktabs) "\\midrule" else "\\hline",
 115                            bottomrule=if(useBooktabs) "\\bottomrule" else "\\hline\\hline",
 116                            cols.as.is=FALSE,
 117                            ...) {
 118   ans <- ""
 119   header <- c(if(rownames){""}else{NULL},colnames(table));
 120   .format.function <- function(x){
 121     format(if(is.null(format)||is.null(scientific)) {x} else {
 122       if(!is.na(suppressWarnings(as.numeric(x)))) as.numeric(x) else x},
 123            digits=digits,nsmall=nsmall,scientific=scientific,...)
 124   }
 125   if(is.null(dim(table))){
 126     header <- names(table)
 127     rownames <- FALSE
 128   }
 129   res <- rbind(header,
 130                cbind(if(rownames){rownames(table)}else{NULL},
 131                      if(is.null(dim(table))){t(sapply(table,.format.function))} else
 132                      {apply(table,1:2,.format.function)}
 133                      ))
 134   res[,] <- gsub("_","\\\\_",res[,])
 135   if (!missing(cols.as.is)) {
 136       res.no.change <-
 137           rbind(header,
 138                 cbind(if(rownames){rownames(table)}else{NULL},
 139                       if(is.null(dim(table))){
 140                           t(sapply(table,function(x){x}))
 141                       } else {
 142                           apply(table,1:2,function(x){x})
 143                       }
 144                       ))
 145       res[,cols.as.is] <- res.no.change[,cols.as.is]
 146   }
 147   ignore.rows <- -1
 148   coefrows <- 2:NROW(res)
 149   if(rownames) {
 150       coefrows <- 1:NROW(res)
 151       ignore.rows <- TRUE
 152   }
 153 ##  res[coefrows,ignore.rows] <- sub("(\\*+)","$^{\\1}$",
 154 ##                                   res[coefrows,ignore.rows])
 155   if (NROW(res) > 1) {
 156       res[coefrows,ignore.rows] <- sub("([0-9]+)([eE])\\+?(-?)0*([0-9]+)","\\1\\\\ensuremath{\\\\times 10^{\\3\\4}}",
 157                                        res[coefrows,ignore.rows])
 158   }
 159   tabspec <- rep("l",ncol(res))
 160   if (length(colspec)==length(tabspec) &&
 161       length(colspec) > 1
 162       ) {
 163     tabspec <- colspec
 164   }
 165
 166   tabbegin <- paste("\\begin{tabular}{",paste(tabspec,collapse=""),"}",sep="")
 167   tabend <- "\\end{tabular}\n"
 168   if (longtable) {
 169     tabbegin <- paste("\\begin{longtable}{",paste(tabspec,collapse=""),"}",sep="")
 170     tabend <- "\\end{longtable}\n"
 171     if (!is.null(label)) {
 172       tabend <- paste(sep="","\\label{",label,"}\\\\","\n",
 173                       tabend
 174                       )
 175     }
 176     if(!is.null(caption))
 177       tabend <- paste(sep="","\\caption{",caption,"}\\\\","\n",
 178                       tabend
 179                       )
 180   } else if (!is.null(label)) {
 181       tabbegin <- paste0("\\begin{table}",latex.pos,"\n",
 182                          if (centering) {"\\centering\n"} else {""},
 183                          tabbegin)
 184       if (!is.null(caption)) {
 185           tabend <- paste0(tabend,"\\caption{",caption,"}\n")
 186       }
 187       tabend <- paste0(tabend,"\\label{",label,"}\n",
 188                        "\\end{table}","\n")
 189   }
 190   ans <- c(ans,tabbegin)
 191   header <- NULL
 192   if(length(toprule))
 193     header <- c(header,toprule)
 194   if (!rownames)
 195     header <- c(header,paste("\\multicolumn{1}{c}{",gsub("\\_"," ",trimws(res[1,1])),"}",sep=""))
 196   for(j in 2:ncol(res))
 197     header <- c(header,paste(" & \\multicolumn{1}{c}{",gsub("\\_"," ",trimws(res[1,j])),"}",sep=""))
 198   header <- c(header,"\\\\")
 199   if(length(midrule))
 200     header <- c(header,midrule)
 201   if (longtable)
 202     header <- c(header,"\\endhead")
 203   ans <- c(ans,header)
 204   if (NROW(res) > 1) {
 205       for(i in 2:NROW(res)) {
 206           ans <- c(ans,
 207                    paste(paste(res[i,],collapse=" & "),"\\\\"))
 208       }
 209   }
 210   if(length(bottomrule))
 211     ans <- c(ans,bottomrule)
 212   ans <- c(ans,tabend)
 213   structure(ans,class="Latex")
 214
 215 }