如何将列添加到基于LM的FLEXTABL

Question

假设我用这样的LM制作了一个模型，

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)

这使我可以通过估计，标准错误，T值和PR（＆GT; | T |）发弹。假设我想在Flextable中添加一列，例如，如果我的y已记录，并且我想要一个列显示exp（型号$ cefficients）-1。

是否有一种直接的方法可以做到这一点，或者我必须从头开始重新创建桌子？

Answer 1

在引用flextable's as_flextable.lm函数的源代码时，很明显，没有内置的方法可以执行此操作。我通过从源复制来制作“新”功能。

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
}

new_cols此功能的参数必须是命名函数列表，其中列表中每个函数的名称将成为新列名。列表中的功能将采用术语，估算，std.error，p.Value作为输入，因为这些是data_t tibble的名称。

例如：

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