我有一个shiny 的应用程序,它使用reactable来显示任务的状态.信息为状态列进行 colored颜色 编码,数据使用updateReactable()更新.

最初,背景 colored颜色 是正确的(例如,红色表示打开,绿色表示完成),但当我调用updateReactable时,背景 colored颜色 不变.

一个简单的解决方案是始终重新呈现表,但我希望保留用户输入(例如排序、筛选、页面 Select 等),因此我使用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)

单击后,看起来像这样:

enter image description here

请注意,所有"完成"字段都应为绿色.

推荐答案

根据动态条件样式的this article,我们需要提供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)

result

R相关问答推荐

根据R中另一个数据集的顺序重新排序数据集的列

使用geom_rect的带有事件注释的时间序列图

使用R中的小鼠()进行插补后观察次数显着变化

从R中的地址提取街道名称

将虚线添加到每个站点的传奇中平均

在Julia中调用R函数

为什么stat_bin在R中的ggplot中显示错误的数字?

x[[1]]中的错误:脚注越界

Rplotly中的Sankey Diagram:意外连接&

在R中无法读入具有Readxl和lApply的数据集

IMF IFS数据以R表示

我正在努力用R计算数据集中的中值逐步距离

如何使用tryCatch执行语句并忽略警告?

从服务器在Shiny中一起渲染图标和文本

如何在科学记数法中显示因子

根据另一列中的值和条件查找新列的值

如何创建累加到现有列累计和的新列?

防止正则表达式覆盖以前的语句

避免在图例中显示VLINS组

如何更改包中函数中的参数?