r - 如何使用 Shiny 的输入来过滤已编辑的数据表？

Question

我对一个三部分过程感到困惑:

1. 我正在尝试通过 Shiny 输入过滤显示到 dataTable 的内容(在实际应用中会有几十个这样的输入)。
2. 然后，我想编辑 DT 中的单元格值。
3. 最后，我希望能够更改过滤器并保留已编辑的单元格值。

下面的示例应用执行 1 和 2，但不执行 3。在我进行编辑并单击 only_johns 复选框后，dataTable 显示原始数据。

如有任何想法，我们将不胜感激!

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
  sidebarMenu(
              downloadButton("downloadResults","Download Results"),
              checkboxInput("only_johns", "only_johns")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = 'admin', class = 'active', 
      fluidRow(
        box(
          dataTableOutput('userTable'), width = 6
        )
      )
    )
  )
)


ui <- dashboardPage(title = 'admin function test', header, sidebar, body)

server <- function(input, output, session){
  
  #1
  start.df <- reactiveValues(data=NA)
  start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
                    id = 1:60, stringsAsFactors = FALSE)
  

  #2  temp display filters df
  display.df <- reactiveValues(data=start.df)
  observe({
    
    temp <- isolate(start.df$data)
    if (input$only_johns) {
      
    display.df$data <- temp[temp$userName == "John",]
    } else {
      display.df$data <- temp
    }
  })
  
# Display editable datatable
  output$userTable <- renderDataTable({
    req(display.df$data)
    DT::datatable(isolate(display.df$data),
                  editable = TRUE,
                  rownames = FALSE)
  })
  
  ###Tracking Changes###

  proxy = dataTableProxy('userTable')
  observe({
    DT::replaceData(proxy, display.df$data, rownames = FALSE, resetPaging = FALSE)
  })
  
  observeEvent(input$userTable_cell_edit, {
    display.df$data <<- editData(display.df$data, input$userTable_cell_edit, rownames = FALSE)
  })
  
  
  output$downloadResults <- downloadHandler(
    filename = function(){paste("userTest.csv", sep = "")},
    content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
  )
  
}

shinyApp(ui = ui, server = server)

Answer 1

到目前为止你只更新了diplay.df$data，但是你需要更新原来的start.df$data。我已将其包含在我的解决方案中，为了找到正确的行而不考虑当前的过滤，我引入了隐藏在 DT 中的列 row_id。另外，我稍微简化了您的代码。

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
  sidebarMenu(
    downloadButton("downloadResults","Download Results"),
    checkboxInput("only_johns", "only_johns")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = 'admin', class = 'active', 
      fluidRow(
        box(
          dataTableOutput('userTable'), width = 6
        )
      )
    )
  )
)


ui <- dashboardPage(title = 'admin function test', header, sidebar, body)

server <- function(input, output, session){
  
  #1
  start.df <- reactiveValues(data=NA)
  start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
                              id = 1:60,
                              row_id = 1:60,
                              stringsAsFactors = FALSE)
  
  
  #2  temp display filters df
  display.df <- reactiveValues(data=start.df)
  observeEvent(input$only_johns, {
    
    temp <- isolate(start.df$data)
    if (input$only_johns) {
      
      display.df$data <- temp[temp$userName == "John",]
    } else {
      display.df$data <- temp
    }
  })
  
  # Display editable datatable
  output$userTable <- renderDataTable({
    req(display.df$data)
    DT::datatable(isolate(display.df$data),
                  editable = TRUE,
                  rownames = FALSE,
                  options = list(
                    columnDefs = list(
                      list(
                        visible = FALSE,
                        targets = 2
                      )
                    )
                  ))
  })
  
  ###Tracking Changes###
  
  proxy = dataTableProxy('userTable')

  observeEvent(input$userTable_cell_edit, {
    
    display.df$data <- editData(display.df$data, input$userTable_cell_edit, rownames = FALSE)
    DT::replaceData(proxy, display.df$data, rownames = FALSE, resetPaging = FALSE)
    
    # update the data in the original df
    # get the correct row_id
    curr_row_id <- display.df$data[input$userTable_cell_edit[["row"]], "row_id", drop = TRUE]
    # get the correct column position
    column_pos <- input$userTable_cell_edit[["col"]] + 1 # DT starts indexing at 0
    # update the data
    temp <- start.df$data
    temp[temp$row_id == curr_row_id, column_pos] <- input$userTable_cell_edit[["value"]]
    start.df$data <- temp
  })
  
  
  output$downloadResults <- downloadHandler(
    filename = function(){paste("userTest.csv", sep = "")},
    content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
  )
  
}

shinyApp(ui, server)

编辑

这是页面未重置的版本。问题在于，对于编辑后的数据，display.df$data 发生了变化，这触发了 output$userTable 的重新呈现，并重置了页面。为了避免这种情况，我添加了另一个包含已编辑数据的 react 值并且不再更改 display.df，它仅通过更改输入过滤来更改。

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
  sidebarMenu(
    downloadButton("downloadResults","Download Results"),
    checkboxInput("only_johns", "only_johns")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = 'admin', class = 'active', 
      fluidRow(
        box(
          dataTableOutput('userTable'), width = 6
        )
      )
    )
  )
)


ui <- dashboardPage(title = 'admin function test', header, sidebar, body)

server <- function(input, output, session){
  
  #1
  start.df <- reactiveValues(data=NA)
  start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
                              id = 1:60,
                              row_id = 1:60,
                              stringsAsFactors = FALSE)
  
  
  #2  temp display filters df
  display.df <- reactiveValues(data=isolate(start.df))
  edit.df <- reactiveValues(data = isolate(start.df))
  observeEvent(input$only_johns, {
    
    temp <- isolate(start.df$data)
    if (input$only_johns) {
      
      display.df$data <- temp[temp$userName == "John",]
      edit.df$data <- temp[temp$userName == "John",]
    } else {
      display.df$data <- temp
      edit.df$data <- temp
    }
  })
  
  # Display editable datatable
  output$userTable <- renderDataTable({
    req(display.df$data)
    DT::datatable(display.df$data,
                  editable = TRUE,
                  rownames = FALSE,
                  options = list(
                    columnDefs = list(
                      list(
                        visible = FALSE,
                        targets = 2
                      )
                    )
                  ))
  })
  
  ###Tracking Changes###
  
  proxy = dataTableProxy('userTable')

  observeEvent(input$userTable_cell_edit, {
    
    edit.df$data <- editData(edit.df$data, input$userTable_cell_edit, rownames = FALSE)
    DT::replaceData(proxy, edit.df$data, rownames = FALSE, resetPaging = FALSE)
    
    # update the data in the original df
    # get the correct row_id
    curr_row_id <- edit.df$data[input$userTable_cell_edit[["row"]], "row_id", drop = TRUE]
    # get the correct column position
    column_pos <- input$userTable_cell_edit[["col"]] + 1 # DT starts indexing at 0
    # update the data
    temp <- start.df$data
    temp[temp$row_id == curr_row_id, column_pos] <- input$userTable_cell_edit[["value"]]
    start.df$data <- temp
  })
  
  
  output$downloadResults <- downloadHandler(
    filename = function(){paste("userTest.csv", sep = "")},
    content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
  )
  
}

shinyApp(ui, server)