在闪亮的应用程序中过滤数据，但在更新表时将值保留在 selectInput 中

我有一个闪亮的应用程序，要求用户上传一个文件（带有数据的表格文件），然后将该文件呈现到一个表中，用户可以根据numericInput, selectInput, and textAreaInput。用户必须选择过滤器，然后按下按钮才能过滤表。

没有顺序过滤，即用户可以填充所有过滤器或仅填充一个。每次用户选择一个过滤器时，其他过滤器的值都会更新（selectInput输入），这就是我想要的行为。然而，一旦Filter按钮被按下，我看不到以前的选择，也无法重置过滤器。

我想要实现的是在更新过滤器时保持实际行为，即一旦我选择一个过滤器并按下另一个过滤器按钮selectInput选择会自动更新，BUT我想跟踪过滤器的选择，以便用户可以看到他/她选择的过滤器。这正是我所期待的，但每次我按下按钮Filter似乎过滤器选项卡再次呈现。

这是我的应用程序，

library(shiny)
library(vroom)
library(dplyr)
library(shinycssloaders)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyr)


header <- dashboardHeader()

sidebar <- dashboardSidebar(width = 450,

  sidebarMenu(id="tabs", 
    menuItem("Filtros", tabName="filtros", icon = icon("bar-chart-o")),
      uiOutput("filtros")

  )
)

body <- dashboardBody(

  tabItems(
    tabItem(tabName="filtros",
          fluidRow(
          column(12,dataTableOutput("tabla_julio") %>% withSpinner(color="#0dc5c1"))
        )
    )  
   )
 )

ui <- dashboardPagePlus(enable_preloader = TRUE, sidebar_fullCollapse = TRUE, header, sidebar, body)

server = function(input, output, session) {

    #Create the choices for sample input
    vals <- reactiveValues(data=NULL)
    vals$data <- iris



  output$filtros <- renderUI({

    datos <- vals$data
      conditionalPanel("input.tabs == 'filtros'",
        tagList(        
            div(style="display: inline-block;vertical-align:top; width: 221px;",numericInput(inputId="Sepal.Length", label="Sepal.Length", value=NA, min = NA, max = NA, step = NA)),                      
            div(
              div(style="display: inline-block;vertical-align:top; width: 224px;", selectInput(inputId = "Species", label = "Species", width = "220",  choices=unique(datos$Species), 
              selected = NULL, multiple = TRUE, selectize = TRUE, size = NULL))
              )
            ),
            actionButton("filtrar", "Filter")
          )
    })

# create reactiveValues

  vals <- reactiveValues(data=NULL)
  vals$data <- iris


# Filter data

observeEvent(input$filtrar, {

      tib <- vals$data

      if (!is.na(input$Sepal.Length)){
        tib <- tib %>% dplyr::filter(!Sepal.Length >= input$Sepal.Length)
        print(head(tib))
      } else { tib <- tib }

      # Filter
      if (!is.null(input$Species)){
        toMatch <- paste0("\\b", input$Species, "\\b")
        matches <- unique(grep(paste(toMatch,collapse="|"), tib$Species, value=TRUE))
        tib <- tib %>% dplyr::filter(Species %in% matches)
      } else { tib <- tib}

      tib -> vals$data
      print(head(tib, n=15))

    })


  # Reactive function creating the DT output object
  output$tabla_julio <- DT::renderDataTable({        
      DT::datatable(vals$data) 
    })

}

shinyApp(ui, server)

另一个更新：

library(shiny)
library(vroom)
library(dplyr)
library(shinycssloaders)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyr)

header <- dashboardHeader()

sidebar <- dashboardSidebar(width = 450,
                            sidebarMenu(id = "tabs",
                                        menuItem(
                                          "Filtros",
                                          tabName = "filtros",
                                          icon = icon("bar-chart-o")
                                        ),
                                        uiOutput("filtros")
                            ))

body <- dashboardBody(tabItems(tabItem(tabName = "filtros",
                                       fluidRow(
                                         column(12,
                                                DT::dataTableOutput("tabla_julio") # %>% withSpinner(color = "#0dc5c1")
                                         )
                                       ))))

ui <-
  dashboardPagePlus(
    enable_preloader = FALSE,
    sidebar_fullCollapse = TRUE,
    header,
    sidebar,
    body
  )

server = function(input, output, session) {
  
  # Create the choices for sample input
  vals <- reactiveValues(data = iris, filtered_data = iris)
  
  output$filtros <- renderUI({
    datos <- isolate(vals$data)
    conditionalPanel(
      "input.tabs == 'filtros'",
      tagList(
        div(
          style = "display: inline-block;vertical-align:top; width: 221px;",
          numericInput(
            inputId = "SepalLength",
            label = "Sepal.Length",
            value = NA,
            min = NA,
            max = NA,
            step = NA
          )
        ),
        div(
          div(
            style = "display: inline-block;vertical-align:top; width: 224px;",
            selectInput(
              inputId = "Species",
              label = "Species",
              width = "220",
              choices = unique(isolate(datos$Species)),
              selected = NULL,
              multiple = TRUE,
              selectize = TRUE,
              size = NULL
            )
          )
        )
      ),
      actionButton("filtrar", "Filter", style = "width: 100px;"),
      actionButton("reset", "Reset", style = "width: 100px;")
    )
  })
  
  
  # Filter data
  observeEvent(input$filtrar, {
    tib <- vals$data
    
    if (!is.na(input$SepalLength)) {
      tib <- tib %>% dplyr::filter(Sepal.Length < input$SepalLength)
      print(head(tib))
    } else {
      tib
    }
    
    # Filter
    if (!is.null(input$Species)) {
      tib <- tib %>% dplyr::filter(Species %in% input$Species)
    } else {
      tib
    }
    
    print(head(tib, n = 15))
    
    vals$filtered_data <- tib
    
    updateSelectInput(session, inputId = "Species", selected = input$Species, choices = unique(vals$filtered_data$Species))
    
  })
  
  observeEvent(input$reset, {
    updateNumericInput(session, inputId = "SepalLength", value = NA)
    updateSelectInput(session, inputId = "Species", selected = "")
  })
  
  # Reactive function creating the DT output object
  output$tabla_julio <- DT::renderDataTable({
    DT::datatable(vals$filtered_data)
  }, server = FALSE)
  
}

