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)