R语言formattable包color_bar使用及导出PDF相关问题求助

我们需要在PDF中插入带有icons、icontext、color_bar等元素的精美formattable表格，可行方案是通过截图工具将html表格输出为图片后插入文档，以下是修复所有问题的完整实现：

依赖安装说明 #

优先使用webshot2替代原版webshot，避免渲染异常：

# 安装依赖
install.packages("formattable")
install.packages("htmltools")
remotes::install_github("rstudio/webshot2")
# 若使用原版webshot需要安装phantomjs：webshot::install_phantomjs()

完整可运行代码 #

library("htmltools")
library("webshot2")  
library(formattable)

# 测试数据：支持正负值混合
DF <- data.frame(
  Ticker = c("", "", "", "IBM", "AAPL", "MSFT"),
  Name = c("Dow Jones", "S&P 500", "Technology", "IBM", "Apple", "Microsoft"),
  Value = accounting(
    c(-15988.08, 1880.33, -50, 130.00, -97.05, 50.99),
    negative.parens = FALSE # 关闭负值自动加括号特性
  ),
  Change = percent(
    c(-0.0239, -0.0216, 0.021, -0.0219, -0.0248, -0.0399)
  )
)

################################## 工具函数 ##################################
# 自定义双向彩色条形formatter
bi_color_bar = function(color, fun = "proportion", ...) {
  fun = match.fun(fun)
  formatter("div", 
            style = function(x) {
              val <- as.numeric(x)
              max_abs <- max(abs(val), na.rm = TRUE)
              style(
                position = "relative",
                width = "100%",
                padding.right = "4px",
                padding.left = "4px",
                `text-align` = "center"
              )
            },
            # 底层条形
            ~ lapply(val, function(v) {
              w <- paste0(abs(as.numeric(v))/max(abs(as.numeric(Value)), na.rm=T)*45, "%")
              dir <- ifelse(as.numeric(v) >=0, "margin-left:50%", "margin-right:50%")
              tags$div(style = paste0("position:absolute;z-index:0;top:25%;height:50%;background:",color,";",dir,";width:",w,";"))
            }),
            # 上层数值
            ~ tags$span(
              style = "position:relative;z-index:10;direction:ltr;", # 强制文本左到右，避免负号错位
              .x
            )
  )
}

# 导出函数适配webshot2
export_formattable <- function(f, file, width = "100%", height = NULL, 
                               background = "white", delay = 0.5)
{
  w <- as.htmlwidget(f, width = width, height = height)
  path <- html_print(w, background = background, viewer = NULL)
  url <- paste0("file:///", gsub("\\\\", "/", normalizePath(path)))
  webshot(url,
          file = file,
          selector = ".formattable_widget",
          delay = delay)
}
###############################################################################

# 生成表格
FT <- formattable(DF, align =c("l","c","c","c"), list(
  Name = formatter("span", 
                   style = x ~ ifelse(x == "Technology", style(font.weight = "bold"), NA)),
  Value = bi_color_bar("orange"),
  Change = formatter("span", 
                     style = x ~ style(color = ifelse(x < 0 , "red", "green"), "font.size" = "18px"), 
                     x ~ icontext(ifelse(x < 0, "arrow-down", "arrow-up"), x)
  )),
  table.attr = 'style="font-size: 18px;width: 800px;"'
)

# 预览表格
FT

# 导出为图片，可直接插入PDF
export_formattable(FT,"./FT.png")

核心修复点说明 #

• 调用accounting时设置negative.parens = FALSE，取消负值自动加括号的默认特性，解决负值格式异常问题
• 自定义bi_color_bar双向条形 formatter，以单元格中心为0点，正值向右延伸、负值向左延伸，数值层级高于条形固定显示在上方
• 给数值标签添加direction: ltr属性，强制文本从左到右渲染，解决导出PDF时负号错位到数值右侧的问题
• 修复原有table.attr的语法错误，Name字段加粗样式可正常生效
• 使用webshot2替代原版webshot，使用Chromium内核渲染，样式兼容性更强，导出效果和RStudio预览一致

内容的提问来源于stack exchange，提问作者JK Lambert