R Shiny中基于上下界的多过滤器实现技术问询

Got you covered! Here's a complete, runnable Shiny app that implements dynamic, unlimited filters exactly as you described—each with variable selection, upper/lower bounds, and the choice to keep values inside or outside the specified range. I adapted this from the dynamic UI filter concept you mentioned:

library(shiny)
library(DT)

# Sample data to filter (replace with your own dataset)
sample_data <- mtcars

ui <- fluidPage(
  titlePanel("Dynamic Unlimited Filters"),
  actionButton("add_filter", "Add New Filter"),
  br(), br(),
  div(id = "filter_container"), # Container for dynamic filter groups
  br(),
  DTOutput("filtered_table")
)

server <- function(input, output, session) {
  # Track active filter IDs to manage dynamic UI state
  filters <- reactiveValues(ids = c())
  
  # Add new filter group when button is clicked
  observeEvent(input$add_filter, {
    new_id <- paste0("filter_", length(filters$ids) + 1)
    filters$ids <- c(filters$ids, new_id)
    
    insertUI(
      selector = "#filter_container",
      where = "beforeEnd",
      ui = div(
        id = new_id,
        fluidRow(
          column(3,
                 selectInput(paste0("var_", new_id), "Select Variable:",
                             choices = names(sample_data))
          ),
          column(2,
                 numericInput(paste0("lwr_", new_id), "Lower Bound:",
                              value = min(sample_data[[1]]))
          ),
          column(2,
                 numericInput(paste0("upr_", new_id), "Upper Bound:",
                              value = max(sample_data[[1]]))
          ),
          column(3,
                 selectInput(paste0("logic_", new_id), "Filter Logic:",
                             choices = c("Keep values between bounds" = "inside",
                                         "Keep values outside bounds" = "outside"))
          ),
          column(2,
                 actionButton(paste0("remove_", new_id), "Remove Filter")
          )
        ),
        br()
      )
    )
    
    # Auto-update bounds when a new variable is selected
    observeEvent(input[[paste0("var_", new_id)]], {
      selected_var <- input[[paste0("var_", new_id)]]
      updateNumericInput(session, paste0("lwr_", new_id), value = min(sample_data[[selected_var]]))
      updateNumericInput(session, paste0("upr_", new_id), value = max(sample_data[[selected_var]]))
    })
    
    # Remove filter group when its remove button is clicked
    observeEvent(input[[paste0("remove_", new_id)]], {
      filters$ids <- filters$ids[filters$ids != new_id]
      removeUI(selector = paste0("#", new_id))
    })
  })
  
  # Apply all active filters to the data
  filtered_data <- reactive({
    data <- sample_data
    
    # Loop through each active filter and apply logic
    for (filter_id in filters$ids) {
      var <- input[[paste0("var_", filter_id)]]
      lwr <- input[[paste0("lwr_", filter_id)]]
      upr <- input[[paste0("upr_", filter_id)]]
      logic <- input[[paste0("logic_", filter_id)]]
      
      # Only apply filter if all inputs are set
      if (!is.null(var) && !is.null(lwr) && !is.null(upr) && !is.null(logic)) {
        if (logic == "inside") {
          data <- data[data[[var]] > lwr & data[[var]] < upr, ]
        } else {
          data <- data[data[[var]] < lwr | data[[var]] > upr, ]
        }
      }
    }
    
    data
  })
  
  # Display filtered data in an interactive table
  output$filtered_table <- renderDT({
    datatable(filtered_data(), options = list(pageLength = 10))
  })
}

shinyApp(ui, server)

Key Features Explained #

• Unlimited Filters: Click "Add New Filter" to create as many filter groups as your server can handle—no hard limits.
• Variable-Specific Bounds: When you select a new variable, the lower/upper bounds auto-set to the variable's min/max (you can override these manually).
• Dual Filter Logic: Choose between keeping values between the bounds or outside them for each filter.
• Clean Filter Removal: Each filter group has its own "Remove Filter" button to tidy up unused filters.
• Real-Time Updates: The table refreshes instantly as you adjust any filter settings.

Core Mechanics #

1. State Tracking: reactiveValues(filters$ids) keeps a list of all active filter IDs, so we can loop through every filter when applying subsetting logic.
2. Dynamic UI: insertUI injects new filter groups into the container, while removeUI deletes them when requested.
3. Filter Application: The filtered_data reactive expression iterates over each active filter, applies the selected logic to the chosen variable, and returns the subsetted data for display.

内容的提问来源于stack exchange，提问作者Vangelis