如何在Shiny中将过滤后的唯一值传递至联动下拉框？

问题描述 #

我有如下结构的数据集：

provincia municipio                
   <chr>     <chr>                    
 1 Alicante  Alacantí                 
 2 Madrid    Zona Suroeste            
 3 Valencia  Valencia, Zona de        
 4 Cádiz     Campo de Gibraltar       
 5 Barcelona Maresme                  
 6 Madrid    Madrid, Zona de          
 7 Almería   Levante Almeriense       
 8 Sevilla   Sevilla capital y entorno
 9 Tarragona Baix Penedès             
10 Cádiz     Bahía de Cádiz  

完整数据集结构：

data = structure(list(provincia = c("Alicante", "Madrid", "Valencia", 
"Cádiz", "Barcelona", "Madrid", "Almería", "Sevilla", "Tarragona", 
"Cádiz", "Cádiz", "Zaragoza", "Málaga", "Cádiz", "Alicante", 
"Barcelona", "Valencia", "Córdoba", "Cádiz", "Madrid", "Barcelona", 
"Madrid", "Málaga", "Gipuzkoa", "Madrid", "Girona", "Tarragona", 
"Tarragona", "Jaén", "Barcelona", "Tarragona", "Tarragona", 
"Tarragona", "Tarragona", "Granada", "Granada", "Tarragona", 
"Tarragona", "Madrid", "Tarragona", "Pontevedra", "Tarragona", 
"Málaga", "Alicante", "Tarragona", "León", "Alicante", "Valencia", 
"Málaga", "Toledo", "Málaga", "Tarragona", "Granada", "Alicante", 
"Madrid", "Málaga", "Almería", "Madrid", "Madrid", "Cádiz", 
"Cádiz"), municipio = c("Alacantí", "Zona Suroeste", "Valencia, Zona de", 
"Campo de Gibraltar", "Maresme", "Madrid, Zona de", "Levante Almeriense", 
"Sevilla capital y entorno", "Baix Penedès", "Bahía de Cádiz", 
"Bahía de Cádiz", "Zaragoza, Zona de", "Costa del Sol Occidental - Zona de Estepona", 
"Bahía de Cádiz", "Vega Baja", "Barcelonès", "La Safor", "Córdoba, Zona de", 
"Bahía de Cádiz", "Madrid, Zona de", "Anoia", "Madrid, Zona de", 
"Costa del Sol Occidental - Zona de Estepona", "Donostialdea - Oarsoldea", 
"Madrid Sureste - Cuenca Tajuña", "La Selva", "Tarragonès", 
"Tarragonès", "Jaén capital y entorno", "Garraf", "Tarragonès", 
"Tarragonès", "Tarragonès", "Tarragonès", "Vega de Granada", 
"Vega de Granada", "Tarragonès", "Baix Camp", "Madrid, Zona de", 
"Baix Camp", "Comarca de Vigo", "Baix Camp", "Costa del Sol Occidental - Zona de Estepona", 
"Alacantí", "Baix Camp", "El Bierzo", "Marina Baixa", "La Safor", 
"Costa del Sol Occidental - Zona de Benalmádena", "La Mesa de Ocaña", 
"Costa del Sol Occidental - Zona de Estepona", "Baix Camp", "Vega de Granada", 
"Alacantí", "Zona Noroeste", "Costa del Sol Occidental - Zona de Benalmádena", 
"Poniente Almeriense", "Zona Sur de Madrid", "Madrid, Zona de", 
"Bahía de Cádiz", "Campo de Gibraltar")), row.names = c(NA, 
-61L), class = c("tbl_df", "tbl", "data.frame"))

我需要创建一组联动下拉框：

1. 第一个下拉框选择provincia（省份）
2. 第二个下拉框自动过滤出该省份对应的所有municipio（市镇）并显示

我尝试了两次Shiny开发，但都没成功，代码如下：

第一次尝试代码 #

library(shiny)

main = unique(data$provincia)

data %>% 
  filter(provincia == "Madrid")
####################################################################################################
ui <- fluidPage(
  selectInput("MAIN", "Select the MAIN region", choices = main),
  selectInput("subMAIN", "Select the sub-MAIN region", choices = output$filteredMAIN)
    
)


server <- function(input, output) {
  eventReactive({
    filteredMAIN = data %>% 
      filter(provincia == .data[[input$MAIN]]) %>% 
      select(municipio) %>% 
      distinct() %>% 
      pull()
  })
}


shinyApp(ui = ui, server = server)

第二次尝试代码 #

library(shiny)

data = read_csv("/run/media/bscuser/A34E-C6B8/inmobiliarioProject2/comprar/propertyPageData/propertyData_2022_09_26.csv") %>% 
  select(geoLocationName) %>% 
  separate(
    col = geoLocationName,
    into = c("provincia", "municipio", "distrito", "zona"),
    sep = "\\|"
  ) %>% 
  drop_na()
####################################################################################################


ui <-  fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("MAIN", label = "Select MAIN Data", choices = unique(data$provincia)),
      selectInput("select_var", label = "Select Variable", choices = output$varnames )
    )
    # mainPanel(
    #   tableOutput("table")
    #)
  )
)

server <- function(input, output, session) {
  
  observeEvent(input$MAIN,{
    updateSelectInput(session, "select_var", choices = names(input$select_data))
    
  })
  
  output$varnames <- reactive({
    filteredMAIN = data %>% 
      filter(provincia == .data[[input$MAIN]]) %>% 
      select(municipio) %>% 
      distinct() %>% 
      pull()
  })
  
  # output$table <- renderTable({
  #   head(varnames[[input$select_var]])
  # })
}


