Недавно я пытался аннотировать график с помощью полей над 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 1n","Phase 2n","Phase 3n"),
                         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 но без какой-либо удачи.

Альтернативным подходом для достижения желаемого результата было бы создание аннотаций с помощью второго 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 1n","Phase 2n","Phase 3n"),
                         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))
  

Установив вторую ось x и заполнив фон меток новой оси element_markdown из ggtext пакета. Вы можете добиться этого:

Вот код:

 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 1n","Phase 2n","Phase 3n"),
                         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')