CODEWITHSUNDEEP
rflextable
Dean MacGregor
Dean MacGregor

Reputation: 18406

How to add a column to a lm based flextable

Let's say I make a model with lm such as

library(flextable)
set.seed(123)

mydata <- data.frame(y=runif(100,1,100), x1=runif(100,1,100), x2=runif(100,1,100))
model <- lm(y~x1+x2, data=mydata)
as_flextable(model)

This gives me a flextable with the Estimate, Standard Error, t value, and Pr(>|t|). Let's say I want to add a column to the flextable, for instance, if my y is logged and I want a column that shows exp(model$coefficients)-1.

Is there a straightforward way to do that or do I have to recreate the table from scratch?

Upvotes: 2

Views: 857

Answers (1)

Dean MacGregor
Dean MacGregor

Reputation: 18406

In referencing the source code of flextable's as_flextable.lm function it's clear there's no built in way to do it. I made a "new" function by copying from source.

pvalue_format <- function(x){
  z <- cut(x, breaks = c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf), labels = c("***", "**", "*", ".", ""))
  as.character(z)
}

as_flextable_newcol<-function(x,new_cols=NULL) {
  data_t <- broom::tidy(x)
  data_g <- broom::glance(x)
  ##this is my addition
  if(!is.null(new_cols)&is.list(new_cols)) {
    for(i in names(new_cols)) {
      data_t <- data_t %>% mutate("{i}":=new_cols[[i]](term, estimate, std.error, p.value))
    }
  }
  ##end of my addition
  ft <- flextable(data_t, col_keys = c("term", "estimate", "std.error", "statistic", "p.value", "signif"))
  ft <- colformat_double(ft, j = c("estimate", "std.error", "statistic"), digits = 3)
  ft <- colformat_double(ft, j = c("p.value"), digits = 4)
  ft <- compose(ft, j = "signif", value = as_paragraph(pvalue_format(p.value)) )

  ft <- set_header_labels(ft, term = "", estimate = "Estimate",
                          std.error = "Standard Error", statistic = "t value",
                          p.value = "Pr(>|t|)", signif = "" )
  dimpretty <- dim_pretty(ft, part = "all")

  ft <- add_footer_lines(ft, values = c(
    "Signif. codes: 0 <= '***' < 0.001 < '**' < 0.01 < '*' < 0.05 < '.' < 0.1 < '' < 1",
    "",
    sprintf("Residual standard error: %s on %.0f degrees of freedom", formatC(data_g$sigma), data_g$df.residual),
    sprintf("Multiple R-squared: %s, Adjusted R-squared: %s", formatC(data_g$r.squared), formatC(data_g$adj.r.squared)),
    sprintf("F-statistic: %s on %.0f and %.0f DF, p-value: %.4f", formatC(data_g$statistic), data_g$df.residual, data_g$df, data_g$p.value)
  ))
  ft <- align(ft, i = 1, align = "right", part = "footer")
  ft <- italic(ft, i = 1, italic = TRUE, part = "footer")
  ft <- hrule(ft, rule = "auto")
  ft <- autofit(ft, part = c("header", "body"))
  ft
}

the new_cols parameter to this function needs to be a named list of functions where the name of each function in the list will become the new column name. The functions inside the list will take term, estimate, std.error, p.value as input as those are the names of the data_t tibble.

For example:

new_cols=list(perc_change=function(term, estimate, std.error, p.value) {
  ifelse(term=="(Intercept)","", paste0(round(100*(exp(estimate)-1),0),"%"))
})

Upvotes: 2

Related Questions