如何用ggplot2制作带文本的色块栏，适配cowplot组合图用于Shiny？

需求说明 #

现有基于cowplot的垂直排列4个子图代码，需要实现：

• 用ggplot2制作独立的左侧色块标题图，每个色块高度与主图对应子图完全匹配
• 色块尺寸大于facet_wrap默认标题条，作为独立侧边标题
• 在Shiny应用中固定色块标题图，主图仅允许X轴滚动（不使用facet_wrap）

解决方案代码 #

1. 生成主图与色块标题图 #

library(ggplot2)
library(cowplot)

# 生成原垂直排列的子图列表
plot_list <- list()
plot_list[["P1"]] <- ggplot(mtcars, aes(x = mpg, y = drat)) + geom_point()
plot_list[["P2"]] <- ggplot(mtcars, aes(x = mpg, y = qsec)) + geom_point()
plot_list[["P3"]] <- ggplot(mtcars, aes(x = disp, y = drat)) + geom_point()
plot_list[["P4"]] <- ggplot(mtcars, aes(x = disp, y = qsec)) + geom_point()

# 组合主图（垂直排列）
main_plot <- plot_grid(plotlist = plot_list, ncol = 1)

# 创建色块标题图的数据：对应每个子图的标题、颜色、位置
title_data <- data.frame(
  label = c("组1", "组2", "组3", "组4"), # 自定义标题文本
  y = seq(3.75, 0.25, length.out = 4), # 对应4个子图的垂直中心位置
  fill = c("#E69F00", "#56B4E9", "#009E73", "#F0E442") # 自定义色块颜色
)

# 绘制色块标题图
title_plot <- ggplot(title_data, aes(y = y)) +
  # 绘制色块，高度对应子图占比
  geom_rect(aes(xmin = 0, xmax = 1, ymin = y - 0.45, ymax = y + 0.45, fill = fill)) +
  # 添加标题文本
  geom_text(aes(x = 0.5, label = label), color = "white", fontface = "bold", size = 5) +
  # 去掉所有轴元素和背景
  theme_void() +
  # 固定填充颜色，去掉图例
  scale_fill_identity() +
  # 调整内边距，保证和主图对齐
  theme(plot.margin = margin(5.5, 5.5, 5.5, 10)) +
  # 设置x轴范围，控制色块宽度
  xlim(0, 1)

# 组合标题图与主图，设置标题图宽度占比
combined_plot <- plot_grid(title_plot, main_plot, rel_widths = c(0.1, 0.9))

# 保存测试PDF
pdf(file="test_all.pdf", height=10, width=20)
print(combined_plot)
dev.off()

2. Shiny应用中实现固定标题+X轴滚动 #

library(shiny)

ui <- fluidPage(
  tags$style(
    HTML("
      .scroll-container {
        overflow-x: auto;
        overflow-y: hidden;
        display: flex;
        align-items: flex-start;
      }
      .fixed-title {
        flex-shrink: 0;
      }
    ")
  ),
  div(
    class = "scroll-container",
    div(class = "fixed-title", plotOutput("title_plot", height = "800px")),
    plotOutput("main_plot", height = "800px", width = "1800px") # 主图设置较大宽度触发滚动
  )
)

server <- function(input, output) {
  output$title_plot <- renderPlot({
    title_plot
  }, res = 96)
  
  output$main_plot <- renderPlot({
    main_plot
  }, res = 96)
}

shinyApp(ui, server)

关键说明 #

• 色块高度匹配：通过geom_rect的ymin/ymax参数精准控制每个色块的垂直范围，确保和主图子图高度完全对应
• 独立标题图：用theme_void()彻底去除ggplot的轴、背景元素，只保留色块和文本
• Shiny滚动实现：通过CSS的overflow-x: auto为主图容器添加水平滚动，flex-shrink: 0固定标题图宽度，避免被压缩

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