使用Shiny制作选择区域后自动更新的交互式条形图

library(dplyr)
library(ggplot2)
library(shiny)
library(shinyWidgets)

# 创建示例数据并预处理年龄区间排序
exampledata <- data.frame(City=c("London","Liverpool","Manchester",
                                 "Portsmouth","Liverpool","Leeds",
                                 "London","Manchester","Nottingham"),
                          Ageband = c("35 to 39","80+","40 to 44",
                                      "0 to 10","80+","35 to 39",
                                      "40 to 44","0 to 10", "80+"),
                          count = c(1200,800,520,
                                    300,105,630,
                                    410,150,700))

# 固定年龄区间的排序，按实际年龄从小到大设置有序因子水平，解决非等距区间排序错乱问题
exampledata$Ageband <- factor(exampledata$Ageband,
                              levels = c("0 to 10", "35 to 39", "40 to 44", "80+"),
                              ordered = TRUE)

# 提前定义配色方案，避免筛选后配色对应错乱
age_colors <- c("#CEE0F1", "#C3DAEE" ,"#B3D3E8" ,"#A2CBE2", "#8FC1DD" ,"#79B6D9" ,"#66AAD4" ,"#559FCD" ,"#4493C6", "#3686C0", "#2878B9","#1C69AF" ,"#1257A1" ,"#084594", "#05337d")

ui <- fluidPage(
  titlePanel("调研人群年龄分布"),
  selectInput("location", "选择区域", choices = unique(exampledata$City)),
  # 配置文本滑块为区间选择模式，默认选中全部年龄段
  sliderTextInput("age", "选择年龄区间", 
                  choices = levels(exampledata$Ageband),
                  selected = range(levels(exampledata$Ageband)),
                  grid = TRUE),
  plotOutput("bar")
)

server <- function(input, output, session) {
  # 响应式数据集，同时绑定两个输入控件的筛选条件
  filtered_data <- reactive({
    # 获取选中年龄段的覆盖范围
    all_age_levels <- levels(exampledata$Ageband)
    start_pos <- which(all_age_levels == input$age[1])
    end_pos <- which(all_age_levels == input$age[2])
    target_ages <- all_age_levels[start_pos:end_pos]
    
    exampledata %>%
      filter(City == input$location, Ageband %in% target_ages)
  })
  
  output$bar <- renderPlot({
    req(filtered_data()) # 等待数据加载完成再绘图，避免启动时报错
    ggplot(filtered_data(), aes(fill=Ageband, y=count, x=Ageband)) + 
      geom_bar(position="dodge", stat="identity", show.legend = FALSE) +
      labs(y="参与人数", x=" ",
           caption=paste0("抽样参与总人数 = ", sum(filtered_data()$count)))+
      scale_fill_manual(name="年龄", values=age_colors, drop = FALSE) +
      theme(plot.title = element_text(hjust = 0.5),
            axis.text.x = element_text(angle = 90))
  })
}

shinyApp(ui = ui, server = server)

• 修正了原代码基础语法错误：补全UI控件间的逗号，删除server多余的闭合大括号，修正输入输出ID的对应关系（原代码UI中城市选择控件ID为location，server误写为input$City；输出图表ID为bar，server误写为output$plot）
• 对年龄段字段做了有序因子转换，固定排序逻辑，适配非等距年龄区间的展示需求
• 给文本滑块添加了区间选择配置，支持拖拽选择起止年龄段，自动匹配选中范围内的所有年龄区间
• 响应式数据集同时绑定区域、年龄区间两个输入控件，筛选后的数据直接用于绘图
• 在配色配置中添加drop=FALSE参数，避免筛选掉部分年龄段后出现配色对应错乱的问题
• 增加req()判断，避免Shiny应用启动时数据未加载完成导致的报错

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