R-Shiny DT: highlight dinamico

Question

Sto cercando di utilizzare una tabella DT in shiny, che è modificabile dall'utente. Le celle dovrebbero essere evidenziate secondo alcune regole (in questo caso, le celle di V1 sono evidenziate quando "nuovo" è uguale a 0 o 1).

Tuttavia, non riesco a farlo funzionare dinamicamente: quando l'utente modifica i valori, le celle evidenziate rimangono invariate. Devo usare un reattivo e come?

Ecco il mio codice breve:

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'))
      )
      
      })

Grazie per l'aiuto!

Answer 1

Prova a trasformare dfin reattivo e accedi ai valori modificati tramite input$tbl_cell_edit. La seconda tabella a destra mostra solo la seconda variabile dal tuo df. Visualizzerà tutti gli aggiornamenti alla variabile V2. Vedi sotto

  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)