需求
目前还没有在R里面发现可以直接生成金融学论文常见的表格样式的包，例如下图所示的Liu et al.（2019）的Table 2做的Fama-MacBeth回归结果，每一列分别代表因变量和不同自变量回归的结果，可以把不同的回归模型放在同一个表格里面进行比较，同时每一个参数下方的括号汇报了（经调整的）t统计量，最下面一行汇报了模型的一些参数。
为了日常写论文时对比分析模型的方便，写了一些函数，可以直接用R生成上述表格。并且可以通过RMarkdown输出为html、docx等格式
目前还只能做到最简单的OLS回归（调用lm函数），t统计量也不能进行调整，但是可以很容易对函数进行修改以实现广义最小二乘（glm）、面板数据回归（plm）以及调整t统计量等功能。未来可能会在函数的参数里面加入这些功能，但目前来说已经够用了。
函数目录
提供如下几个函数
lmWithMultipleXY：针对一个数据集，使用不同的因变量对自变量的不同组合进行回归，返回一个list，里面每一个元素都是模型在lm函数下的拟合结果；lmFitToPaperTable：把单个lm的输出做成论文的表格MultiLmFitToPaperTable：多个lm对象输出为论文的格式，支持每一个lm对象的自变量不一样exportFitPaperTable：把lmFitToPaperTable和MultiLmFitToPaperTable输出的论文格式通过RMarkdown输出为html、docx、md等格式
例子
函数会直接放在本文的最后，这一部分直接以例子来讲解函数的使用。我们以R自带的mtcars数据集进行分析。
1. 不同的因变量对自变量的不同组合进行回归
使用mpg和cyl作为因变量分别对不同的变量组合进行回归，回归结果存在一个list里面，每一个元素都是某一个模型回归的结果。
ys <- colnames(mtcars[1: 2])
xs <- list(colnames(mtcars[3]), colnames(mtcars[3: 4]))
fit <- lmWithMultipleXY(ys, xs, mtcars)
fit_vars <- sapply(fit, function(x) all.vars(x[["terms"]]))
print(fit_vars)
# $mpg_x1
# [1] "mpg" "disp"
# $mpg_x2
# [1] "mpg" "disp" "hp"
# $cyl_x1
# [1] "cyl" "disp"
# $cyl_x2
# [1] "cyl" "disp" "hp"2. 回归结果制表
单个回归结果制表，传入lm返回的对象
fit_table_1 <- lmFitToPaperTable(fit[[1]])
View(fit_table_1)建议结果直接在RStudio里面View，看起来更方便点
把这个结果最简单粗暴地复制到Word文档里面的方法是，先在Excel里面把一部分区域的类型调整为“文本”格式（这样可以使括号在粘贴后不会消失），然后把View的结果包括列名全部选中复制，以文本格式在Excel里面粘贴，再进行调整即可：
这个方法有一个缺点是*不是上标，最开始的处理方法是，表格粘贴到Word里面后，把*替换为上标，可以参考这篇《WORD中如何给内容批量加上标？》，不过只要不是要展示给别人，是不是上标影响不大。这里讲到的方法是为最开始使用的方法，在表格不多时也比较方便，但后面会讲如何用RMarkdown直接输出。
另外，lmFitToPaperTable函数可以选择横表，括号里可以选择标准差，结果这里就不展示了。
View(lmFitToPaperTable(fit[[1]], table_type="H"))
View(lmFitToPaperTable(fit[[1]], stats_in_paren="Std. Error"))3. 多个回归结果制表
传入lmFitToPaperTable函数返回的对象到MultiLmFitToPaperTable函数里面即可制表
fit_table_2 <- MultiLmFitToPaperTable(fit)
View(fit_table_2)
这样就成功实现了增减控制变量后，不同模型一起比较的问题。输出到Word里面以及让*上标的方法和上一节提到的一样。
同样的，MultiLmFitToPaperTable支持括号里是t值还是标准差
View(MultiLmFitToPaperTable(fit, stats_in_paren="Std. Error"))4. 表格直接输出为文档
通过向RMarkdown传参可以直接将表格输出为文档，exportFitPaperTable函数是这个功能的封装，默认输出html格式的文档，也可以输出docx格式的文档。并且通过运用markdown文档的数学公式语法，可以直接将*表示为上标。
具体实现上，exportFitPaperTable函数将表格作为参数传入到rmd模板文件中，然后对表格格式进行优化，再输出为指定格式文档。
例如下面的代码分别将MultiLmFitToPaperTable函数得到的表格输出为html和docx文档，默认在当前工作目录下。需要注意的是，fit_paper_table.Rmd这个文档是输出模板，需要预先放在目录里面。
exportFitPaperTable(fit_table_2, rmd_file="./fit_paper_table.Rmd")
exportFitPaperTable(fit_table_2, rmd_file="./fit_paper_table.Rmd", file_type="word")
到目前为止，基本上实现了R调整控制变量的批量回归以及制作论文表格的全流程。
然而目前输出到Word文档的方式仍然有一点问题，主要在于使用数学公式表达来处理*的上标问题，使得整个表格的数字部分全是公式格式，在表格太多时可能会影响word的性能，同时Word的数学公式的字体不是Times New Roman也有一点问题。当然，最优解可能是输出为markdown文档，然后在LaTeX里面写作，然而当前这个函数直接输出为markdown文档还有些问题，后续再修复这个bug。
函数
下面展示了使用了的函数，注释部分表明了参数的用法
################ 批量回归 ####
lmWithMultipleXY <- function(ys, xs, df, ...) {
# 针对一个数据集，使用不同的因变量对自变量的不同组合进行回归，
# 返回一个list，里面每一个元素都是模型在lm函数下的拟合结果
# ys: 是一个向量，包含需要回归的y
# xs: 是list，每一个元素是一个向量，包含需要回归的自变量组合
# df: data.frame对象，回归数据集
# ...: 任意传给lm函数的参数，例如subset，weights等等
if(inherits(xs, "list") == FALSE) stop("xs必须为list")
fit_lt <- list()
cnt <- 1
for(i in 1: length(ys)) {
for(j in 1: length(xs)) {
x <- xs[[j]]
formula_i <- as.formula(paste0(ys[i], " ~ ."))
fit_i <- lm(formula_i, df[, c(ys[i], x)], ...)
fit_lt[[cnt]] <- fit_i
cnt <- cnt + 1
}
}
names(fit_lt) <- paste0(rep(ys, each=length(xs)), "_x", seq_along(xs))
return(fit_lt)
}
################ 输出格式调整 ####
lmFitToPaperTable <- function(lm_list, table_type="V", stats_in_paren="t value") {
# 把lm的输出做成论文的表格
# H代表横着，V代表竖着
# stats_in_paren表示估计出来的参数下方括号是什么可选：
# t值："t value"
# 标准差："Std. Error"
# P值："Pr(>|t|)"
reg_stats_name <- c("R-Squared", "Observations")
reg_stats_num <- length(reg_stats_name)
lm_summary <- summary(lm_list)
lm_coef <- lm_summary[["coefficients"]]
coef_num <- nrow(lm_coef)
res <- data.frame(matrix(NA, coef_num + reg_stats_num, 2))
rownames(res) <- c(rownames(lm_coef), reg_stats_name)
# 估计参数的星星
# 这里调整*的分位数
lm_est <- formatDecimal(lm_coef[, "Estimate"], 4)
lm_est_p_star <- symnum(lm_coef[, "Pr(>|t|)"], corr=FALSE, na=FALSE,
cutpoints=c(0, 0.01, 0.05, 0.1, 1), symbols=c("***", "**", "*", ""))
lm_est <- paste0(lm_est, lm_est_p_star)
res[1: coef_num, 1] <- lm_est
# 标准差/t值/P值
res[1: coef_num, 2] <- paste0("(", formatDecimal(lm_coef[, stats_in_paren], 2), ")")
# 统计量
res["R-Squared", 1] <- formatDecimal(lm_summary[["adj.r.squared"]], 4)
res["Observations", 1] <- length(lm_summary[["residuals"]]) # 估计数量
res[is.na(res)] <- ""
if(table_type == "H") {
return(t(res))
} else if(table_type == "V") {
new_res <- generateVerticalPaperTable(rownames(lm_coef), reg_stats_name)
new_res[seq(1, coef_num * 2, 2), 2] <- res[1: coef_num, 1]
new_res[seq(2, coef_num * 2, 2), 2] <- res[1: coef_num, 2]
new_res[(coef_num * 2 + 1): (coef_num * 2 + reg_stats_num), 2] <- res[reg_stats_name, 1]
return(new_res)
}
}
MultiLmFitToPaperTable <- function(fit_lt, stats_in_paren="t value", reg_stats=c("R-Squared", "Observations")) {
# 多个lm对象输出为论文的格式，只能以列的方式输出
# reg_stats是放在表格最后，展示回归信息的统计量，和lmFitToPaperTable挂钩
fit_table <- lapply(fit_lt, function(x) lmFitToPaperTable(x, table_type="V", stats_in_paren=stats_in_paren))
# 最终的第一列参数名称，要保证顺序不变
table_x <- c()
for(i in 1: length(fit_lt)) {
table_x <- unique(c(table_x, names(coef(fit_lt[[i]]))))
}
# 把参数值按照最终变量名称填入到表格中
new_fit_table_lt <- list()
for(i in 1: length(fit_table)) {
blank_table <- generateVerticalPaperTable(table_x, reg_stats)
fit_table_i <- fit_table[[i]]
x <- names(coef(fit_lt[[i]]))
x_index <- rep(NA, length(x) * 2)
x_index[seq(1, length(x_index) - 1, 2)] <- match(x, blank_table[, 1])
x_index[seq(2, length(x_index), 2)] <- match(x, blank_table[, 1]) + 1
blank_table[x_index, "Value"] <- fit_table_i[1: length(x_index), "Value"]
blank_table[match(reg_stats, blank_table[, 1]), "Value"] <- fit_table_i[match(reg_stats, fit_table_i[, 1]), "Value"]
new_fit_table_lt[[i]] <- blank_table
}
res <- data.frame(new_fit_table_lt[[1]][, 1], sapply(new_fit_table_lt, function(x) x[, 2]), stringsAsFactors=FALSE)
colnames(res)[1] <- ""
if(is.null(names(fit_lt))) {
colnames(res)[2: ncol(res)] <- paste0("Fit_", 1: length(fit_lt))
} else {
colnames(res)[2: ncol(res)] <- names(fit_lt)
}
return(res)
}
formatDecimal <- function(x, k) {
trimws(format(round(x, k), nsmall=k))
}
generateVerticalPaperTable <- function(coef_name, reg_stats_name=c("R-Squared", "Observations")) {
coef_num <- length(coef_name)
reg_stats_num <- length(reg_stats_name)
res <- data.frame(matrix("", coef_num * 2 + reg_stats_num, 2), stringsAsFactors=F)
colnames(res) <- c("", "Value")
res[c(seq(1, coef_num * 2, 2), (coef_num * 2 + 1): (coef_num * 2 + reg_stats_num)), 1] <- c(coef_name, reg_stats_name)
return(res)
}
################ 输出为文档 ####
exportFitPaperTable <- function(fit_paper_table, rmd_file="./fit_paper_table.Rmd", output_dir="./",
output_file_name="fit_paper_table", file_type="html", open_file=FALSE) {
# rmd_file rmd文档的路径
# output_dir 是输出文件的路径，默认当前工作目录
# output_file_name 输出文件的名称，不带后缀
# file_type 输出的文件格式，支持"html"，"word"
# open_file 报告生成后，是否直接打开文档。HTML可以在浏览器内打开
switch(file_type,
html = {output_format <- "html_document"; output_file_name <- paste0(output_file_name, ".html")},
word = {output_format <- "word_document"; output_file_name <- paste0(output_file_name, ".docx")})
# 复制一个临时文档
temp_file <- file.path(tempdir(), "fit_paper_table.Rmd")
file.copy(rmd_file, temp_file, overwrite=TRUE)
# 输出
rmarkdown::render(temp_file,
output_format=output_format, output_file=output_file_name, output_dir=output_dir,
params=list(fit_paper_table=fit_paper_table),
quiet=TRUE)
if(open_file) {
file.show(paste0(output_dir, "/", output_file_name))
}
}下面是fit_paper_table.Rmd的RMarkdown文件内容
---
title: "回归结果"
params:
"fit_paper_table": NULL
---
```{r results='asis', echo=FALSE}
library(knitr)
fit_paper_table <- params[["fit_paper_table"]]
# 把*、**、***变成上标，方式为转换成^{*}、^{**}、^{***}并在前后加上$号，markdown可以渲染成数学符号
# 这里使用了正则表达式里面的 “?<= ... 正后发断言”，参考下面链接4.3节
# https://github.com/ziishaned/learn-regex/blob/master/translations/README-cn.md
fit_paper_table <- apply(fit_paper_table, 2, function(x) sub("(?<=[0-9])([*]{1}$)", "^{*}", x, perl=TRUE))
fit_paper_table <- apply(fit_paper_table, 2, function(x) sub("(?<=[0-9])([*]{2}$)", "^{**}", x, perl=TRUE))
fit_paper_table <- apply(fit_paper_table, 2, function(x) sub("(?<=[0-9])([*]{3}$)", "^{***}", x, perl=TRUE))
fit_paper_table[, -1] <- apply(fit_paper_table[, -1], 2, function(x) paste0("$", x, "$"))
fit_paper_table[, -1] <- apply(fit_paper_table[, -1], 2, function(x) sub("$$", "", x, perl=TRUE))
kable(fit_paper_table)
```
2万+
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
