如何在Shiny中用patchwork保持多图固定尺寸或全屏高度？

问题概述 #

在Shiny应用中使用patchwork生成多用户自定义图表时，随着选择的X变量数量增加，单张图表会被逐步压缩变小。需要实现两种效果之一：

• 每张图表保持预定义的固定宽高
• 整体图表区域高度自适应占满100%可用空间

原实现代码及问题现象如下：

原代码 #

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

plt_func <- function(x,y){
  plt_list <- list()
  for (X_var in x){
    plt_list[[X_var]] <- mtcars %>% ggplot(aes_string(X_var, y))+
      geom_point() + 
      labs(x = X_var, y = y)
  }
  
  if (length(plt_list) == 1) {
    return(plt_list[[1]])
  } else {
    patchwork::wrap_plots(plt_list, ncol = min(length(plt_list), 2)) %>% print(.)
  }
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel( 
      selectInput(inputId = "dataset", label = "Choose a dataset:", choices = c("mtcars")),
      selectizeInput(inputId = "x", label = "X", choices = names(mtcars), multiple = T),
      selectInput(inputId = "y", label = "Y", choices = names(mtcars), multiple = F),
      selectInput(inputId = "t", label = "Treatment", choices = names(mtcars), multiple = F),
      actionButton("plot", label = "Plot")
    ),
    mainPanel(plotOutput("plots"))
  )
)

server <- function(input, output, session) {
  observeEvent(input$plot, {
    req(input$x, input$y)
    output$plots <- renderPlot({plt_func(input$x, input$y)})
  })
}

shinyApp(ui, server)

问题现象 #

• 2张图表时尺寸正常：
  
• 6张图表时单图被严重压缩：
  

解决方案 #

方案1：固定单图尺寸 #

通过给每个ggplot设置固定宽高比，同时动态计算renderPlot的输出高度，确保每张图的展示空间一致。

修改后的核心代码：

# 调整绘图函数，给每个图表设置固定宽高比
plt_func <- function(x,y){
  plt_list <- list()
  for (X_var in x){
    plt_list[[X_var]] <- mtcars %>% ggplot(aes_string(X_var, y))+
      geom_point() + 
      labs(x = X_var, y = y) +
      theme(aspect.ratio = 1.2)  # 自定义宽高比，比如1.2:1
  }
  
  if (length(plt_list) == 1) {
    plt_list[[1]]
  } else {
    patchwork::wrap_plots(plt_list, ncol = min(length(plt_list), 2))
  }
}

# 修改server部分，动态计算输出高度
server <- function(input, output, session) {
  observeEvent(input$plot, {
    req(input$x, input$y)
    n_plots <- length(input$x)
    n_rows <- ceiling(n_plots / 2)  # 按2列排列，计算行数
    
    output$plots <- renderPlot({
      plt_func(input$x, input$y)
    }, height = function() {
      n_rows * 450  # 每张图固定高度450px，总高度=行数*单图高度
    })
  })
}

方案2：整体高度自适应占满空间 #

通过CSS设置图表容器占满页面剩余空间，结合Shiny客户端数据动态调整输出高度，让图表区域始终占满可用空间。

修改后的UI和server代码：

ui <- fluidPage(
  # 添加CSS让主面板和图表占满空间
  tags$style(HTML("
    .main-panel {
      height: calc(100vh - 90px);  # 减去侧边栏和顶部导航的高度
      padding: 0;
    }
    #plots {
      height: 100% !important;
    }
  ")),
  sidebarLayout(
    sidebarPanel( 
      selectInput(inputId = "dataset", label = "Choose a dataset:", choices = c("mtcars")),
      selectizeInput(inputId = "x", label = "X", choices = names(mtcars), multiple = T),
      selectInput(inputId = "y", label = "Y", choices = names(mtcars), multiple = F),
      selectInput(inputId = "t", label = "Treatment", choices = names(mtcars), multiple = F),
      actionButton("plot", label = "Plot")
    ),
    mainPanel(class = "main-panel", plotOutput("plots", height = "auto"))
  )
)

server <- function(input, output, session) {
  observeEvent(input$plot, {
    req(input$x, input$y)
    
    output$plots <- renderPlot({
      plt_func(input$x, input$y)
    }, height = function() {
      # 基于客户端容器高度动态调整，留5%边距
      session$clientData$output_plots_height * 0.95
    })
  })
}

补充说明 #

• 方案1适合需要严格控制单图比例和大小的场景，确保所有图表展示效果一致。
• 方案2适合追求页面空间利用率的场景，图表会自动填充剩余的页面高度。
• 可以结合patchwork::plot_layout(heights = c(...))参数，对不同行的高度进行更精细的分配。

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