求助：基于Shiny模块实现按选中季节生成堆叠ggplot图表

核心实现思路 #

• 通过响应式逻辑筛选选中季节的数据，拆分为按季节分组的数据集列表
• 遍历列表为每个季节生成独立的ggplot图表
• 使用gridExtra或patchwork包将多个图表垂直堆叠排列

完整可运行代码 #

样本数据 #

sample_data <- data.frame(
  Season = rep(c("Spring", "Summer", "Autumn", "Winter"), each = 10),
  Category = rep(c("A", "B"), 20),
  Value = rnorm(40, mean = 50, sd = 10)
)

Shiny应用代码 #

library(shiny)
library(ggplot2)
library(gridExtra)

ui <- fluidPage(
  titlePanel("季节数据堆叠图表"),
  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId = "selected_seasons",
        label = "选择要展示的季节",
        choices = unique(sample_data$Season),
        multiple = TRUE,
        selected = c("Spring", "Summer")
      )
    ),
    mainPanel(
      uiOutput("season_plots_container")
    )
  )
)

server <- function(input, output) {
  # 响应式生成按季节分组的数据集列表
  season_data_list <- reactive({
    req(input$selected_seasons)
    target_data <- sample_data[sample_data$Season %in% input$selected_seasons, ]
    split(target_data, target_data$Season)
  })

  # 生成并排列图表
  output$season_plots_container <- renderUI({
    # 为每个季节创建ggplot
    plot_list <- lapply(names(season_data_list()), function(season) {
      ggplot(season_data_list()[[season]], aes(x = Category, y = Value, fill = Category)) +
        geom_col() +
        ggtitle(glue::glue("{season} 数据")) +
        theme_minimal() +
        theme(plot.title = element_text(hjust = 0.5))
    })

    # 渲染堆叠的图表，ncol=1实现垂直排列
    renderPlot({
      do.call(grid.arrange, c(plot_list, ncol = 1))
    })
  })
}

shinyApp(ui, server)

关键细节说明 #

• req(input$selected_seasons)：确保下拉框有选中值时才执行后续逻辑，避免空输入引发错误
• split()：将筛选后的数据按季节拆分为列表，每个元素对应单个季节的数据集
• lapply()：遍历列表自动生成对应数量的图表，选中n个季节就生成n张图
• do.call(grid.arrange, ...)：动态传递所有图表对象，自动完成堆叠，无需手动逐个添加

模块改造方案（若使用模块） #

如果需要用模块封装图表逻辑，可参考以下代码：

# 定义图表模块
season_plot_mod <- function(id) {
  moduleServer(id, function(input, output, session, data, season) {
    output$plot <- renderPlot({
      ggplot(data, aes(x = Category, y = Value, fill = Category)) +
        geom_col() +
        ggtitle(glue::glue("{season} 数据")) +
        theme_minimal()
    })
  })
}

# 修改Server部分
server <- function(input, output) {
  season_data_list <- reactive({
    req(input$selected_seasons)
    target_data <- sample_data[sample_data$Season %in% input$selected_seasons, ]
    split(target_data, target_data$Season)
  })

  output$season_plots_container <- renderUI({
    season_names <- names(season_data_list())
    # 生成每个图表的UI输出
    plot_uis <- lapply(season_names, function(s) {
      plotOutput(paste0("plot_", s))
    })

    # 调用模块生成每个图表
    lapply(season_names, function(s) {
      season_plot_mod(paste0("plot_", s))(
        data = season_data_list()[[s]],
        season = s
      )
    })

    # 返回UI列表实现堆叠
    tagList(plot_uis)
  })
}

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