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

Question

我想在编辑 datatable 单元格时以交互方式更新 data.frame 和 DT::datatable。这工作正常但是当我使用 selectInput 函数过滤 data.frame 并编辑 datatable 另一行中的单元格时，它只是复制我之前在 data.frame 和 datatable 中编辑的值。有什么建议吗？

下面是一个可重现的例子。我想这是 react 性的问题。作为 Shiny 的新手，我还远未掌握它。

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

一些修改以实现预期的行为:

• dtProxy 应该只在服务器启动时创建一次
• observeEvent(input$dt_cell_edit,...) 应该独立于 observeEvent(input$s_internal_idNew,...)
• df_showed() 也应更新为 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)