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

Question

我想在编辑datatable的单元格时，交互式地更新data.frame和DT::datatable。这样可以正常运行，但是当我使用selectInput函数筛选数据框并编辑另一行的datatable单元格时，它只复制了我之前编辑过的值，无论是在data.frame还是在datatable中。有什么建议吗？

以下是可重现的示例。我猜这是响应性问题。作为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)

- Gion Mors

---

我编辑了代码，使其完全可复制。正如您所注意到的那样，在编辑col_1并使用selectInput筛选器过滤其他行时，编辑后的值会复制到其他行。 - Gion Mors

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)

- Waldi