R shiny : trying to keep selected lines, even after changing inputs (renderDataTable)

Posit Professional & Hosted Products shinyapps.io
1

I try to ensure that the lines can be selected and that the selection is retained even when the filters are changed. If certain lines have been selected and fall within the filter criteria, I want them to remain selected regardless of any changes made to the filters.



load("data/data.Rdata")

data <- subset(data, select = c(VARIABLE, VARIABLE.QUESTIONNAIRE, LABEL, ENQUETE, QUESTIONNAIRE, THEME, STATUT))
data <- subset(data, STATUT != "non-disponible")
name <- sort(unique(data$VARIABLE))
theme <- sort(unique(data$THEME))
enquete <- sort(unique(data$ENQUETE))
question <- sort(unique(data$QUESTIONNAIRE))

choix <- c( "Maternité", "2-10 mois : alimentation", "2 mois", "1 an", "2 ans", "3 ans", "4 ans", "5 ans", "6 ans", "7 ans", "9 ans", "10 ans")

# ----- Shiny App -----
ui <- fluidPage(
  
  tags$head(
    tags$style(HTML(
      "label { font-size:120%;margin-bottom:5px; }"))
  ),
  
  # Thème
  theme = bs_theme(version = 4, bootswatch = "minty"),
  
    fluidRow(
    
    column(3, pickerInput("enqueteSelect", "Recherche par enquête", choix, options = pickerOptions(actionsBox = TRUE, size = 10), multiple = TRUE)), 
    column(3, selectInput("themeSelect", "Par thème", theme, selected = NULL, multiple = TRUE)),
    column(3, selectInput("nameSelect", "Par variable", name, selected = NULL, multiple = TRUE),), 
    column(3, selectInput("questionSelect", "Par questionnaire", question, selected = NULL, multiple = TRUE)) ),
  
  
  # DataTab en sortie
  DTOutput("results"),
  

    uiOutput("downloadBtnUI")
)

# ----- Server -----
server <- function(input, output, session) {

    shinyjs::useShinyjs()
  
  
  output$results <- renderDT({
    dt <- data
    
    if (!is.null(input$themeSelect)) {
      dt <- dt %>% filter(THEME %in% input$themeSelect)}
    if (!is.null(input$enqueteSelect)) {
      dt <- dt %>% filter(ENQUETE %in% input$enqueteSelect)}
    if (!is.null(input$nameSelect)) {
      dt <- dt %>% filter(VARIABLE %in% input$nameSelect)}
    if (!is.null(input$questionSelect)) {
      dt <- dt %>% filter(QUESTIONNAIRE %in% input$questionSelect)}
    
    dt
  },
  escape = FALSE,
  selection = 'none', 
  rownames = FALSE,
  extensions = 'Select',
  options = list(
    dom = 'Bfrtip',
    scrollY = 550, scrollX = 400, scroller = TRUE,
    pageLength = 100,
    select = 'multiple'), 
  
  server = FALSE
  )

    proxy <- dataTableProxy("results")
  
  observeEvent(input$enqueteSelect, {
    enquete <- paste0(" ", toString(sprintf("\"%s\"", input$enqueteSelect)), " ")
    updateSearch(
      proxy,
      keywords = list(
        global = NULL,
        columns = c("", "", "", enquete, "", "", "")
      )
    )
  })
    observe({
    shinyjs::enable("downloadBtn")
  })
  

      output$downloadBtnUI <- renderUI({
    if (length(input$results_rows_selected) > 0) {
      downloadButton("downloadBtn", "Télécharger la sélection", icon = icon("download"), style="color: #333; background-color: #e8f5ba; border-color: #333")
    } else {
      return(NULL)
    }
  })
  

        output$downloadBtn <- downloadHandler(
    filename = function() {
      paste0(Sys.Date(), "_VARIABLES.csv")
    },
    content = function(file) {
      selected_rows <- input$results_rows_selected
      selected_data <- data[selected_rows, ]
      write.csv(selected_data, file, row.names = FALSE)
    }
  )
  
}

shinyApp(ui, server)