r - 将统计信息分成多列

Question

我正在尝试使用stargazer两个单独的回归模型的结果创建一个回归表。我希望表格显示回归系数、95% 置信区间、t 值和 p 值，并且我已经做到了这一点：

library(stargazer)

data(iris)
attach(iris)

model1 <- lm(Sepal.Length ~ Petal.Length * Petal.Width)
model2 <- lm(Sepal.Width ~ Petal.Length * Petal.Width)

stargazer(model1, model2,
          title="Results",
          align=TRUE,
          type = "text",
          dep.var.labels=c("Sepal length","Sepal width"),
          covariate.labels=c("Petal length","Petal width","Interaction"),
          ci=TRUE,
          report = "vcstp",
          ci.level=0.95,
          keep.stat="n",
          model.numbers=FALSE,
          notes = "",
          notes.append = FALSE,
          notes.label="",
          digits = 2,
          initial.zero = FALSE,
          single.row=TRUE)

Results
===================================================
                      Dependent variable:          
             --------------------------------------
                Sepal length        Sepal width    
---------------------------------------------------
Petal length   .44 (.31, .57)    -.37 (-.49, -.26) 
                  t = 6.74           t = -6.22     
                  p = 0.00            p = 0.00     
Petal width  -1.24 (-1.67, -.81) -.71 (-1.10, -.31)
                  t = -5.65          t = -3.51     
                 p = 0.0000           p = .001     
Interaction    .19 (.12, .25)      .22 (.16, .28)  
                  t = 5.62            t = 7.13     
                 p = 0.0000           p = 0.00     
Constant      4.58 (4.36, 4.80)  4.04 (3.84, 4.24) 
                  t = 40.89          t = 39.31     
                  p = 0.00            p = 0.00     
---------------------------------------------------
Observations         150                150        
===================================================

但是，我希望每个模型的结果出现在 3 列中：一列带有系数和 CI，一列带有 t 值，1 列带有 p 值。

在下面的尝试中，我尝试使用该column.separate函数为每个模型创建 3 列结果，然后使用系数、t 值和 p 值作为单独的输入，但我最终得到了 6 个表的输出，其中一个用于我想要的每个结果子集，而不是包含所有内容的 1 个表：

stargazer(summary(model1)$coefficients[,1], summary(model1)$coefficients[,3], summary(model1)$coefficients[,4], summary(model2)$coefficients[,1], summary(model2)$coefficients[,3], summary(model2)$coefficients[,4],
          title="Results",
          align=TRUE,
          type = "text",
          dep.var.labels=c("Sepal length","Sepal width"),
          ci=TRUE,
          report = "vcstp",
          ci.level=0.95,
          keep.stat="n",
          model.numbers=FALSE,
          notes = "",
          notes.append = FALSE,
          notes.label="",
          digits = 2,
          initial.zero = FALSE,
          single.row=TRUE,
          column.separate=c(3,3))

Results
=============================================================
(Intercept) Petal.Length Petal.Width Petal.Length:Petal.Width
-------------------------------------------------------------
4.58            .44         -1.24              .19           
-------------------------------------------------------------


Results
=============================================================
(Intercept) Petal.Length Petal.Width Petal.Length:Petal.Width
-------------------------------------------------------------
40.89           6.74        -5.65              5.62          
-------------------------------------------------------------


Results
=============================================================
(Intercept) Petal.Length Petal.Width Petal.Length:Petal.Width
-------------------------------------------------------------
0                0         0.0000             0.0000         
-------------------------------------------------------------


Results
=============================================================
(Intercept) Petal.Length Petal.Width Petal.Length:Petal.Width
-------------------------------------------------------------
4.04            -.37        -.71               .22           
-------------------------------------------------------------


Results
=============================================================
(Intercept) Petal.Length Petal.Width Petal.Length:Petal.Width
-------------------------------------------------------------
39.31          -6.22        -3.51              7.13          
-------------------------------------------------------------


Results
=============================================================
(Intercept) Petal.Length Petal.Width Petal.Length:Petal.Width
-------------------------------------------------------------
0                0          .001                0            
-------------------------------------------------------------

任何帮助将不胜感激！

更新：作者stargazer通知我，目前（5.2 版，2015-07-14 发布），我所追求的格式无法使用stargazer.

score 2 · Accepted Answer

Here's a function to do what you want - you can export to HTML, Latex and ASCII.

# 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 
# out: the output format (default ASCII)
# title: 

print_models <- function(models, dp=2, ralign=1, out="text", title="Results") {

# figure out seperator
sep <- ifelse(out=="latex" || out=="html", " ", "|")

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("Dependent 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 && j <= output.nrows) {
            output[j,i] <- paste(ifelse(j > 2 && j<output.nrows, paste0(" ", sep, " "), "   "), 
                                 ifelse(ralign==1,
                                        paste(rep(" ", max(0,max_len - nchar(output[j,i]))), collapse=""),
                                        output[j,i]),
                                 ifelse(ralign==0,
                                        paste(rep(" ", max(0,max_len - nchar(output[j,i]))), collapse=""),
                                        output[j,i]))
        } else { 
            if(j==output.nrows && i > 1) {
                output[j,i] <- paste(paste(rep(" ", 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="") )
            }
        }
    }
}

