在 Shiny 中结合 selectInput 和 DT::datatable 编辑

Question

I would like to update both a data.frame and a DT::datatable interactively when editing the datatable cells. This works fine but when I use the selectInput function to filter the data.frame and edit cells in another row of the datatable , it just copies the values I edited previously both in the data.frame and datatable . Any suggestions?

Below, is a reproducible example. I guess that this is an issue of reactivity. Being new to Shiny I am still far from mastering that.

library(tidyverse); library(DT); library(shiny)

df <- data.frame(internal_idNew=c(1, 2, 3, 4), col_1=c("this", "is", "a", "column"))

ui <- fluidPage(
  #filter df
  selectInput("s_internal_idNew", "Record id (new)", choices=c(1:nrow(df))),
              #dt output
              dataTableOutput("dt")
  )
  
  server <- function(input, output) {
    #reactive df
    df <- reactiveVal({df})
    #reactive df filtered
    df_showed <- reactiveVal({})
    
    observeEvent(input$s_internal_idNew, {
      #filter a row matching the internal id
      df_showed(df() %>% filter(internal_idNew==input$s_internal_idNew))
      #render dt
      output$dt <- DT::renderDataTable(df_showed(), editable=list(target = "cell", disable = list(columns =c(0))), options=list(dom = 't', bSort=FALSE, pageLength=1), rownames = FALSE, selection = "none")
      #create proxy dt
      dt_proxy <- dataTableProxy("dt")
      
      #edit dt
      observeEvent(input$dt_cell_edit, {
        this <- df()
        showed <- df_showed()
        
        #extract edited value to edit df
        col_name <- showed %>% names() %>% .[input$dt_cell_edit$col+1]
        row_name <- input$s_internal_idNew %>% as.numeric()
        value_name <- coerceValue(input$dt_cell_edit$value, showed[row_name, col_name])
        
        #store edited values in reactive df
        this[row_name, col_name] <- value_name
        df(this)
        #replace data in datatable
        replaceData(dt_proxy, df_showed(), resetPaging = TRUE, rownames = FALSE)
      })
    })
  }

shinyApp(ui = ui, server = server)

Answer 1

A few modifications to achieve expected behavior:

• dtProxy should be created only once at server launch
• observeEvent(input$dt_cell_edit,...) should be independent of observeEvent(input$s_internal_idNew,...)
• df_showed() should also be updated, as df()

library(tidyverse); library(DT); library(shiny)

df <- data.frame(internal_idNew=c(1, 2, 3, 4), col_1=c("this", "is", "a", "column"))

ui <- fluidPage(
  #filter df
  selectInput("s_internal_idNew", "Record id (new)", choices=c(1:nrow(df))),
  #dt output
  dataTableOutput("dt")
)

server <- function(input, output) {
  #reactive df
  df <- reactiveVal({df})
  #reactive df filtered
  df_showed <- reactiveVal({})
  
  #create proxy dt once
  dt_proxy <- dataTableProxy("dt")
  
  
  observeEvent(input$s_internal_idNew, {
    #filter a row matching the internal id
    df_showed(df() %>% filter(internal_idNew==input$s_internal_idNew))
    #render dt
    output$dt <- DT::renderDataTable(df_showed(), editable=list(target = "cell", disable = list(columns =c(0))), options=list(dom = 't', bSort=FALSE, pageLength=1), rownames = FALSE, selection = "none")

  })

    #edit dt - separate from previous reactive
    observeEvent(input$dt_cell_edit, {
      this <- df()
      showed <- df_showed()
      
      #extract edited value to edit df
      col_name <- showed %>% names() %>% .[input$dt_cell_edit$col+1]
      row_name <- input$s_internal_idNew %>% as.numeric()
      value_name <- coerceValue(input$dt_cell_edit$value, showed[row_name, col_name])
      
      #store edited values in reactive df
      this[row_name, col_name] <- value_name
      df(this)
      df_showed(this[row_name, ]) # Also updated
      #replace data in datatable
      replaceData(dt_proxy, df_showed(), resetPaging = TRUE, rownames = FALSE)
    })
  
}

shinyApp(ui = ui, server = server)