Shiny级联选择器添加全选选项及关联动态表格实现问题

完整实现代码 #

library(shiny)
library(DT)

ui <- fluidPage(
  titlePanel("Test Dashboard "),
  sidebarLayout(
    sidebarPanel(
      uiOutput("data1"),   
      uiOutput("data2"),
      uiOutput("data3")
    ),
    mainPanel(
      DTOutput('table') # 表格放在主面板，适配sidebarLayout布局结构
    )
  ))


server <- function(input, output){
  
  State <- c("NV", "NV","NV", "MD", "MD", "MD", "MD", "NY", "NY", "NY", "OH", "OH", "OH")
  County <- c("CLARK", "WASHOE", "EUREKA", "MONTGOMERY", "HOWARD", "BALTIMORE", "FREDERICK", "BRONX", "QUEENS", "WESTCHESTER", "FRANKLIN", "SUMMIT", "STARK" )
  City <- c("Las Vegas", "Reno", "Eureka", "Rockville", "Columbia", "Baltimore", "Thurmont", "Bronx", "Queens", "Yonkers", "Columbus", "Akron", "Canton")
  Rating<- c(1,2,3,4,5,6,7,8,9,10,11,12,13)
  df <- data.frame(State, County, City, Rating, stringsAsFactors = F)
  
  # 第一级州选择器：新增全部选项，支持多选
  output$data1 <- renderUI({
    selectInput("data1", "Select State", 
                choices = c("全部", unique(df$State)),
                multiple = TRUE,
                selected = "全部")
  })
  
  # 第二级县选择器：随选中州更新选项，新增全部选项
  output$data2 <- renderUI({
    req(input$data1)
    # 先根据选中的州过滤可选县范围
    if("全部" %in% input$data1){
      available_county <- unique(df$County)
    }else{
      available_county <- unique(df$County[df$State %in% input$data1])
    }
    selectInput("data2", "Select County", 
                choices = c("全部", available_county),
                multiple = TRUE,
                selected = "全部")
  })
  
  # 第三级城市选择器：随选中州、县更新选项，新增全部选项
  output$data3 <- renderUI({
    req(input$data1, input$data2)
    tmp_df <- df
    if(!"全部" %in% input$data1){
      tmp_df <- tmp_df[tmp_df$State %in% input$data1,]
    }
    if(!"全部" %in% input$data2){
      tmp_df <- tmp_df[tmp_df$County %in% input$data2,]
    }
    available_city <- unique(tmp_df$City)
    selectInput("data3", "select City", 
                choices = c("全部", available_city),
                multiple = TRUE,
                selected = "全部")
  })
  
  # 响应式筛选数据
  filtered_df <- reactive({
    req(input$data1, input$data2, input$data3)
    res <- df
    # 州筛选：未选全部时才生效
    if(!"全部" %in% input$data1){
      res <- res[res$State %in% input$data1,]
    }
    # 县筛选：未选全部时才生效
    if(!"全部" %in% input$data2){
      res <- res[res$County %in% input$data2,]
    }
    # 城市筛选：未选全部时才生效
    if(!"全部" %in% input$data3){
      res <- res[res$City %in% input$data3,]
    }
    res
  })
  
  # 渲染动态表格
  output$table <- renderDT({
    filtered_df()
  }, options = list(pageLength = 5))
  
}

shinyApp(ui, server)

核心修改说明 #

• 布局问题修复：将DTOutput放在mainPanel内部，符合sidebarLayout的组件结构，不会打乱原有页面布局
• 选择器功能升级：每个下拉框新增multiple = TRUE支持多选，所有选项头部增加全部选项默认选中，同时保留下一级选项对上一级选择的依赖，不会出现无效选项
• 筛选逻辑适配：通过响应式变量filtered_df实现三级条件过滤，只要某一级选中全部就跳过该维度的筛选，完全匹配需求的筛选规则
• 表格动态更新：renderDT直接调用响应式筛选结果，选择器修改时表格会自动刷新

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