regTex <- function(regs, vars, file = NULL, depvars = NULL, vcov = NULL,
intercept = FALSE, fixed.effects = NULL,
number.format = "%.2f", stars = c(0.1, 0.05, 0.01),
parentheses = "se", stats = c("N"), table.env = FALSE,
caption = " ", caption.position = "bottom",
stand.alone = FALSE, compile = FALSE) {
if (any(class(regs) != "list")) {
regs <- list(regs)
}
# Check that vars was inputted correctly:
if (!is.list(vars)) {
stop("'vars' must be a list")
} else {
# If only one row is provided, add the second row:
vars <- lapply(vars, function(x) {
if (length(x) == 1) {
return(c(x, ""))
} else if (length(x) == 2) {
return(x)
} else {
return(x[1:2])
}
})
}
# If depvars is provided, check that it was inputed correctly.
depvar.names <- unlist(lapply(regs, function(x) names(x$model)[1]))
if (is.null(depvars)) {
if (length(unique(depvar.names)) > 1) {
stop("If dependent variables differ between models, 'depvars' must be
provided")
}
} else {
if (length(unique(depvar.names)) > 1) {
if (!is.list(depvars)) {
stop("'depvars' must be a list")
}
if (length(depvars) != length(regs)) {
stop("Number of names in 'depvars' does not match the length of
'regs'")
}
}
if (is.list(depvars)) {
# Make each element of depvars have the same number of elements:
num.depvar.rows <-
length(depvars[[which.max(lapply(depvars, length))]])
depvars <- lapply(depvars, function(x) {
for (i in 1:num.depvar.rows) {
if (length(x) == i) {
return(c(rep("", num.depvar.rows - i), x))
}
}
})
}
}
# Check that vcov was inputted correctly, if not given use the defaults:
if (!is.null(vcov)) {
if (!is.list(vcov) | any(unlist(lapply(vcov, class)) != "matrix")) {
stop("Argument 'vcov' must be a list of matrices")
}
} else {
vcov <- lapply(regs, vcov)
}
# Check that intercept was inputted correctly:
if (!is.logical(intercept)) {
stop("Argument 'intercept' must be logical (TRUE or FALSE)")
}
if (!is.null(fixed.effects)) {
if (!is.list(fixed.effects)) {
stop("'fixed.effects' must be a list")
} else if (any(unlist(lapply(fixed.effects, length)) != length(regs)+1)) {
stop("Each element of 'fixed.effects' must have a length equal to the
number of regressions plus one (for the title)")
}
}
if (!(caption.position %in% c("top", "bottom"))) {
stop("'caption.position' can only be 'top' or 'bottom'")
}
if (!is.null(file)) {
sink(file)
}
if (stand.alone | compile) {
cat("\\documentclass[12pt]{article}\n")
cat("\\usepackage{siunitx}\n")
cat("\\begin{document}\n")
}
if (table.env) {
cat("\\begin{table}")
if (caption.position == "top") {
cat("\\caption{")
cat(caption)
cat("}\n")
}
}
cat("\\begin{tabular}{l*{")
cat(length(regs))
cat("}{S[input-symbols = (),
table-align-text-pre = false,
table-align-text-post = false]}}\n")
# If depvars is provided, display dependent variable name above the column:
cat("\\hline \\hline\n")
if (!is.null(depvars)) {
if (!is.list(depvars)) {
cat("Dependent variable:")
cat(rep("&", length(regs)))
cat("\\\\\n")
cat(depvars)
} else {
for (i in 1:num.depvar.rows) {
for (j in 1:length(depvars)) {
cat(" & {")
cat(depvars[[j]][i])
cat("} ")
}
cat("\\\\\n")
}
}
}
# Display model number in parentheses if more than one regression:
if (length(regs) > 1) {
for (i in seq_along(regs)) {
cat(" & ")
cat("({")
cat(i)
cat("})")
}
}
cat("\\\\ \\hline\n")
cat("\\rule{0pt}{3ex}")
if (intercept) {
cat("Constant")
for (j in seq_along(regs)) {
t.stat <- regs[[j]]$coefficients[1]/sqrt(vcov[[j]][1, 1])
tmp <- pt(t.stat, df = regs[[j]]$df.residual)
p.value <- 2*(1 - tmp)
cat(" & ")
cat(sprintf(number.format, regs[[j]]$coefficients[1]))
if (!is.null(stars)) {
if (p.value <= stars[3]) {
cat("$^{\\star\\star\\star}$")
} else if (p.value <= stars[2] & p.value > stars[3]) {
cat("$^{\\star\\star}$")
} else if (p.value <= stars[1] & p.value > stars[2]) {
cat("$^{\\star}$")
}
}
}
cat("\\\\\n")
for (j in seq_along(regs)) {
cat(" & ")
cat("{(}")
if (parentheses == "se") {
cat(sprintf(number.format, sqrt(vcov[[j]][1, 1])))
} else if (parentheses == "t") {
cat(sprintf(number.format, t.stat))
} else if (parentheses == "p") {
cat(sprintf(number.format, p.value))
} else {
stop("'parentheses' must be one of 'se', 't', 'p'")
}
cat("{)}")
}
cat("\\\\\n")
cat("\\rule{0pt}{3ex}")
}
for (i in seq_along(vars)) {
cat(vars[[i]][1])
for (j in seq_along(regs)) {
if (any(class(regs[[j]]) == "felm")) {
coef.names <- rownames(regs[[j]]$coefficients)
} else {
coef.names <- names(regs[[j]]$coefficients)
}
# Check if the variable was included in the regression:
cat(" & ")
if (names(vars)[i] %in% coef.names) {
k <- which(coef.names == names(vars)[i])
cat(sprintf(number.format, regs[[j]]$coefficients[k]))
# Significance stars (from the Student t distribution):
t.stat <- abs(regs[[j]]$coefficients[k]/sqrt(vcov[[j]][k, k]))
tmp <- pt(t.stat, df = regs[[j]]$df.residual)
p.value <- 2*(1 - tmp)
if (!is.null(stars)) {
if (p.value <= stars[3]) {
cat("$^{\\star\\star\\star}$")
} else if (p.value <= stars[2] & p.value > stars[3]) {
cat("$^{\\star\\star}$")
} else if (p.value <= stars[1] & p.value > stars[2]) {
cat("$^{\\star}$")
}
}
}
}
cat("\\\\\n")
if (!is.na(vars[[i]][2])) {
cat(vars[[i]][2])
}
for (j in seq_along(regs)) {
if (any(class(regs[[j]]) == "felm")) {
coef.names <- rownames(regs[[j]]$coefficients)
} else {
coef.names <- names(regs[[j]]$coefficients)
}
cat(" & ")
if (names(vars)[i] %in% coef.names) {
k <- which(coef.names == names(vars)[i])
cat("{(}")
if (parentheses == "se") {
cat(sprintf(number.format, sqrt(vcov[[j]][k, k])))
} else if (parentheses == "t") {
t.stat <- abs(regs[[j]]$coefficients[k]/sqrt(vcov[[j]][k, k]))
cat(sprintf(number.format, t.stat))
} else if (parentheses == "p") {
t.stat <- abs(regs[[j]]$coefficients[k]/sqrt(vcov[[j]][k, k]))
tmp <- pt(t.stat, df = regs[[j]]$df.residual)
p.value <- 2*(1 - tmp)
cat(sprintf(number.format, p.value))
} else {
stop("'parentheses' must be one of 'se', 't', 'p'")
}
cat("{)}")
}
}
cat("\\\\\n")
}
if (!is.null(fixed.effects)) {
cat(rep("&", length(regs)))
cat("\\\\\n")
for (i in seq_along(fixed.effects)) {
cat(fixed.effects[[i]][1])
for (j in seq_along(regs)) {
cat("& {")
cat(fixed.effects[[i]][j + 1])
cat("}")
}
cat("\\\\\n")
}
}
cat("\\hline\\rule{0pt}{3ex}")
for (i in seq_along(stats)) {
if (stats[i] == "N") {
cat("$N$")
for (j in seq_along(regs)) {
cat(" & {")
cat(length(regs[[j]]$residuals))
cat("} ")
}
cat("\\\\\n")
}
if (stats[i] == "R.squared") {
cat("$R^2$")
for (j in seq_along(regs)) {
cat(" &")
if (any(class(regs[[j]]) == "lm")) {
cat(sprintf(number.format, summary(regs[[j]])$r.squared))
} else if (any(class(regs[[j]]) == "felm")) {
cat(sprintf(number.format, summary(regs[[j]])$r2))
}
cat("")
}
cat("\\\\\n")
}
if (stats[i] == "adj.R.squared") {
cat("Adjusted $R^2$")
for (j in seq_along(regs)) {
cat(" &")
if (any(class(regs[[j]]) == "lm")) {
R.sq <- summary(regs[[j]])$r.squared
adj.R.squared <- 1 - (1 - R.sq) *
((nrow(regs[[j]]$model) - 1)/regs[[j]]$df.residual)
cat(sprintf(number.format, adj.R.squared))
} else if (any(class(regs[[j]]) == "felm")) {
cat(sprintf(number.format, summary(regs[[j]])$r2adj))
}
cat("")
}
cat("\\\\\n")
}
if (stats[i] == "F") {
cat("$F$-statistic")
for (j in seq_along(regs)) {
cat(" &")
if (any(class(regs[[j]]) == "lm")) {
cat(sprintf(number.format, summary(regs[[j]])$fstatistic[1]))
} else if (any(class(regs[[j]]) == "felm")) {
cat(sprintf(number.format, summary(regs[[j]])$fstat))
}
cat("")
}
cat("\\\\\n")
}
if (stats[i] == "mean.depvar") {
cat("Mean dependent variable")
for (j in seq_along(regs)) {
if (any("felm" %in% class(regs[[i]]))) {
cat(" &")
cat(sprintf(number.format, mean(regs[[j]]$response)))
cat("")
} else {
cat(" &")
cat(sprintf(number.format, mean(regs[[j]]$model[[1]])))
cat("")
}
}
cat("\\\\\n")
}
}
cat("\\hline \\hline\n\\end{tabular}\n")
if (table.env) {
if (caption.position == "bottom") {
cat("\\caption{")
cat(caption)
cat("}\n")
}
cat("\\end{table}")
}
if (stand.alone | compile) {
cat("\\end{document}")
}
if (!is.null(file)) {
sink()
}
if (!is.null(file) & compile) {
system(paste("pdflatex", file))
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.