updateData 上可反应的 R 闪亮条件颜色列

我有一个闪亮的应用程序，它使用可反应来显示任务的状态。状态列的信息采用颜色编码，数据使用以下方式更新updateReactable().

最初，颜色背景是正确的（例如红色表示打开，绿色表示完成），但是当我打电话时updateReactable，背景颜色不变。

一个简单的解决方案是始终重新渲染表格，但我想保留用户输入（例如排序、过滤、页面选择等），因此我使用 updateReactable。

MWE 看起来像这样：

library(shiny)
library(reactable)

ui <- fluidPage(
  reactableOutput("table"),
  actionButton("go", "Go")
)

d <- data.frame(x = sample(letters, 10, replace = TRUE), status = "Open")
d[1, "status"] <- "Done"

cols_bg <- c("Open" = "red", "Done" = "green")
cols_font <- c("Open" = "black", "Done" = "white")

server <- function(input, output, session) {
  # render this only once, update values later
  output$table <- renderReactable({
    reactable(d,
              columns = list(
                status = colDef(name = "Status", 
                                style = function(value) {
                                  list(background = cols_bg[[value]],
                                       fontWeight = 600, color = cols_font[[value]])
                                })
              )
    )
  })
  
  # on button-click replace some values with Done and update table
  observeEvent(input$go, {
    ids <- sample(nrow(d), 0.7*nrow(d))
    d$status[ids] <- "Done"
    updateReactable("table", d)
  })
}

shinyApp(ui, server)

点击后看起来像这样：

请注意，所有“完成”字段都应为绿色。

As per 本文 https://glin.github.io/reactable/articles/conditional-styling.html对于动态条件样式，我们需要提供一个 JS 函数：

library(shiny)
library(reactable)

ui <- fluidPage(reactableOutput("table"),
                actionButton("go", "Go"))

d <- data.frame(x = sample(letters, 10, replace = TRUE), status = "Open")
d[1, "status"] <- "Done"

server <- function(input, output, session) {
  output$table <- renderReactable({
    reactable(d,
              columns = list(status = colDef(
                style =  JS(
                  "function(rowInfo) {
                                if (rowInfo.values['status'] == 'Open') {
                                  return { backgroundColor: 'red', color: 'black', fontWeight: 600}
                                } else if (rowInfo.values['status'] == 'Done') {
                                  return { backgroundColor: 'green', color: 'white', fontWeight: 600 }
                                } else {
                                  return { backgroundColor: 'grey', color: 'black', fontWeight: 600 }
                                }
                              }"
                )
              )))
  })
  
  # on button-click replace some values with Done and update table
  observeEvent(input$go, {
    ids <- sample(nrow(d), 0.7 * nrow(d))
    d$status[ids] <- "Done"
    updateReactable("table", d)
  })
}

shinyApp(ui, server)