annotate ggplot above plot

Question

I tried lately to annotate a graph with boxes above a ggplot. Here is what I want:

I found a way using grid, but I find it too complicated, and I am quite sure there is a better way to do it, more ggplot2 friendly. Here is the example and my solution:

the data:

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)

plot

the main plot

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')

the annotation part

Here is the part I am not happy with:

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"])
} 

Is there a simplier/nicer way to obtain similar result ? I tried with annotate, label but without any luck.

Answer 1

By setting a second x-axis and filling the background of the new axis labels with element_markdown from the ggtext package. You may achieve this:

Here is the code:

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')

Answer 2

An alternative approach to achieve the desired result would be to make the annotations via a second ggplot which could be glued to the main plot via e.g. patchwork.

For the annotation plot I basically used your code for the main plot, added a geom_text layer, get rid of the axix, etc. via theme_void and set the limits in line with main plot. Main difference is that I restrict the y-axis to a 0 to 1 scale. Besides that I shifted the xmin, xmax, ymin and ymax values to add some space around the rectangels (therefore it is important to set the limits).

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))