R-Shiny DT：动态高光

Question

我正在尝试使用 shiny 中的 DT 表，该表可由用户编辑。 单元格应根据某些规则突出显示（在本例中，当“新”等于 0 或 1 时，V1 的单元格将突出显示）。

但是，我无法使其动态工作：当用户编辑值时，突出显示的单元格保持不变。 我应该使用反应式吗？如何使用？

这是我的短代码：

library(shiny)
library(DT)

shinyApp(
  ui = fluidPage(DTOutput('tbl')),

  server = function(input, output) {

df = as.data.frame(cbind(matrix(round(rnorm(50), 3), 10)))
df$new=rownames(df)
    
    output$tbl=   renderDataTable({
      
      datatable(df, editable = T)%>% 
        formatStyle(
        'V1', 'new',
        backgroundColor = styleEqual(c(0, 1), c('gray', 'yellow'))
      )
      
      })

谢谢您的帮助！

Answer 1

尝试使df成为反应式，并通过input$tbl_cell_edit访问修改后的值。 右侧的第二个表仅显示df中的第二个变量。 它将显示对变量 V2 的所有更新。 见下文

  library(shiny)
  library(DT)


    ui = fluidPage(
      fluidPage(
        column(8,DTOutput('tbl') ), column(3,DTOutput('tb2') )
      ))

    server = function(input, output) {
      DF1 <- reactiveValues(data=NULL)

      observe({
        df <- as.data.frame(cbind(matrix(round(rnorm(50), 3), 10)))
        names(df) <- c("V1","V2","V3","V4","V5")
        df$new=rownames(df)
        rownames(df) <- NULL
        DF1$data <- df
      })  

      output$tbl <-  renderDT({
        plen <- nrow(DF1$data)
        datatable(DF1$data, class = 'cell-border stripe',
                  options = list(dom = 't', pageLength = plen, initComplete = JS(
                    "function(settings, json) {",
                    "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
                    "}")),editable = TRUE) %>%
            formatStyle('V1', 'new',
            backgroundColor = styleEqual(c(0, 1), c('gray', 'yellow'))
            )

      })
      
      observeEvent(input$tbl_cell_edit, {
        info = input$tbl_cell_edit
        str(info)
        i = info$row
        j = info$col # + 1  # column index offset by 1
        v = info$value
        
        DF1$data[i, j] <<- DT::coerceValue(v, DF1$data[i, j])
      })
      
      output$tb2 <- renderDT({
        df2 <- NULL
        df2$Var1 <- DF1$data[,2]
        plen <- nrow(df2)
        df2 <- as.data.frame(df2)
        datatable(df2, class = 'cell-border stripe',
                  options = list(dom = 't', pageLength = plen, initComplete = JS(
                    "function(settings, json) {",
                    "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
                    "}")))
        
      })
      
    }

    shinyApp(ui, server)