#' @title Stack Multiple Regression Outputs
#'
#' @description This routine takes in multiple outputs from regtable and
#' arranges them into one output. The function stacks the different coefficients
#' and summary statistics, while the extra_rows are grouped at the bottom of the
#' regtable_stack() output.
#'
#' @param final_tables list of output produced by regtable, which includes
#' \itemize{
#' \item \emph{output}: a dataframe version of the regtable results
#' \item \emph{model_names}: either the character vector specified by
#' \emph{mnames} in regtable or a function generated vector of numeric
#' IDs for the models
#' }
#' To output a dataframe in regtable, pass in "df" for the output_format.
#'
#' @param table_names A character vector specifying the names of the objects in
#' final_tables. These names are concatenated with the coefficent names in
#' the output.
#' @param output_format A string passed to kable() that specifies the format of
#' the table output. The options are "latex", "html", "markdown", "pandoc",
#' and "rst". The default is "latex".
#' @param note A character string if a footnote is to be added to the end of the
#' table.
#' @param header A character vector to be passed into
#' \code{\link[kableExtra:add_header_above]{add_header_above}} that creates
#' a new header row. This should have length equal to ms from regtable()
#'
#' @examples
#' library(lfe)
#'
#' # create covariates
#' x1 <- rnorm(1000)
#' x2 <- rnorm(length(x1))
#'
#' # fixed effects
#' fe <- factor(sample(20, length(x1), replace=TRUE))
#'
#' # effects for fe
#' fe_effs <- rnorm(nlevels(fe))
#'
#' # creating left hand sides y1 and y2
#' u <- rnorm(length(x1))
#' y1 <- 2 * x1 + x2 + fe_effs[fe] + u
#' y2 <- 3 * x1 + x2 + fe_effs[fe] + u
#'
#' m1 <- felm(y1 ~ x1 + x2 | fe)
#' m2 <- lm(y1 ~ x1 + x2)
#'
#' n1 <- felm(y2 ~ x1 + x2 | fe)
#' n2 <- lm(y2 ~ x1 + x2)
#'
#' # generate output from regtable
#' r1 <- regtable(list(m1, m2), est = "x1",
#' output_format = "df")
#' r2 <- regtable(list(n1, n2), est = "x1",
#' output_format = "df")
#'
#' regtable_stack(list(r1, r2), table_names = c("1", "2"),
#' output_format = "rst")
#'
#'
#' @importFrom magrittr %>%
#' @importFrom tibble tibble as_tibble
#' @importFrom purrr map_df map2_df reduce
#' @importFrom knitr kable
#' @importFrom kableExtra collapse_rows row_spec add_footnote
#' @importFrom stringr str_replace_all
#' @import dplyr
#' @importFrom broom glance
#' @name regtable_stack
#'
#' @export
#' @rdname regtable_stack
regtable_stack <- function(final_tables, table_names = NULL,
output_format = "latex", note = NULL, header = NULL){
if(!is.null(table_names)){
final_df <-
map2_df(final_tables, table_names,
function(x, y) mutate(x$output, table_name = y))
} else{
final_df <-
map_df(final_tables, function(x) c(x$output)) %>%
mutate(table_name = NA)
}
mnames <-
map(final_tables, function(x) c(x$model_names)) %>%
unique %>%
unlist
final_df <- mutate(final_df, part = if_else(term == "N", "extra", part))
coef <-
final_df %>%
filter(part == "coef" | part == "stats") %>%
mutate(term = if_else(part == "coef" & !is.na(table_name),
paste(term, "-", table_name), term))
extra <-
final_df %>%
filter(part == "extra") %>%
select(-table_name) %>%
distinct()
output <-
bind_rows(coef, extra) %>%
select(-type, -table_name, -part) %>%
rename(` ` = term)
output <-
output %>%
kable(format = output_format,
booktabs = TRUE,
col.names = colnames(.),
linesep = "",
escape = FALSE,
align = c('l', rep('c', length(mnames)))) %>%
add_footnote(note)
if(!is.null(header)) final_table <- final_table %>% add_header_above(header)
if(output_format == "latex"){
break_end <- nrow(coef)
break_start <- break_end / length(final_tables)
breaks <- seq(break_start, break_end, break_start)
output <-
output %>%
row_spec(breaks, extra_latex_after = "\\midrule") %>%
collapse_rows(columns = 1, latex_hline = "none")
output <-
output %>%
str_replace_all(fixed("phantom{X}"), "\\phantom{X}")
}
return(output)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.