Удалить дубликаты ярлыков в легенде ggplot

Question

Я хотел бы создать сюжет с подгруппами в легенде, используя взаимодействие. Я создаю некоторые поддельные данные с нулевыми значениями для создания подзаголовка.

Мои образцы данных:

library(ggplot2)
df <- data.frame(value = runif(27, 0, 1),
                 x = rep(1:3, each = 3),
                 group1 = rep(c(letters[1:3])),
                 group2 = rep(c("fake", "X", "Y"), each = 9))
# introducing fake data
df[df$group2 == "fake", "value"] <- 0
df$group2 <- relevel(df$group2, ref = "fake")

Мне почти удалось создать нужный сюжет:

# labels
lbl1 <- c(expression(bold("HEADING 1")), paste("LABEL 1", 1:2),
          expression(bold("HEADING 2")), paste("LABEL 2", 1:2),
          expression(bold("HEADING 3")), paste("LABEL 3", 1:2))
fills <- c("white", "red1", "red3",
           "white", "blue1", "blue3",
           "white", "green1", "green3")
colo <- c("white", "black", "black",
          "white", "black", "black",
          "white", "black", "black")

ggplot(df, aes(x = x, y = value,
               fill = interaction(group2, group1), 
               colour = interaction(group2, group1))) +
  geom_col(position = "dodge") +
  scale_fill_manual("", values = fills, label = lbl1)  +
  scale_colour_manual("", values = colo, label = lbl1)

Однако я не хочу, чтобы в подгруппах были LABEL 1 1 и LABEL 1 2 и т. Д. Я хотел бы иметь только LABEL 1 и LABEL 2.

Мне не удалось создать такой график при указании таких меток:

lbl2 <- c(expression(bold("HEADING 1")), paste("LABEL", 1:2),
          expression(bold("HEADING 2")), paste("LABEL", 1:2),
          expression(bold("HEADING 3")), paste("LABEL", 1:2))

ggplot(df, aes(x = x, y = value,
               fill = interaction(group2, group1), 
               colour = interaction(group2, group1))) +
  geom_col(position = "dodge") +
  scale_fill_manual("", values = fills, label = lbl2)  +
  scale_colour_manual("", values = colo, label = lbl2)

Если быть точным, это желаемый вывод:

Answer 1

У вас есть неуникальные метки, потому что вы вводите фальшивую группу для разделения столбцов на вашем графике. По справке discrete_scale:

Вектор символов, дающий метки (должен быть такой же длины, что и разрывы)

Код масштаба, вероятно, вызывает unique к символьному вектору, и в итоге получается вектор с меньшим количеством меток, чем разрывов, что приводит к странным легендам.

Похоже, вы должны использовать фасеты для получения похожих результатов вместо взлома (поддельная группа):

# Remove the "fake" group 2
df1 <- df[df$group2 != "fake",]

ggplot(df1, aes(x = group1, y = value, fill=group2)) +
    geom_col(position = "dodge", color ="black")+
    scale_fill_manual( values =c("red","green"),labels = c("Lable 1", "Lable 2")) +
    scale_x_discrete(labels =c("H1", "H2", "H3")) +
    facet_wrap(x~., strip.position = "bottom")

Если вы действительно хотите получить точный график, вам придется изменить метки, модифицирующие gtable, используя больше хаков:

library(grid)

fills <- c("white", "red1", "red3",
           "white", "blue1", "blue3",
           "white", "green1", "green3")
# You need the lbl1 in order to get the legend correct placed since it needs
# size of labels.
lbl1 <- c(expression(bold("HEADING 1")), paste("LABEL 1", 1:2),
          expression(bold("HEADING 2")), paste("LABEL 2", 1:2),
          expression(bold("HEADING 3")), paste("LABEL 3", 1:2))
lbl2 <- c(expression(bold("HEADING 1")), paste("LABEL", 1:2),
          expression(bold("HEADING 2")), paste("LABEL", 1:2),
          expression(bold("HEADING 3")), paste("LABEL", 1:2))
 colo <- c("white", "black", "black",
         "white", "black", "black",
         "white", "black", "black")



p <- ggplot(df, aes(x = x, y = value,
                fill = interaction(group2, group1),
                color = interaction(group2, group1))) +
    geom_col(position = "dodge") +
    scale_fill_manual("",values = fills, labels=lbl1)  +
    scale_color_manual("",values = colo, labels=lbl1)

gt <- ggplotGrob(p)

gt
#TableGrob (12 x 11) "layout": 19 grobs
#z         cells       name                                            grob
#1   0 ( 1-12, 1-11) background               rect[plot.background..rect.16164]
# ...
#14 13 ( 7- 7, 7- 7)     ylab-r                                  zeroGrob[NULL]
#15 14 ( 7- 7, 9- 9)  guide-box                               gtable[guide-box]
#16 15 ( 4- 4, 5- 5)   subtitle         zeroGrob[plot.subtitle..zeroGrob.16160]
# ...

# We want the item 15 guide-box
gt$grobs[[15]]$grobs
#21 21 ( 4- 4, 4- 4)   label-3-3             gTree[GRID.gTree.11993]
#22 22 ( 5- 5, 4- 4)   label-4-3             gTree[GRID.gTree.11994]
#23 23 ( 6- 6, 4- 4)   label-5-3             gTree[GRID.gTree.11995]
#24 24 ( 7- 7, 4- 4)   label-6-3             gTree[GRID.gTree.11996]
#25 25 ( 8- 8, 4- 4)   label-7-3             gTree[GRID.gTree.11997]
#26 26 ( 9- 9, 4- 4)   label-8-3             gTree[GRID.gTree.11998]
#27 27 (10-10, 4- 4)   label-9-3             gTree[GRID.gTree.11999]
#28 28 (11-11, 4- 4)  label-10-3             gTree[GRID.gTree.12000]
#29 29 (12-12, 4- 4)  label-11-3             gTree[GRID.gTree.12001]

# Items 21 to 29 are labels, replace the labels with the ones we want.
for(i in 1:9)
{
  gt$grobs[[15]]$grobs[[1]]$grobs[[20 +i]]$children[[1]]$children[[1]]$label <- lbl2[i]

}
# New plot
grid.draw(gt)

Answer 2

Следующий пример почти представляет ваше последнее изображение, за исключением черных границ вокруг столбцов, но, может быть, вам все равно это хорошо?

lbl1 <- c(("HEADING 1"), paste("LABEL", 1:2),
          ("HEADING 2"), paste("LABEL", 1:2),
          ("HEADING 3"), paste("LABEL", 1:2))

fills <- c("white", "red1", "red3",
           "white", "blue1", "blue3",
           "white", "green1", "green3")

ggplot(df, aes(x = x, y = value,
               fill = interaction(group2, group1))) +
  geom_col(position = "dodge", show.legend = TRUE) +
  scale_fill_manual(values = fills, label = lbl1) +
  theme(legend.title = element_blank())