R Shiny中根据首下拉框选中值动态限制次下拉框选项实现子集筛选

要实现两个下拉框的联动效果，核心是通过observeEvent()监听第一个选择框的取值变化，触发updateSelectInput()动态更新第二个选择框的可选列表，具体修改如下：

完整可运行代码 #

library(shiny)
library(tidyverse)

# 定义测试数据集
d = tibble(
    colour = c('blue','blue','yellow','yellow'),
    thing = c('the sea',"my lover's eyes", 'the sun', 'campari')
)

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            selectInput("my_colour", "Pick a colour:", 
                        choices=unique(d$colour)),
            # 初始可选值留空，后续由server端动态赋值
            selectInput("my_thing", "Pick a thing:", 
                        choices=NULL)
        ),
        mainPanel(
           textOutput("my_text")
        )
    )
)

# 注意server需要新增session参数，才能调用更新输入项的方法
server <- function(input, output, session) {
    # 监听颜色选择框的变化，触发更新事物选择框的可选值
    observeEvent(input$my_colour, {
        # 筛选当前选中颜色对应的所有事物
        valid_things <- d %>%
            filter(colour == input$my_colour) %>%
            pull(thing) %>%
            unique()
        # 更新事物选择框的可选列表
        updateSelectInput(session, "my_thing", choices = valid_things)
    })

    output$my_text <- renderText({
        d %>% 
            filter(
                colour == input$my_colour,
                thing == input$my_thing
            ) %>% 
            pull(thing) %>% 
            paste(collapse = ', ')
    })
}

shinyApp(ui = ui, server = server)

关键改动说明 #

• 给server函数新增了session参数，这是调用所有update*系列输入更新函数的必要参数
• 新增observeEvent(input$my_colour, {...})响应式监听逻辑，每次颜色选择变化时，自动筛选对应关联的事物取值，更新第二个下拉框的可选列表
• UI端的my_thing初始可选值设为NULL，避免初始加载时出现不匹配的可选值，应用启动后会自动触发第一次更新加载对应初始颜色的事物列表

可选替代方案 #

你也可以用动态UI的方式实现：把UI端的selectInput("my_thing")替换为uiOutput("dynamic_thing")，然后在server端新增output$dynamic_thing <- renderUI({...})，每次根据当前选中的颜色渲染对应的选择框。不过相比updateSelectInput的方案，动态UI的渲染开销更大，更推荐上面的实现方式。

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