在情节上方注释ggplot

Question

我最近尝试用 ggplot 上方的框来注释图表。 这是我想要的：

我找到了一种使用grid 的方法，但我觉得它太复杂了，而且我很确定有更好的方法可以做到这一点，对ggplot2 更友好。这是示例和我的解决方案：

数据：

y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
                         x2 = c(4,7,10),
                         politiquecat = c(1:3),
                         politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
                         y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
colorpal <- viridis::inferno(n=3,direction = -1)

情节

主要情节

p <- ggplot(data = mesure_pol) +
  geom_rect(aes(xmin = x1,
                xmax = x2,
                ymin = 0,
                ymax = 300,
                fill = as.factor(politiquecat)),
            fill = colorpal,
            color = "black",
            size = 0.3,
            alpha = 0.2)+
  theme(plot.margin=unit(c(60, 5.5, 5.5, 5.5), "points"))+
  coord_cartesian(clip = 'off')

注释部分

这是我不满意的部分：

for (i in 1:dim(mesure_pol)[1])  {
  
  text <- textGrob(label = mesure_pol[i,"politique"], gp = gpar(fontsize=7,fontface="bold"),hjust = 0.5)
  rg <- rectGrob(x = text$x, y = text$y, width = stringWidth(text$label) - unit(3,"mm") ,                 
                 height = stringHeight(text$label) ,gp = gpar(fill=colorpal[i],alpha = 0.3))
  p <- p + annotation_custom(
    grob = rg,
    ymin = mesure_pol[i,"y"],      # Vertical position of the textGrob
    ymax =  mesure_pol[i,"y"],    
    xmin = mesure_pol[i,"x_median"],         # Note: The grobs are positioned outside the plot area
    xmax = mesure_pol[i,"x_median"]) +
    annotation_custom(
      grob = text,
      ymin = mesure_pol[i,"y"],      # Vertical position of the textGrob
      ymax =  mesure_pol[i,"y"],    
      xmin = mesure_pol[i,"x_median"],         # Note: The grobs are positioned outside the plot area
      xmax = mesure_pol[i,"x_median"])
} 

有没有更简单/更好的方法来获得类似的结果？我尝试使用annotate、label，但没有任何运气。

Answer 1

实现所需结果的另一种方法是通过第二个 ggplot 进行注释，该 ggplot 可以通过例如粘贴到主图上。 patchwork.

对于注释图，我基本上将您的代码用于主图，添加了geom_text 层，通过theme_void 摆脱轴等，并根据主图设置限制。主要区别在于我将 y 轴限制为 0 到 1 的比例。除此之外，我改变了 xmin、xmax、ymin 和 ymax 值以在矩形周围添加一些空间（因此设置限制很重要）。

library(ggplot2)
library(patchwork)

y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
                         x2 = c(4,7,10),
                         politiquecat = c(1:3),
                         politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
                         y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
colorpal <- viridis::inferno(n=3,direction = -1)

p <- ggplot(data = mesure_pol) +
  geom_rect(aes(xmin = x1,
                xmax = x2,
                ymin = 0,
                ymax = 300,
                fill = as.factor(politiquecat)),
            fill = colorpal,
            color = "black",
            size = 0.3,
            alpha = 0.2)

ann <- ggplot(data = mesure_pol) +
  geom_rect(aes(xmin = x1 + 1,
                xmax = x2 - 1,
                ymin = 0.2,
                ymax = 0.8,
                fill = as.factor(politiquecat)),
            fill = colorpal,
            color = "black",
            size = 0.3,
            alpha = 0.2) +
  geom_text(aes(x = x_median, y = .5, label = politique), vjust = .8, fontface = "bold", color = "black") +
  coord_cartesian(xlim = c(1, 10), ylim = c(0, 1)) +
  theme_void()

ann / p  + 
  plot_layout(heights = c(1, 4))

Answer 2

通过设置第二个 x 轴并使用 ggtext 包中的 element_markdown 填充新轴标签的背景。你可以做到这一点：

代码如下：

library(ggtext)

y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
                         x2 = c(4,7,10),
                         politiquecat = c(1:3),
                         politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
                         y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2


p <- ggplot(data = mesure_pol) +
  geom_rect(aes(xmin = x1,
                xmax = x2,
                ymin = 0,
                ymax = 300,
                fill = as.factor(politiquecat)),
            fill = c("yellow", "red", "black"),
            color = "black",
            size = 0.3,
            alpha = 0.2) +
  scale_x_continuous(sec.axis = dup_axis(name = "",
                                         breaks = c(2.5, 5.5, 8.5),
                                         labels = c("Phase 1", "Phase 2", "Phase 3"))) +
  theme(plot.margin=unit(c(60, 5.5, 5.5, 5.5), "points"),
        axis.ticks.x.top = element_blank(),
        axis.text.x.top = element_markdown(face = "bold", 
                                  size = 12, 
                                  fill = adjustcolor(c("yellow", "red", "black"),
                                                              alpha.f = .2)))+
  coord_cartesian(clip = 'off')