R/model_summary_kabletype.R

In DeependraD/expdean: Collection of Design and Analysis Functions for Agriculture and Related Fields Data

# ========== p_annotator ==========
#
#' @title Regression table with summary annotations (like stargazer) using knitr
#'
#' @description This function accepts a list of models, for multiple response variables,
#' and even when fitted with different model terms
#' this is similar to `stargazer::stargazer` but more friendly to tweak
#' It accepts a list of model (i.e. `lm`, `lme`, etc.) with (suitably some) common terms
#' It returns a tibble with annotations -- the stars correspond to the level of significance,
#' the standard error are shown in parenthesis, etc.
#' This function is most suitable when working with random effects models
#' fitted using \code{\link{lme}} or else.
#'
#' @param model_list A list of model objects generated by lm_list or custom generated list
#'
#' @return A tbl
#' @export
#'
#' @importFrom purrr map map_dfr map_df
#' @importFrom stats coefficients AIC BIC nobs
#' @importFrom tidyr as_tibble spread
#' @importFrom dplyr mutate case_when mutate_if select full_join
#' @importFrom stringi stri_replace_all_fixed
#' @importFrom stringr str_to_title str_replace_all
#' @importFrom magrittr set_names
#'
#' @examples
#' p_annotator(list(lme_model3, lme_model2, lme_model1))
#' @note Currently only 3 models are tidied (in join step) due to column name mismatch
#'
p_annotator <- function(model_list) {
  model_iv_terms_all <- purrr::map(model_list, ~attr(.x$terms, "dataClasses")) %>%
    unlist()
  model_iv_terms_fact_char <- model_iv_terms_all[model_iv_terms_all %in% c("factor", "character")] %>%
    names() %>%
    unique()

  model_summary_df <- purrr::map_dfr(model_list,
          ~stats::coefficients(summary(.x)) %>%
            tidyr::as_tibble(rownames = "term"), .id = "name") %>%
    dplyr::mutate(significance_stars = dplyr::case_when(
      `p-value` < .001 ~ "***",
      `p-value` < .01 ~ "**",
      `p-value` < .05 ~ "*",
      TRUE ~ " ")) %>%
    dplyr::mutate_if(is.numeric, ~round(., 2)) %>%
    dplyr::mutate(Value = paste(Value,"(", Std.Error, ")", significance_stars, sep = "")) %>%
    dplyr::select(name, term, Value) %>%
    tidyr::spread(key = name, value = Value) %>%
    dplyr::mutate(
      term = stringi::stri_replace_all_fixed(term, pattern = model_iv_terms_fact_char, replacement = c(""),
                                             vectorize_all = FALSE),
      term = stringr::str_replace_all(term, "_", " "),
      term = stringr::str_replace_all(term, "\\(|\\)", "")) %>%
    dplyr::mutate_at(1, stringr::str_to_title)

  model_ic_nobs <- purrr::map_df(model_list,
                    function(ma){
                      list(stats::AIC(ma),
                           stats::BIC(ma),
                           stats::nobs(ma)) %>%
                        magrittr::set_names(c("Akaike IC", "Bayesian IC", "Observations"))
                    }) %>%
    round(3) %>%
    t() %>%
    tidyr::as_tibble(rownames = "term", .name_repair = "universal", check = FALSE) %>%
    dplyr::mutate_if(is.numeric, as.character)

  model_summary_df <- dplyr::full_join(model_summary_df, model_ic_nobs,
                                       by = c("1" = "...1", "2" = "...2", "3" = "...3", "term" = "term"))

  return(model_summary_df)
}