R-Shiny DT: dynamisches Highlight

Question

Ich versuche, eine DT-Tabelle in glänzendem Zustand zu verwenden, die vom Benutzer bearbeitet werden kann. Die Zellen sollten gemäß einigen Regeln hervorgehoben werden (in diesem Fall werden die Zellen von V1 hervorgehoben, wenn "neu" gleich 0 oder 1 ist).

Ich kann es jedoch nicht dynamisch arbeiten lassen: Wenn der Benutzer die Werte bearbeitet, bleiben die hervorgehobenen Zellen unverändert. Soll ich ein reaktives verwenden und wie?

Hier ist mein Funktionscode:

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

Danke für deine Hilfe!

Answer 1

Versuchen Sie, dfeine reaktive zu machen und über auf auf geänderte Werte zuzugreifen input$tbl_cell_edit. In der zweiten Tabelle rechts wird nur die zweite Variable von Ihrer angezeigt df. Es werden alle Aktualisierungen der Variablen V2 angezeigt. Siehe unten

  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)