Shiny R中基于前置输入动态更新选择输入的实现问题

你的代码核心问题在于从数据框提取选项时返回的是数据框而非向量，updateSelectInput需要接收字符/数值向量作为choices参数，而非数据框。另外初始状态下需要确保筛选器有默认值，避免后续逻辑出错。以下是修正后的完整代码及关键改动说明：

关键改动点 #

• 用dplyr::pull()替代select()提取单列数据为向量，确保updateSelectInput能正确识别选项
• 为type_var和name_var添加排序逻辑，让选项更规整
• 初始加载时自动选中第一个城市，并同步更新后续筛选器的初始选项
• 优化响应式依赖，确保城市、类型变化时，后续筛选器能联动更新

修正后的代码 #

library(shiny)
library(shinythemes)
library(dplyr)
library(tidyr)
library(readxl)
library(ggplot2) # 补充加载ggplot2，原代码中使用但未加载

data <-  read_excel("foreign_students_by_nationality_2021_2022.xlsx")
colnames(data) <- c("name", "type", "city", "country", "male", "female", "total")
data$male <- as.numeric(data$male)
data$female <- as.numeric(data$female)
data$total <- as.numeric(data$total)

# Define UI for application that draws a histogram
ui <- fluidPage(
    titlePanel("Foreign Students in Turkish Universities"),
    theme = shinythemes::shinytheme("superhero"),
    sidebarLayout(
        sidebarPanel(
            selectInput("uni_city",
                        "Select a City",
                        choices = data$city %>% unique() %>% sort(),
                        selected = data$city %>% unique() %>% sort() %>% first() # 默认选中第一个城市
                          ),
            selectInput("uni_type", 
                        "Select a University Type", 
                        choices = ""
                        ),
            selectInput("uni_name", 
                        "Select a University", 
                        choices = ""
                        )
        ),
        mainPanel(
           plotOutput("barplot")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  
  # 提取当前城市对应的院校类型（返回向量）
  type_var <- reactive({
    data %>% 
      filter(city == input$uni_city) %>% 
      pull(type) %>% 
      unique() %>% 
      sort()
  })
    
  # 更新院校类型筛选器
  observe({
    updateSelectInput(session, "uni_type", 
                      choices = type_var(),
                      selected = type_var() %>% first()) # 默认选中第一个类型
  })
  
  # 提取当前城市+类型对应的院校名称（返回向量）
  name_var <- reactive({
    req(input$uni_type) # 确保类型选择后再执行
    data %>% 
      filter(city == input$uni_city, type == input$uni_type) %>% 
      pull(name) %>% 
      unique() %>% 
      sort()
  })
  
  # 更新院校名称筛选器
  observe({
    updateSelectInput(session, "uni_name", 
                      choices = name_var(),
                      selected = name_var() %>% first()) # 默认选中第一个院校
  })
  
  output$barplot <- renderPlot({
    req(input$uni_name) # 确保院校选择后再绘制图表
    
    highest_country <- 
      data %>% 
      filter(city == input$uni_city,
             type == input$uni_type,
             name == input$uni_name) %>% 
      group_by(country) %>% 
      summarise(female = sum(female, na.rm = TRUE), 
                male = sum(male, na.rm = TRUE), 
                total = sum(total, na.rm = TRUE)) %>% 
      arrange(desc(total)) %>% 
      pivot_longer(c(-country, -total), names_to = "gender", values_to = "value") %>% 
      slice_max(total, n = 20)
    
    ggplot(highest_country, 
           aes(x = reorder(country, total), 
               y = value, 
               fill = gender)
    ) +
      geom_col() +
      coord_flip() + 
      labs(x = "Nationality", y = "Number of Students") +
      theme_minimal()
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

额外优化说明 #

• 添加req()函数确保依赖项存在后再执行逻辑，避免空值报错
• 为所有筛选器添加默认选中项，提升用户体验
• 补充加载ggplot2包（原代码中使用ggplot但未显式加载）
• 在汇总函数中添加na.rm = TRUE处理缺失值，避免计算错误

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