data(iris)
attach(iris)
library(xtable)
# models: a list of lm models
# dp: number of decimal places to round results to
# ralign: 1 if output should be right align in numeric cols
print_models <- function(models, dp=2, ralign=1, sep="|", show_output=T) {
ncols <- length(models)
# assume both models have the same number of rows
nrows <- length(models[[1]]$coefficients)
coef <- matrix("0", nrows, ncols)
CI <- matrix("0", nrows, ncols)
t <- matrix("0", nrows, ncols)
p <- matrix("0", nrows, ncols)
nobs <- numeric(2)
output.row.names <- character(nrows)
output.col.names <- character(ncols)
# fill the matrices with character elements
for( i in 1:ncols ) {
model <- models[[i]]
model.summary <- summary(model)
model.ci <- confint(model)
model.coef <- coef(model.summary)
nobs[i] <- length(model$residuals)
CI.separate <- aperm(round( model.ci , dp ))
coef.separate <- round( model.coef[,1], dp )
t.separate <- round( model.coef[,3], dp )
p.separate <- round( model.coef[,4], dp )
output.col.names[i] <- names(attributes(model$terms)$dataClasses)[1]
if(i==1) { # figure out the row names
output.row.names <- row.names(model.coef)
}
coef[,i] <- coef.separate
t[,i] <- t.separate
p[,i] <- p.separate
# deal with CI
for(j in 1:nrows) {
CI[j,i] <- paste0("(", paste(CI.separate[ ((j-1)*2 + 1) : (j*2) ], collapse=", "),
")")
}
}
rm(model, model.summary, model.ci, model.coef)
# creates matrix of character strings by column
output.nrows <- nrows + 4
output.ncols <- ncols + 1
output <- matrix(c(
c("Variable: ", "", "", output.row.names, "Observations")
), output.nrows, 1, byrow=FALSE)
for(i in 2:output.ncols) {
output_col <- c("", output.col.names[i-1], "CI", CI[,i-1], "")
output <- matrix(c(output,output_col),nrow=output.nrows)
output_col <- c("","","t",t[,i-1],"")
output <- matrix(c(output,output_col),nrow=output.nrows)
output_col <- c("","","p",p[,i-1],nobs[i-1])
output <- matrix(c(output,output_col),nrow=output.nrows)
}
output.ncols <- (output.ncols-1)*3 + 1
# padding
for(i in 1:output.ncols) {
max_len <- max(nchar(output[,i]))
for(j in 1:output.nrows) {
if(i > 1 && ralign && j <= output.nrows) {
output[j,i] <- paste(ifelse(j > 2 && j<output.nrows, paste0(" ", sep, " "), " "),
paste(rep(" ", max(0,max_len - nchar(output[j,i]))), collapse=""),
output[j,i])
} else {
# left align
if(j==output.nrows && i > 1) {
output[j,i] <- paste(paste(rep(" ", max(0,max_len - nchar(output[j,i]))), collapse=""),
output[j,i])
} else {
output[j,i] <- paste(output[j,i], paste(rep(" ", max(0,max_len - nchar(output[j,i]))),
collapse="") )
}
}
}
}
msg_width <- sum(sapply(output[1,],nchar))
msg <- ""
for(i in 1:output.nrows ) {
if(i==1 || i==output.nrows) {
msg <- paste0(msg, paste(rep("=", msg_width+4), collapse=""), "\n",
paste0(sep, " "), paste(output[i,], collapse=""), paste0(" ",sep), "\n")
} else {
msg <- paste0(msg, paste0(sep, " "), paste(rep("-", msg_width+2), collapse=""), "\n",
paste0(sep, " "), paste(output[i,], collapse=""), paste0(" ",sep), "\n")
}
if(i==output.nrows) {
msg <- paste0(msg, paste(rep("=", msg_width+4), collapse=""),"\n")
}
}
if(show_output) cat(msg)
output
}
model1 <- lm(Sepal.Length ~ Petal.Length * Petal.Width)
model2 <- lm(Sepal.Width ~ Petal.Length * Petal.Width)
model3 <- lm(Sepal.Width ~ Petal.Length * Petal.Width)
models <- list(model1, model2)
tmp <- print_models(models, dp=2, ralign=1, sep="|", show_output=TRUE)
## =======================================================================================================
## | Variable: |
## | -----------------------------------------------------------------------------------------------------
## | Sepal.Length Sepal.Width |
## | -----------------------------------------------------------------------------------------------------
## | | CI | t | p | CI | t | p |
## | -----------------------------------------------------------------------------------------------------
## | (Intercept) | (4.36, 4.8) | 40.89 | 0 | (3.83, 4.24) | 39.31 | 0 |
## | -----------------------------------------------------------------------------------------------------
## | Petal.Length | (0.31, 0.57) | 6.74 | 0 | (-0.49, -0.25) | -6.22 | 0 |
## | -----------------------------------------------------------------------------------------------------
## | Petal.Width | (-1.67, -0.81) | -5.65 | 0 | (-1.1, -0.31) | -3.51 | 0 |
## | -----------------------------------------------------------------------------------------------------
## | Petal.Length:Petal.Width | (0.12, 0.25) | 5.62 | 0 | (0.16, 0.28) | 7.13 | 0 |
## =======================================================================================================
## | Observations 150 150 |
## =======================================================================================================
output_latex <- function(models) {
res <- print_models(models, dp=2, ralign=1, sep=" ", show_output=FALSE)
# uses right align
print(xtable(res,align=c('l','|l',rep('r',ncol(res)-2), 'r|'),
caption="Summary statistics"), include.rownames = F, include.colnames=F)
}
output_latex(models)
## % latex table generated in R 3.2.1 by xtable 1.7-4 package
## % Fri Aug 14 17:28:37 2015
## \begin{table}[ht]
## \centering
## \begin{tabular}{|lrrrrrr|}
## \hline
## \hline
## Variable: & & & & & & \\
## & Sepal.Length & & & Sepal.Width & & \\
## & CI & t & p & CI & t & p \\
## (Intercept) & (4.36, 4.8) & 40.89 & 0 & (3.83, 4.24) & 39.31 & 0 \\
## Petal.Length & (0.31, 0.57) & 6.74 & 0 & (-0.49, -0.25) & -6.22 & 0 \\
## Petal.Width & (-1.67, -0.81) & -5.65 & 0 & (-1.1, -0.31) & -3.51 & 0 \\
## Petal.Length:Petal.Width & (0.12, 0.25) & 5.62 & 0 & (0.16, 0.28) & 7.13 & 0 \\
## Observations & & & 150 & & & 150 \\
## \hline
## \end{tabular}
## \caption{Summary statistics}
## \end{table}