How to add a column to a lm based flextable - r

Question

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?

Answer 1

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),"%"))
})