如何解决如何使用有光泽的输入来过滤已编辑的数据表？

我陷入了一个三部分的过程：

我正在尝试通过Shiny输入过滤显示到dataTable的内容（在实际应用中将有数十种）。
然后，我想在DT中编辑单元格值。
最后，我希望能够更改过滤器并保留已编辑的单元格值。

下面的示例应用程序执行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)

解决方法

到目前为止，您仅更新了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,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的重新呈现，从而重置了页面。为了避免这种情况，我添加了另一个包含已编辑数据的反应性值，并且不再更改display.df，只能通过更改输入过滤来更改它。

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

header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
  sidebarMenu(
    downloadButton("downloadResults",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,]
      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,{
    
    edit.df$data <- editData(edit.df$data,edit.df$data,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"]],server)

__ 你好！

此帖子非常有趣。我使用了与上面相同的代码，但是当我编辑单元格时，会向用户显示一条错误消息：每个版本上都显示“警告：JSON无效响应”！

一切似乎都是正确的。如何删除此错误消息？

我尝试了一下，但是没有用：

tags$script(HTML("$.fn.dataTable.ext.errMode = 'throw';")),

非常感谢您的合作，问候