通过 DT 包中的 Shiny 数据表保存对反应式数据框所做的更改

Question

请帮忙。我对这篇文章有一个后续问题。 如何使用DT包编辑和保存对Shiny数据表所做的更改

如果数据表数据集是反应式数据框怎么办？那么我怎样才能保存编辑呢？

为了进一步澄清，假设我要求用户输入性别选择（男性或女性），然后我根据该反应性输入创建输出 tab1 数据表，并且仍然希望能够编辑并将更改保存到该数据表。我怎样才能做到这一点？请参阅下面的示例代码。

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


Admit <- c("Admitted","Rejected","Admitted", "Rejected", "Admitted", "Rejected", "Admitted",
         "Rejected","Admitted", "Rejected", "Admitted","Rejected","Admitted", "Rejected","Admitted","Rejected", "Admitted", "Rejected",
         "Admitted","Rejected", "Admitted" ,"Rejected","Admitted", "Rejected")
Gender <- c("Male","Male","Female","Female", "Male",   "Male",   "Female", "Female", "Male","Male","Female","Female",
          "Male","Male","Female","Female","Male",   "Male",   "Female", "Female","Male","Male","Female","Female")
Dept <- c( "A","A", "A", "A", "B", "B", "B", "B", "C", "C", "C", "C", "D", "D", "D", "D", "E", "E", "E", "E", "F", "F", "F", "F")
Freq <- c("512", "313",  "89",  "19", "353", "207",  "17",   "8", "120", "205", "202", "391", "138", "279", "131", "244",  "53", "138",
        "94", "299",  "22", "351",  "24", "317")

banking.df<-data.frame(Admit,Gender,Dept, Freq,stringsAsFactors = FALSE)



ui <- fluidPage(
  
  selectInput("gender", label = "Select Gender", c("Male", "Female"), selected = "Male"), br(),
  
  DTOutput("tab1"), br(), 
  
  actionButton("saveBtn", "Save changes"), br(),
  
  DTOutput("tab2")
)


server=function(input, output) {
  
  dat1 <- reactive({ banking.df %>% filter(Gender %in% input$gender) })
  
  output$tab1<-renderDT(datatable(dat1(), selection='none', editable = 'cell') )
  
  observeEvent(input$tab1_cell_edit, { 
    str(input$tab1_cell_edit)
    row  <- input$tab1_cell_edit$row
    col <- input$tab1_cell_edit$col
    value <- input$tab1_cell_edit$value
    dat1()[row,col] <<- value
  })
  
  save_fun<-eventReactive(input$saveBtn,{
    dat1()
  })
  
  output$tab2 <- renderDT({
    datatable(dat1(), caption="After Saved Edits")})
  
}

shinyApp(ui = ui, server = server)

将更改保存回反应式数据帧时出现此错误

警告：<<-: invalid (NULL) left side of assignment

中出现错误

Answer 1

我在你的代码中发现了几个错误并修改了它：

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

Admit <- c("Admitted","Rejected","Admitted", "Rejected", "Admitted", "Rejected", "Admitted",
           "Rejected","Admitted", "Rejected", "Admitted","Rejected","Admitted", "Rejected","Admitted","Rejected", "Admitted", "Rejected",
           "Admitted","Rejected", "Admitted" ,"Rejected","Admitted", "Rejected")
Gender <- c("Male","Male","Female","Female", "Male",   "Male",   "Female", "Female", "Male","Male","Female","Female",
            "Male","Male","Female","Female","Male",   "Male",   "Female", "Female","Male","Male","Female","Female")
Dept <- c( "A","A", "A", "A", "B", "B", "B", "B", "C", "C", "C", "C", "D", "D", "D", "D", "E", "E", "E", "E", "F", "F", "F", "F")
Freq <- c("512", "313",  "89",  "19", "353", "207",  "17",   "8", "120", "205", "202", "391", "138", "279", "131", "244",  "53", "138",
          "94", "299",  "22", "351",  "24", "317")

banking.df <- data.frame(Admit, Gender, Dept, Freq, stringsAsFactors = FALSE)

ui <- fluidPage(
    selectInput("gender", label = "Select Gender", c("Male", "Female"), selected = "Male"), br(),
    DTOutput("tab1"), br(),
    actionButton("saveBtn", "Save changes"), br(),
    DTOutput("tab2")
)

server <- function(input, output) {
    dat1 <- reactiveVal()

    observe({
        dat1(banking.df %>% filter(Gender %in% input$gender))
    })

    output$tab1 <- renderDT(datatable(dat1(), selection = 'none', editable = 'cell'))

    observeEvent(input$tab1_cell_edit, {
        info <- input$tab1_cell_edit
        str(info)
        modified_data <- dat1()
        modified_data[info$row, info$col] <- info$value
        dat1(modified_data)
    })

    save_fun <- eventReactive(input$saveBtn, {
        dat1()
    })

    output$tab2 <- renderDT({
        datatable(save_fun(), caption = "After Saved Edits")
    })
}

shinyApp(ui = ui, server = server)