如何在Shiny的DT::datatable中添加动态生成的图片？

需求说明 #

需要生成DataFrame的汇总表，以判断数据是否小于5为例，核心要求：

• 使用DT::datatable组件，支持参数名搜索与排序功能
• 表格包含三列：
  • 参数名
  • 数值小于5的占比（百分比格式）
  • 可视化小值分布的图片（类似颜色条展示数据分布）

非DT场景的可行实现 #

以下代码可以实现预期的表格效果，但未使用DT::datatable：

library(shiny)

df <- iris[,1:4]

ui <- fluidPage(
  uiOutput("table_replacement")
)

server <- function(input, output, session) {
  output$table_replacement <- renderUI(
    lapply(names(df), function(param){
      fluidRow(
        column(2, param),
        column(2, paste0(round(sum(df[[param]]<5)/nrow(df)*100,2), "%")),
        column(8, imageOutput(
          outputId = paste0("is_it_big", param),
          height = "50px"
        ))
      )
    })
  )
  lapply(names(df), function(param){
    output[[paste0("is_it_big", param)]] <- renderImage({
      pngdata <- array(0, dim = c(10, nrow(df), 3))
      pngdata[,df[[param]]<5,1] <- 1
      outfile <- tempfile(fileext = "png")
      png::writePNG(pngdata, outfile)
      list(
        src = outfile,
        contentType = "image/png",
        width = 200,
        height = 20,
        alt = paste("png for", param)
      )
    }, deleteFile = TRUE)
  })
}

shinyApp(ui, server)

DT组件中的问题 #

尝试将图片嵌入DT::datatable时，renderImage未被触发（打印语句无输出），图片无法加载。复现代码如下：

library(shiny)

df <- iris[, 1:4]

ui <- fluidPage(
  DT::DTOutput("dtout")
)

server <- function(input, output, session) {
  output$dtout <- DT::renderDT({
    perc <- sapply(names(df), function(param) {
      paste0(round(sum(df[[param]] < 5) / nrow(df) * 100, 2), "%")
    })
    images <- sapply(names(df), function(param) {
      as.character(imageOutput(
        outputId = paste0("is_it_big", param),
        height = "50px"
      ))
    })
    dt <- data.frame(
      params = names(df),
      percentages = perc,
      images = images
    )
    DT::datatable(
      dt,
      escape = FALSE
    )
  })
  lapply(names(df), function(param) {
    output[[paste0("is_it_big", param)]] <- renderImage(
      {
        print(paste("Rendering", param))
        pngdata <- array(0, dim = c(10, nrow(df), 3))
        pngdata[, df[[param]] < 5, 1] <- 1
        outfile <- tempfile(fileext = "png")
        png::writePNG(pngdata, outfile)
        list(
          src = outfile,
          contentType = "image/png",
          width = 200,
          height = 20,
          alt = paste("png for", param)
        )
      },
      deleteFile = TRUE
    )
  })
}

shinyApp(ui, server)

了解到可能需要通过JavaScript绑定/解绑告知Shiny动态创建的元素，但不清楚具体操作方式。

额外需求与疑问 #

1. 图片懒加载：数据量较大（约200个参数、2万行数据），预加载所有图片耗时过长，希望实现仅在图片进入用户可见区域时才加载。
2. PNG生成优化：当前实现需要创建临时文件存储PNG，是否必须这么做？有没有更高效的PNG生成方式？

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