R/regcut.R

In KatoPachi/FlextableLikeStar: Generating Regression Table Using Flextable

utils::globalVariables(c("pval", "s.e.", "seNames", "v", "variables"))

#' @title Get Results of Regression
#'
#' @name .regcut
#' @param reg regression with specific class
#' @param keep keep variable name
#' @param omit omit variable name
#' @param digits maximum digits
#' @param star vector of symbols representing statistically significance at 10%, 5%, and 1% level
#'
#' @return generate column of coefficient of regression
#'
#' @export

# lm
lm.regcut <- function(
  reg, keep = NULL, omit = NULL, digits = 2, star = c("*", "**", "***")) {

  sig <- 1:3 %>% list.map(paste("%1.", digits, "f", star[.], sep = ""))
  insig <- paste("%1.", digits, "f", sep = "")
  se <- paste("(%1.", digits, "f)", sep = "")

  covariate.label <- rownames(summary(reg)$coefficient)

  if (!is.null(omit)) {
    omit.var <- paste(omit, collapse = "|")
    bool <- !str_detect(covariate.label, omit.var)
  } else if (!is.null(keep)) {
    keep.var <- paste(keep, collapse = "|")
    bool <- str_detect(covariate.label, keep.var)
  } else {
    bool <- rep(TRUE, length(covariate.label))
  }

  cut <- summary(reg)$coefficient[bool, c("Estimate", "Std. Error", "Pr(>|t|)")] %>%
    matrix(.,ncol = 3) %>%
    data.frame() %>%
    setNames(c("coef", "s.e.", "pval")) %>%
    bind_cols(variables = covariate.label[bool], .)

  cut <- cut %>%
    mutate(
      coef = case_when(
        pval < 0.01 ~ sprintf(sig[[3]], coef),
        pval < 0.05 ~ sprintf(sig[[2]], coef),
        pval < 0.1  ~ sprintf(sig[[1]], coef),
        TRUE        ~ sprintf(insig, coef)
      ),
      s.e. = sprintf(se, s.e.)
    ) %>%
    select(-pval) %>%
    gather(key = stat, value = v, -variables) %>%
    arrange(variables)

  return(cut)

}


#'
#' @name .regcut
#' @param reg regression with specific class
#' @param keep keep variable name
#' @param omit omit variable name
#' @param digits maximum digits
#' @param star vector of symbols representing statistically significance at 10%, 5%, and 1% level
#'
#'
#' @export

# coeftest
coeftest.regcut <- function(
  reg, keep = NULL, omit = NULL, digits = 2, star = c("*", "**", "***")) {

  sig <- 1:3 %>% list.map(paste("%1.", digits, "f", star[.], sep = ""))
  insig <- paste("%1.", digits, "f", sep = "")
  se <- paste("(%1.", digits, "f)", sep = "")

  covariate.label <- rownames(reg)

  if (!is.null(omit)) {
    omit.var <- paste(omit, collapse = "|")
    bool <- !str_detect(covariate.label, omit.var)
  } else if (!is.null(keep)) {
    keep.var <- paste(keep, collapse = "|")
    bool <- str_detect(covariate.label, keep.var)
  } else {
    bool <- rep(TRUE, length(covariate.label))
  }

  cut <- reg[bool, c("Estimate", "Std. Error", "Pr(>|t|)")] %>%
    matrix(.,ncol = 3) %>%
    data.frame() %>%
    setNames(c("coef", "s.e.", "pval")) %>%
    bind_cols(variables = covariate.label[bool], .)

  cut <- cut %>%
    mutate(
      coef = case_when(
        pval < 0.01 ~ sprintf(sig[[3]], coef),
        pval < 0.05 ~ sprintf(sig[[2]], coef),
        pval < 0.1  ~ sprintf(sig[[1]], coef),
        TRUE        ~ sprintf(insig, coef)
      ),
      s.e. = sprintf(se, s.e.)
    ) %>%
    select(-pval) %>%
    gather(key = stat, value = v, -variables) %>%
    arrange(variables)

  return(cut)

}