有没有办法在 shiny 中将选择器/选择输入与可编辑的反应式 DT 结合使用？

Question

I have struggled with the following issue and have found no suitable solution on SO.

Here is what I require from my DataTable

1. I would like to edit my DataTable (achieved)
2. Filter the data in DataTable with my edits intact. Currently, my edits disappear after I change the filters
3. Save whole DataTable as RDS rather than just the current displayed data based on filters. Currently, I just save the current displayed DataTable based on filters

Thank you for your help in advance!

df <- iris

species <- unique(as.character(df$Species))
width <- unique(df$Petal.Width)
#==========================================UI=======================================================#
ui = navbarPage("CSAT & SA", theme = shinytheme("flatly"),
                tabPanel("Sentiment Analysis",
                         sidebarLayout(
                           sidebarPanel(
                             pickerInput(inputId = "species",
                                         label = "Species", selected = species,
                                         choices = species, multiple = T, 
                                         options = list(`actions-box` = TRUE, `deselect-all-text` = "None...",
                                                        `select-all-text` = "Select All", `none-selected-text` = "None Selected")),
                             pickerInput(inputId = "width",
                                         label = "Petal Width", selected = width,
                                         choices = width, multiple = T, 
                                         options = list(`actions-box` = TRUE, `deselect-all-text` = "None...",
                                                        `select-all-text` = "Select All", `none-selected-text` = "None Selected")),
                             width = 2, 
                             actionButton(inputId = "save", label = "Save"), 
                             actionButton(inputId = "update", label = "Update")
                           ),
                           mainPanel(
                             h2("Iris"), fluidRow(
                               tabPanel("Iris", DT::dataTableOutput("x1"),
                                        width = 12)
                             )))))
#==========================================SERVER=======================================================#

server <- function(input, output, session) {
  
  SA <- reactive({
    df<-df %>%
      filter(Species %in% input$species) %>%
      filter(Petal.Width %in% input$width)
  }) 
  
  
  rec_val = reactiveValues(df = NULL)
  
  
  observe({
    rec_val$SA <- SA()
  })
  
  output$x1 = renderDT(SA(),  selection = 'none', editable = list(target = 'cell', disable = list(columns=c(0,1,2))))
  
  proxy = dataTableProxy('x1')
  
  observeEvent(input$x1_cell_edit, {
    info = input$x1_cell_edit
    str(info)
    i = info$row
    j = info$col   
    v = info$value
    rec_val$SA[i, j] <<- DT::coerceValue(v, rec_val$SA[i, j])
    replaceData(proxy, rec_val$SA, resetPaging = FALSE)
  })
  
  observeEvent(input$save, {
    saveRDS(rec_val$SA, "somewhere.rds") # write new data out
    
  })

  
  
}

shinyApp(ui = ui, server = server) 

Edit:

see here

Answer 1

You need to use updatePickerInput() to update the choices available based on the edits. Also, define row id to keep the modified data. Using reset you can return to the original datatable. Try this

library(shinythemes)
dat <- iris

species <- unique(as.character(dat$Species))
width <- unique(dat$Petal.Width)
#==========================================UI=======================================================#
ui = navbarPage("CSAT & SA", theme = shinytheme("flatly"),
                tabPanel("Sentiment Analysis",
                         sidebarLayout(
                           sidebarPanel(
                             pickerInput(inputId = "species",
                                         label = "Species", selected = species,
                                         choices = as.list(species), multiple = T, 
                                         options = list(`actions-box` = TRUE, `deselect-all-text` = "None...",
                                                        `select-all-text` = "Select All", `none-selected-text` = "None Selected")),
                             pickerInput(inputId = "width",
                                         label = "Petal Width", selected = width,
                                         choices = as.list(width), multiple = T, 
                                         options = list(`actions-box` = TRUE, `deselect-all-text` = "None...",
                                                        `select-all-text` = "Select All", `none-selected-text` = "None Selected")),
                             width = 2, 
                             actionButton(inputId = "save", label = "Save"), 
                             actionButton(inputId = "reset", label = "Reset")
                           ),
                           mainPanel(
                             h2("Iris"), fluidRow(
                               tabPanel("Iris", DT::dataTableOutput("x1"), DTOutput("x2"),
                                        width = 12)
                             )))))