shinyApp(ui = ui, server = server)

问题分析 #

你的两次尝试都存在关键错误：

• 第一次尝试：
  1. eventReactive未指定触发事件，也未将结果赋值给可访问对象
  2. UI中直接用output$filteredMAIN作为下拉框选项是错误的，Shiny无法在UI中直接引用输出对象作为输入选项
• 第二次尝试：
  1. observeEvent里用names(input$select_data)错误，input$select_data不存在，应使用过滤后的市镇列表
  2. UI中同样错误地直接引用output$varnames作为选项

正确解决方案 #

实现联动下拉框的核心是：用observeEvent监听第一个下拉框的变化，再用updateSelectInput动态更新第二个下拉框的选项，同时正确生成过滤后的市镇列表。

以下是修正后的完整代码：

library(shiny)
library(dplyr)

# 你的数据集
data = structure(list(provincia = c("Alicante", "Madrid", "Valencia", 
"Cádiz", "Barcelona", "Madrid", "Almería", "Sevilla", "Tarragona", 
"Cádiz", "Cádiz", "Zaragoza", "Málaga", "Cádiz", "Alicante", 
"Barcelona", "Valencia", "Córdoba", "Cádiz", "Madrid", "Barcelona", 
"Madrid", "Málaga", "Gipuzkoa", "Madrid", "Girona", "Tarragona", 
"Tarragona", "Jaén", "Barcelona", "Tarragona", "Tarragona", 
"Tarragona", "Tarragona", "Granada", "Granada", "Tarragona", 
"Tarragona", "Madrid", "Tarragona", "Pontevedra", "Tarragona", 
"Málaga", "Alicante", "Tarragona", "León", "Alicante", "Valencia", 
"Málaga", "Toledo", "Málaga", "Tarragona", "Granada", "Alicante", 
"Madrid", "Málaga", "Almería", "Madrid", "Madrid", "Cádiz", 
"Cádiz"), municipio = c("Alacantí", "Zona Suroeste", "Valencia, Zona de", 
"Campo de Gibraltar", "Maresme", "Madrid, Zona de", "Levante Almeriense", 
"Sevilla capital y entorno", "Baix Penedès", "Bahía de Cádiz", 
"Bahía de Cádiz", "Zaragoza, Zona de", "Costa del Sol Occidental - Zona de Estepona", 
"Bahía de Cádiz", "Vega Baja", "Barcelonès", "La Safor", "Córdoba, Zona de", 
"Bahía de Cádiz", "Madrid, Zona de", "Anoia", "Madrid, Zona de", 
"Costa del Sol Occidental - Zona de Estepona", "Donostialdea - Oarsoldea", 
"Madrid Sureste - Cuenca Tajuña", "La Selva", "Tarragonès", 
"Tarragonès", "Jaén capital y entorno", "Garraf", "Tarragonès", 
"Tarragonès", "Tarragonès", "Tarragonès", "Vega de Granada", 
"Vega de Granada", "Tarragonès", "Baix Camp", "Madrid, Zona de", 
"Baix Camp", "Comarca de Vigo", "Baix Camp", "Costa del Sol Occidental - Zona de Estepona", 
"Alacantí", "Baix Camp", "El Bierzo", "Marina Baixa", "La Safor", 
"Costa del Sol Occidental - Zona de Benalmádena", "La Mesa de Ocaña", 
"Costa del Sol Occidental - Zona de Estepona", "Baix Camp", "Vega de Granada", 
"Alacantí", "Zona Noroeste", "Costa del Sol Occidental - Zona de Benalmádena", 
"Poniente Almeriense", "Zona Sur de Madrid", "Madrid, Zona de", 
"Bahía de Cádiz", "Campo de Gibraltar")), row.names = c(NA, 
-61L), class = c("tbl_df", "tbl", "data.frame"))

ui <- fluidPage(
  selectInput("provincia", "选择省份", choices = unique(data$provincia)),
  selectInput("municipio", "选择市镇", choices = NULL)  # 初始为空，后续动态更新
)

server <- function(input, output, session) {
  
  # 监听省份选择变化，更新市镇下拉框
  observeEvent(input$provincia, {
    # 过滤当前省份对应的市镇，去重后转为向量
    filtered_municipios <- data %>%
      filter(provincia == input$provincia) %>%
      distinct(municipio) %>%
      pull(municipio)
    
    # 更新第二个下拉框的选项
    updateSelectInput(session, "municipio", choices = filtered_municipios)
  })
  
  # 可选：初始化时显示第一个省份的市镇
  observe({
    # 应用启动时，自动触发一次省份选择的更新
    updateSelectInput(session, "provincia", selected = unique(data$provincia)[1])
  })
}

shinyApp(ui = ui, server = server)

代码说明 #

1. UI部分：第二个下拉框初始choices = NULL，无需提前绑定输出对象，后续通过服务器端动态更新。
2. Server部分：
   • observeEvent(input$provincia, {...})：监听省份下拉框的变化事件，用户选择新省份时执行内部代码。
   • 内部代码过滤出当前省份对应的所有市镇，去重后转为向量，再用updateSelectInput更新第二个下拉框的选项。
   • 额外添加的observe块用于初始化，确保应用启动时第二个下拉框自动显示第一个省份的市镇。

这样就能实现完全联动的下拉框效果，选择省份后，市镇下拉框会自动更新为对应选项。

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