if(out=="text") {
     # ASCII formatting 
    msg_width <- sum(sapply(output[1,],nchar))
    msg <- paste(title, "\n")

    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")
        }
    }
    cat(msg)
} else if(out=="latex") {
    # TEX formatting
    alignment <- ifelse(ralign, paste0("l|", paste(rep("r|", output.ncols-1), collapse="")),
                        paste0("l|", paste(rep("l|", output.ncols-1), collapse="")))
    msg <- paste0("\n% \\usepackage{multicolumn}\n\\begin{table}[ht]\n\\centering\n", 
                  "\\begin{tabular}{|", alignment, "} \\hline\n", 
                    "&  \\multicolumn{", output.ncols - 1, "}{c|}{\\textit{Dependent Variable}}",
                  "\\\\ \\cline{2-", output.ncols, "}\n\\textit{Parameter}")

    for(i in seq(2, output.ncols, 3)) {
        msg <- paste0(msg, "& \\multicolumn{3}{c|}{", output[2,i], "} ")
    }
    msg <- paste0(msg, "\\\\ \\cline{2-", output.ncols, "}\n", 
                  paste(rep("& CI & t & p ", (output.ncols - 1)/3), collapse=""), "\\\\ \\hline \n")

    for(i in 4:(output.nrows-1)) {
        msg <- paste0(msg, "\n")
        for(j in 1:(output.ncols-1)) {
            msg <- paste0(msg, output[i,j], " & ")
        }
        msg <- paste0(msg, output[i,output.ncols], " \\\\")
    }
    msg <- paste0(msg, " \\hline", "\nObservations")

    for(i in seq(4,output.ncols,3)) {
        msg <- paste0(msg, "& \\multicolumn{3}{c|}{", output[output.nrows, i], "} ")            
    }
    msg <- paste0(msg, "\\\\ \\hline\n\\end{tabular}\n\\caption{", title, "}\n\\end{table}")
    cat(msg)
} else { 
    # html formatting
    msg <- paste0('\n<table frame="box" cellpadding="0" cellspacing="0">\n<tr> <td> </td>',
                  ' <td colspan="', (output.ncols - 1), '" style="border-bottom: 1px solid black; solid black; text-align:center; border-left: 1px solid black">',
                  ' <em> Dependent Variable </em> </td> </tr>', '\n<tr> <td> &nbsp; <em> Parameter </em> &nbsp; </td>')

    for(i in seq(2, output.ncols, 3)) {
        msg <- paste0(msg, '<td colspan="3" style="text-align:center; border-left: 1px solid black; border-bottom: 1px solid black"> &nbsp; ', 
                      output[2,i], ' &nbsp; </td>')
    }
    msg <- paste0(msg, ' </tr>\n<tr> <td style="border-bottom: 1px solid black"> </td> ', 
                   paste(rep(paste('<td style="border-left: 1px solid black; border-bottom: 1px solid black"> &nbsp; CI &nbsp; </td>',
                         '<td style="border-bottom: 1px solid black; border-left: 1px solid black"> &nbsp; t &nbsp; </td>',
                         '<td style="border-bottom: 1px solid black; border-left: 1px solid black"> &nbsp; p &nbsp; </td>'), (output.ncols-1)/3), collapse=""),
                  ' </tr>')

    for(i in 4:(output.nrows-1)) {
        msg <- paste0(msg, '\n<tr>')
        msg <- paste0(msg, ' <td style="border-right: 1px solid black;', 
                      ifelse(ralign, ' text-align: left">', '">'), '&nbsp; ',
                      output[i,1], ' &nbsp; </td>')
        for(j in 2:(output.ncols-1)) {
            msg <- paste0(msg, ' <td style="border-right: 1px solid black;', 
                          ifelse(ralign, ' text-align: right">', '">'), '&nbsp; ',
                          output[i,j], ' &nbsp; </td>')
        }
        msg <- paste0(msg, ' <td> &nbsp; ', output[i,output.ncols], ' </td>  &nbsp; </tr>')
    }
    msg <- paste0(msg, '\n<tr> <td style="border-top: 1px solid black"> &nbsp; Observations &nbsp; </td>')

    for(i in seq(4,output.ncols,3)) {
        msg <- paste0(msg, ' <td colspan="3" style="text-align:center; border-left: 1px solid black; border-top: 1px solid black"> ',
                     '&nbsp; ', output[output.nrows,i], ' &nbsp; </td>')       
    }
    msg <- paste0(msg, '\n<caption> ', title, ' </caption>\n </table>')
    cat(msg)
}

}

Demo

models <- list(model1=lm(Sepal.Length~Petal.Length*Petal.Width, data=iris),
           model2=lm(Sepal.Width~Petal.Length*Petal.Width, data=iris))
print_models(models, dp = 2, ralign = 1, out = "text", 
             title="Regression  results (iris dataset)")

print_models(models, dp = 2, ralign = 1, out = "latex", 
             title="Regression results (iris dataset)")

print_models(models, dp = 2, ralign = 1, out = "html", 
             title="Regression results (iris dataset)")

r - 将统计信息分成多列

1 回答 1

Related

Reference