#==========================================SERVER=======================================================#

server <- function(input, output, session) {
  
  SA <- reactive({
    row_id <- c(1:nrow(dat))
    data <- data.frame(dat,row_id)
    data
  })
  
  rv = reactiveValues(df = NULL)
  
  observe({
    rv$df <- SA() %>%
      filter(Species %in% isolate(input$species)) %>%
      filter(Petal.Width %in% isolate(input$width))
  })
  
  observeEvent(input$species, {
                  df1 <- SA()         ### orig data
                  df2 <- rv$df        ### modified data
                  if (is.null(df2)){
                    rvdf <- SA()
                  }else{
                    vn <- colnames(df1)
                    vnx <- paste0(vn,".x")
                    vny <- paste0(vn,".y")

                    rvdf <- left_join(df1, df2, by="row_id") %>% transmute(var1 = get(!!vnx[1]), var2 = get(!!vnx[2]), var3 = get(!!vnx[3]),
                                                                            var4 = ifelse(is.na(get(!!vny[4])), get(!!vnx[4]), get(!!vny[4])),
                                                                            var5 = get(!!vnx[5]),  # ifelse(is.na(get(!!vny[5])), get(!!vnx[5]), get(!!vny[5])),
                                                                            row_id)

                    colnames(rvdf) <- vn
                  }
                  rv$df <- rvdf  %>%
                    filter(Species %in% input$species) %>% 
                    filter(Petal.Width %in% input$width)

  })
  
  observeEvent(input$width, {
    df1 <- SA()         ### orig data
    df2 <- rv$df        ### modified data
    if (is.null(df2)){
      rvdf <- SA()
    }else{
      
      vn <- colnames(df1)
      vnx <- paste0(vn,".x")
      vny <- paste0(vn,".y")
      ###    keep modified data, if present; if not, keep original data
      rvdf <- left_join(df1, df2, by="row_id") %>% transmute(var1 = get(!!vnx[1]), var2 = get(!!vnx[2]), var3 = get(!!vnx[3]),
                                                              var4 = ifelse(is.na(get(!!vny[4])), get(!!vnx[4]), get(!!vny[4])),  ##  keep modified data
                                                              var5 = get(!!vnx[5]),  # ifelse(is.na(get(!!vny[5])), get(!!vnx[5]), get(!!vny[5])),
                                                              row_id)
      
      colnames(rvdf) <- vn
      
    }
    rv$df <- rvdf  %>%
      filter(Species %in% input$species) %>% 
      filter(Petal.Width %in% input$width)
    
  })
  
  output$x1 <- renderDT(rv$df,  selection = 'none',
                       editable = list(target = 'cell', disable = list(columns=c(0,1,2))),
                       options = list(
                         columnDefs = list(
                           list(
                             visible = FALSE,
                             targets = 6
                           )
                         )
                       )
                       )
  
  proxy <- dataTableProxy('x1')
  
  observeEvent(input$x1_cell_edit, {
    info = input$x1_cell_edit
    str(info)
    i = info$row
    j = info$col   
    v = info$value
    
    rv$df[i, j] <<- DT::coerceValue(v, rv$df[i, j])
    
    #replaceData(proxy, rv$df, resetPaging = FALSE)
    
  })
  
  observeEvent(input$save, {
    #choicess <- as.list(unique(c(as.character(rv$df[,5]), as.character(SA()[,5]))))
    choicesp <- as.list(unique(c(rv$df[,4], SA()[,4])))
    # updatePickerInput(session, inputId = "species", choices = choicess, selected=choicess)
    updatePickerInput(session, inputId = "width", choices = choicesp, selected=choicesp)
    saveRDS(rv$df, "somewhere.rds") # write new data out
    
    df3 <- readRDS("C:/My Disk Space/_My Work/RStuff/GWS/somewhere.rds")
    output$x2 <- renderDT({
      df3
    })
    
  })
  observeEvent(input$reset, {
    rv$df <- SA()
    # choicess <- unique(as.character(rv$df[,5]))
    choicesp <- unique(SA()[,4])
    # updatePickerInput(session, inputId = "species", choices = choicess, selected=choicess)
    updatePickerInput(session, inputId = "width", choices = choicesp, selected=choicesp)
  })
  
}

shinyApp(ui = ui, server = server)