如何将Shiny App的滑块时间选择改为预设周数下拉选择？

核心修改思路 #

把原滑块组件替换为selectInput下拉选择框，通过选项对应数值来匹配时间范围，再在Server端根据选中值筛选数据。

修改后完整代码 #

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

# 模拟176周的发病率数据（替换成你的真实数据即可）
set.seed(123)
data <- tibble(
  week = 1:176,
  incidence = rnorm(176, mean = 5, sd = 1) + seq(0, 3, length.out = 176)
)

ui <- fluidPage(
  titlePanel("发病率趋势图"),
  sidebarLayout(
    sidebarPanel(
      # 替换滑块为下拉选择框
      selectInput("time_range", "选择时间范围:",
                  choices = list(
                    "前4周" = 4,
                    "前8周" = 8,
                    "前12周" = 12,
                    "前16周" = 16,
                    "全周期（176周）" = 176
                  ),
                  selected = 4) # 默认选中前4周
    ),
    mainPanel(
      plotOutput("trend_plot")
    )
  )
)

server <- function(input, output) {
  # 根据选中的时间范围筛选数据
  filtered_data <- reactive({
    req(input$time_range)
    selected_weeks <- as.integer(input$time_range)
    max_week <- max(data$week)
    
    # 全周期返回所有数据，其余取最近N周
    if (selected_weeks == 176) {
      data
    } else {
      data %>% filter(week >= (max_week - selected_weeks + 1))
    }
  })
  
  # 生成趋势图
  output$trend_plot <- renderPlot({
    filtered_data() %>%
      ggplot(aes(x = week, y = incidence)) +
      geom_line(color = "steelblue", linewidth = 1) +
      labs(x = "周数", y = "发病率", title = "发病率趋势") +
      theme_minimal()
  })
}

shinyApp(ui, server)

关键说明 #

1. UI组件替换：用selectInput替代滑块，通过choices参数设置显示文本与对应周数的映射，用户看到的是友好的文本选项，程序实际拿到的是对应数字。
2. 数据筛选逻辑：
   • 用req()确保输入有效后再执行筛选，避免空值报错
   • 针对「全周期」做特殊判断，直接返回全部数据；其他选项计算最近N周的起始周数，筛选对应区间的数据
3. 适配真实数据：把示例中的模拟数据替换成你的实际数据集，确保数据包含week（周数列）和incidence（发病率列）即可。

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