更改输入后如何在 R Shiny 应用程序中保持选择

Question

我正在尝试创建一个具有行选择和导出为 CSV 文件的应用程序。当我更改过滤器输入时，我无法保留选定的行。我已经设法在页面更改时做到这一点，但在更改过滤器时却无法做到这一点。 所以我希望能够更改 pickerinput 或 selectinput 并保留之前选择的行。

load("data/data.Rdata")

# Selection des colonnes à garder
data <- subset(data, select = c(VARIABLE, VARIABLE.QUESTIONNAIRE, LABEL, ENQUETE, QUESTIONNAIRE, THEME, STATUT))

# Selection des lignes => si la variable est disponible
data <- subset(data, STATUT != "non-disponible")


#Unique Variable / Thème / Enquête / Questionnaire - Pour Input
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")

ui <- fluidPage(
  
  tags$head(
    tags$style(HTML(
      "label { font-size:120%;margin-bottom:5px; }"))
  ),
  
  # Thème
  theme = bs_theme(version = 4, bootswatch = "minty"),
  
  # Titre et En-tête 
  h1("titre"),
  h6("note"),
  
  # Masquer les erreurs 
  tags$style(type="text/css",
             ".shiny-output-error { visibility: hidden; }",
             ".shiny-output-error:before { visibility: hidden; }"
  ),
  
  # Sélection filtrée 
  fluidRow(
    
    column(3, pickerInput("enqueteSelect", "Recherche par enquête", choix, options = pickerOptions(actionsBox = TRUE, size = 10), multiple = TRUE)
    ), br(),  
    column(3, selectInput("themeSelect", "Par thème", theme, selected = NULL, multiple = TRUE)
    ), br(),
    column(3, selectInput("nameSelect", "Par variable", name, selected = NULL, multiple = TRUE),
    ), br(),
    column(3, selectInput("questionSelect", "Par questionnaire", question, selected = NULL, multiple = TRUE)
    ) ),
  
  
  # DataTab en sortie
  DTOutput("results"),
  
  # Bouton de téléchargement
  #downloadButton("downloadBtn", "Télécharger la sélection", icon = icon("download"), style="color: #333; background-color: #e8f5ba; border-color: #333"))
  # Bouton de téléchargement
  uiOutput("downloadBtnUI")
)

# ----- Server -----
server <- function(input, output, session) {
  # Activer shinyjs
  shinyjs::useShinyjs()
  
  
  output$results <- renderDataTable({
    dt <- data
    
    if (
      is.null(input$themeSelect) &&
      is.null(input$enqueteSelect) &&
      is.null(input$nameSelect) &&
      is.null(input$questionSelect)
    ) {
      return(NULL)}
    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)}
    
    
    # Colonne cases à cocher
    #dt$Selection <- paste0('<input type="checkbox" class="rowCheckbox" name="row', 1:nrow(dt), '" value="', 1:nrow(dt), '">')
    
    dt
  },
  escape = FALSE,
  selection = 'none', 
  rownames = FALSE,
  extensions = 'Select',
  options = list(
    dom = 'Bfrtip',
    scrollY = 550, scrollX = 400, scroller = TRUE,
    pageLength = 100,
    select = 'multiple'), # Sélection multiple
  server = FALSE
  )
  
  
  # Maj de la sélection lors du changement de page
  observe({
    shinyjs::enable("downloadBtn")
  })
  
  # Afficher ou masquer le bouton de téléchargement en fonction de la sélection
  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)
    }
  })
  
  # Téléchargement du fichier au format csv
  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)

Answer 1

这是一种通过代理使用

updateSearch

的方法。

library(shiny)
library(shinyWidgets)
library(DT)
library(shinyjs)

dat <- iris
species <- levels(iris$Species)

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      "label { font-size:120%;margin-bottom:5px; }"))
  ),
  # Titre et En-tête 
  h1("titre"),
  h6("note"),
  # Masquer les erreurs 
  tags$style(type="text/css",
             ".shiny-output-error { visibility: hidden; }",
             ".shiny-output-error:before { visibility: hidden; }"
  ),
  # Sélection filtrée 
  fluidRow(
    column(
      3, 
      pickerInput("species", "Select species", species, options = pickerOptions(actionsBox = TRUE, size = 10), multiple = TRUE)
    ) 
  ),
  # DataTab en sortie
  DTOutput("results"),
  # Bouton de téléchargement
  #downloadButton("downloadBtn", "Télécharger la sélection", icon = icon("download"), style="color: #333; background-color: #e8f5ba; border-color: #333"))
  # Bouton de téléchargement
  uiOutput("downloadBtnUI")
)

# ----- Server -----
server <- function(input, output, session) {
  # Activer shinyjs
  shinyjs::useShinyjs()
  
  
  output$results <- renderDT({
    datatable(
      dat,
      escape = FALSE,
      selection = 'multiple', 
      rownames = FALSE,
      filter = "top", # needed to perform columns searching with updateSearch
      options = list(
        dom = 'Bfrtip',
        scrollY = 550, scrollX = 400, scroller = TRUE,
        pageLength = 100
      )
    )
  },
  server = TRUE)
  
  proxy <- dataTableProxy("results")
  
  observeEvent(input$species, {
    species <- paste0("[", toString(sprintf("\"%s\"", input$species)), "]")
    updateSearch(
      proxy,
      keywords = list(
        global = NULL,
        columns = c("", "", "", "", species)
      )
    )
  })
  
  # Maj de la sélection lors du changement de page
  observe({
    shinyjs::enable("downloadBtn")
  })
  
  # Afficher ou masquer le bouton de téléchargement en fonction de la sélection
  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)
    }
  })
  
  # Téléchargement du fichier au format csv
  output$downloadBtn <- downloadHandler(
    filename = function() {
      paste0(Sys.Date(), "_VARIABLES.csv")
    },
    content = function(file) {
      selected_rows <- input$results_rows_selected
      selected_data <- dat[selected_rows, ]
      write.csv(selected_data, file, row.names = FALSE)
    }
  )
  
}

shinyApp(ui, server)