在R Shiny Dashboard中创建动态数量的图表

要实现第二行图表数量随第一行选择动态变化的功能，核心是利用Shiny的动态UI生成能力，通过uiOutput和renderUI动态创建子图表容器，再配合observeEvent绑定绘图输出。以下是修改后的完整代码：

library(shiny)
library(shinydashboard)
library(ggplot2)
library(magrittr)

# 定义主指标与对应子指标的映射关系
metric_sub_map <- list(
  mpg = c("drat", "wt", "qsec"),
  cyl = c("gear", "carb"),
  hp = c("wt", "drat"),
  wt = c("mpg", "qsec")
)

ui <- dashboardPage(
  skin = "yellow",
  dashboardHeader(title = "My dashboard"),
  dashboardSidebar(
    sidebarMenu()
  ),
  dashboardBody(
    fluidRow(
      box(title = "Primary Metric:", status = "primary", solidHeader = T, plotOutput("CPlot"), width = 7),
      box(selectInput("metric", 
                      "Metric:", 
                      c("mpg",  "cyl", "hp", "wt")),  
          width = 3
      )
    ),
    # 替换静态子图表行，改为动态生成的UI容器
    uiOutput("subplotsRow")
  )
)


server <- function(input, output){
  data <- mtcars # 替换为你的实际数据集
  
  # 封装直方图绘制逻辑，复用代码
  make_hist_plot <- function(var_name) {
    ggplot(data, aes(x = .data[[var_name]])) +
      geom_histogram(fill="#D55E00", color="#e9ecef", alpha=0.9) +
      labs(
        title = paste0("Distribution of ", var_name, " over the last 12 month"),
        x = var_name,
        y = "Count") +
      theme_minimal()
  }
  
  # 主图表输出
  output$CPlot <- renderPlot({
    make_hist_plot(input$metric)
  }) %>% bindEvent(input$metric)
  
  # 动态生成子图表的UI行
  output$subplotsRow <- renderUI({
    sub_metrics <- metric_sub_map[[input$metric]]
    # 自动计算每个子图表容器的宽度，确保铺满一行
    box_width <- 12 / length(sub_metrics)
    
    # 循环生成每个子图表的box
    sub_boxes <- lapply(seq_along(sub_metrics), function(i) {
      current_var <- sub_metrics[i]
      box(
        title = paste0("Sub-Metric", i), 
        width = box_width,  
        status = "warning", 
        solidHeader = T, 
        plotOutput(paste0("subPlot_", current_var))
      )
    })
    
    fluidRow(sub_boxes)
  }) %>% bindEvent(input$metric)
  
  # 动态绑定子图表的输出
  observeEvent(input$metric, {
    sub_metrics <- metric_sub_map[[input$metric]]
    lapply(sub_metrics, function(var) {
      output[[paste0("subPlot_", var)]] <- renderPlot({
        make_hist_plot(var)
      })
    })
  })
}

shinyApp(ui = ui, server = server)

关键改动说明 #

• 指标映射表：用metric_sub_map明确每个主指标对应的子指标集合，方便后续动态调用。
• 动态UI容器：用uiOutput("subplotsRow")替代原来的静态fluidRow，在服务器端根据当前选择的主指标生成对应数量的子图表容器。
• 复用绘图逻辑：将直方图绘制代码封装成make_hist_plot函数，避免重复编写相同代码。
• 动态输出绑定：通过observeEvent监听主指标的变化，循环为每个子指标创建对应的renderPlot输出，确保子图表正确显示对应变量的直方图。

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