shinyApp(ui, server)

Update:我想这就是你所追求的。最重要的一步是isolate输入在renderUI因此它们不会在每次输入更改时重新渲染。

library(shiny)
library(vroom)
library(dplyr)
library(shinycssloaders)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyr)

header <- dashboardHeader()

sidebar <- dashboardSidebar(width = 450,
                            sidebarMenu(id = "tabs",
                                        menuItem(
                                          "Filtros",
                                          tabName = "filtros",
                                          icon = icon("bar-chart-o")
                                        ),
                                        uiOutput("filtros")
                            ))

body <- dashboardBody(tabItems(tabItem(tabName = "filtros",
                                       fluidRow(
                                         column(12,
                                                DT::dataTableOutput("tabla_julio") # %>% withSpinner(color = "#0dc5c1")
                                         )
                                       ))))

ui <-
  dashboardPagePlus(
    enable_preloader = FALSE,
    sidebar_fullCollapse = TRUE,
    header,
    sidebar,
    body
  )

server = function(input, output, session) {
  
  # Create the choices for sample input
  vals <- reactiveValues(data = iris, filtered_data = iris)
  
  output$filtros <- renderUI({
    datos <- isolate(vals$data)
    conditionalPanel(
      "input.tabs == 'filtros'",
      tagList(
        div(
          style = "display: inline-block;vertical-align:top; width: 221px;",
          numericInput(
            inputId = "SepalLength",
            label = "Sepal.Length",
            value = NA,
            min = NA,
            max = NA,
            step = NA
          )
        ),
        div(
          div(
            style = "display: inline-block;vertical-align:top; width: 224px;",
            selectInput(
              inputId = "Species",
              label = "Species",
              width = "220",
              choices = unique(isolate(datos$Species)),
              selected = NULL,
              multiple = TRUE,
              selectize = TRUE,
              size = NULL
            )
          )
        )
      ),
      actionButton("filtrar", "Filter", style = "width: 100px;"),
      actionButton("reset", "Reset", style = "width: 100px;")
    )
  })
  
  
  # Filter data
  observeEvent(input$filtrar, {
    tib <- vals$data
    
    if (!is.na(input$SepalLength)) {
      tib <- tib %>% dplyr::filter(Sepal.Length < input$SepalLength)
      print(head(tib))
    } else {
      tib
    }
    
    # Filter
    if (!is.null(input$Species)) {
      tib <- tib %>% dplyr::filter(Species %in% input$Species)
    } else {
      tib
    }
    
    print(head(tib, n = 15))
    
    vals$filtered_data <- tib
    
  })
  
  observeEvent(input$reset, {
    updateNumericInput(session, inputId = "SepalLength", value = NA)
    updateSelectInput(session, inputId = "Species", selected = "")
  })
  
  # Reactive function creating the DT output object
  output$tabla_julio <- DT::renderDataTable({
    DT::datatable(vals$filtered_data)
  }, server = FALSE)
  
}

shinyApp(ui, server)

初步回答：

我建议使用selectizeGroup模块 https://dreamrs.github.io/shinyWidgets/reference/selectizeGroup-module.html来自图书馆（闪亮小部件 https://github.com/dreamRs/shinyWidgets).

它创建了一个

相互依存的群体selectizeInput用于过滤 data.frame 的列（如 Excel 中的列）。

除此之外，它只使用selectizeInput它似乎满足您的要求，并节省了我们大量的打字时间。

这是一个使用的示例iris数据集：

library(shiny)
library(DT)
library(shinyWidgets)
library(datasets)

DF <- iris
names(DF) <- gsub("\\.", "", names(DF))

ui <- fluidPage(
  fluidRow(
    column(width = 10, offset = 1, tags$h3("Filter data with selectize group")),
    column(width = 3, offset = 1, 
           selectizeGroupUI(
             id = "my-filters",
             params = list(
               SepalLength = list(inputId = "SepalLength", title = "SepalLength:"),
               SepalWidth = list(inputId = "SepalWidth", title = "SepalWidth:"),
               PetalLength = list(inputId = "PetalLength", title = "PetalLength:"),
               PetalWidth = list(inputId = "PetalWidth", title = "PetalWidth:"),
               species = list(inputId = "Species", title = "Species:")
             ),
             inline = FALSE
           )),
    column(
      width = 10, offset = 1,DT::dataTableOutput(outputId = "table")
    )
  )
)

server <- function(input, output, session) {
  filtered_table <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = DF,
    vars = names(DF),
    inline = FALSE
  )
  output$table <- DT::renderDataTable(filtered_table())
}

shinyApp(ui, server)