r - 将文本添加到ggplot2中的图例颜色方 block

Question

我正在为一些 Likert 数据(沿着 these lines )制作一个发散条形图。客户要求每个组有一个“平均响应”，将 Likert 响应视为连续整数(“强烈不同意”= 1，“不同意”= 2 等)；这些平均值显示在条形顶部的“中性”区域中。

为了透明度，我想将每个 Likert 响应的数值添加到图例中。我可以将数字添加到标签中(例如，“强烈同意 (5)”)，但我更愿意将其放在颜色框的顶部(例如，在表示“强烈同意”的蓝色方 block 顶部)。

以下是生成发散条形图的代码:

library(dplyr)
library(ggplot2)
library(RColorBrewer)
# The data.
df = structure(list(group = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L),
                                  .Label = c("Group A", "Group B", "Group C"),
                                  class = "factor"),
                response = c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 5L, 5L, 5L),
                n = c(4, 8, 25, 8, 25, 29, 29, 35, 28, 25, 22, 12, 34, 10, 6),
                mean.response = c(3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5),
                response.fill = c("#CA0020", "#CA0020", "#CA0020",
                                  "#F4A582", "#F4A582", "#F4A582",
                                  "#F7F7F7", "#F7F7F7", "#F7F7F7",
                                  "#92C5DE", "#92C5DE", "#92C5DE",
                                  "#0571B0", "#0571B0", "#0571B0"),
                n.to.plot = c(4, 8, 25, 8, 25, 29, 14.5, 17.5, 14, 25, 22, 12, 34, 10, 6)),
           class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
           row.names = c(NA, -15L),
           groups = structure(list(group = structure(1:3, .Label = c("Group A", "Group B", "Group C"),
                                                     class = "factor"),
                                   .rows = list(c(1L, 4L, 7L, 10L, 13L),
                                                c(2L, 5L, 8L, 11L, 14L),
                                                c(3L, 6L, 9L, 12L, 15L))),
                              row.names = c(NA, -3L),
                              class = c("tbl_df", "tbl", "data.frame"),
                              .drop = TRUE))
# Groups, responses, and colors.
n.groups = 3
groups = paste("Group", LETTERS[1:n.groups])
likert.responses = c("Strongly disagree", "Disagree", "Neutral", "Agree", "Strongly agree")
pal = brewer.pal(length(likert.responses), "RdBu")
# Make the plot.
ggplot(data = df, aes(x = group, y = n.to.plot, fill = response.fill)) +
  # Start with the "agree" responses.
  geom_bar(data = df %>% filter(response >= 3),
           stat = "identity") +
  # Add the "disagree" responses going the opposite way.
  geom_bar(data = df %>%
             filter(response <= 3) %>%
             mutate(n.to.plot = n.to.plot * -1),
           stat = "identity") +
  # Add text labels with the mean response for each group.
  geom_text(data = df %>%
              dplyr::select(group, mean.response) %>%
              distinct(),
            aes(x = group, y = 0,
                label = format(mean.response, nsmall = 1),
                fill = NA)) +
  # Specify fill colors.
  scale_fill_identity("Response", breaks = pal, labels = likert.responses,
                      guide = "legend") +
  # Adjust axis labels.
  scale_x_discrete("") +
  scale_y_continuous("Number of responses") +
  # Swap x and y axes.
  coord_flip() +
  # Add the prompt text as the title.
  ggtitle("I like program XYZ.")

这是我想要的输出:

从 this answer 中汲取灵感，我尝试向填充图例添加 label 美学，但这没有任何作用:

+ guides(fill = guide_legend(override.aes = list(label = "foo")))

我知道我可以 customize the shape of the legend symbols ，但问题是我想要两件事:一个带有颜色的正方形，以及一个叠加在正方形上的黑色数字。

更新:自定义注释

@M-- 建议使用 annotation_custom，如 here 所述。为此，我需要弄清楚图例中的颜色框在哪里。这就是我被困住的地方；我可以找到这些框的格罗布，但我不知道如何将文本放在它们上面。

抓取其中一个颜色框(将上面的图保存为 g 后；在 this answer 的指导下):

gt = ggplot_gtable(ggplot_build(g))
gb = which(gt$layout$name == "guide-box")
box.grob = gt$grobs[[gb]]$grobs[[1]]$grobs[[3]]

box.grob$x 和 box.grob$y 都是 0.5npc；我尝试使用 geom_text_npc 添加标签，但标签位于绘图的中间。显然，我没有正确识别颜色框的位置(或者我没有将其正确转换为绘图坐标)。

library(ggpmisc)
g + geom_text_npc(aes(npcx = 0.5, npcy = 0.5, label = "foo"))

Answer 1

在这里稍微思考一下，您可以避免 custom_annotation 并使用您将数字添加到标签的想法，如下所示:

likert.responses = c("1   Strongly disagree", "2   Disagree", "3   Neutral", "4   Agree", "5   Strongly agree")

并稍微调整一下图例标签 element_text 的左边距:

guides(
  fill = guide_legend(label.theme = element_text(margin = margin(l = -18, unit = 'pt')))
)

这可以实现您想要的效果，并且具有在绘图更改大小时可以很好地缩放的优点，因为我们使用 pt 单位。

完整的可重现解决方案:

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(ggplot2)
library(RColorBrewer)
# The data.
df = structure(list(group = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L),
                                      .Label = c("Group A", "Group B", "Group C"),
                                      class = "factor"),
                    response = c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 5L, 5L, 5L),
                    n = c(4, 8, 25, 8, 25, 29, 29, 35, 28, 25, 22, 12, 34, 10, 6),
                    mean.response = c(3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5),
                    response.fill = c("#CA0020", "#CA0020", "#CA0020",
                                      "#F4A582", "#F4A582", "#F4A582",
                                      "#F7F7F7", "#F7F7F7", "#F7F7F7",
                                      "#92C5DE", "#92C5DE", "#92C5DE",
                                      "#0571B0", "#0571B0", "#0571B0"),
                    n.to.plot = c(4, 8, 25, 8, 25, 29, 14.5, 17.5, 14, 25, 22, 12, 34, 10, 6)),
               class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
               row.names = c(NA, -15L),
               groups = structure(list(group = structure(1:3, .Label = c("Group A", "Group B", "Group C"),
                                                         class = "factor"),
                                       .rows = list(c(1L, 4L, 7L, 10L, 13L),
                                                    c(2L, 5L, 8L, 11L, 14L),
                                                    c(3L, 6L, 9L, 12L, 15L))),
                                  row.names = c(NA, -3L),
                                  class = c("tbl_df", "tbl", "data.frame"),
                                  .drop = TRUE))
# Groups, responses, and colors.
n.groups = 3
groups = paste("Group", LETTERS[1:n.groups])
likert.responses = c("1   Strongly disagree", "2   Disagree", "3   Neutral", "4   Agree", "5   Strongly agree")
pal = brewer.pal(length(likert.responses), "RdBu")
# Make the plot.
ggplot(data = df, aes(x = group, y = n.to.plot, fill = response.fill)) +
  # Start with the "agree" responses.
  geom_bar(data = df %>% filter(response >= 3),
           stat = "identity") +
  # Add the "disagree" responses going the opposite way.
  geom_bar(data = df %>%
             filter(response <= 3) %>%
             mutate(n.to.plot = n.to.plot * -1),
           stat = "identity") +
  # Add text labels with the mean response for each group.
  geom_text(data = df %>%
              dplyr::select(group, mean.response) %>%
              distinct(),
            aes(x = group, y = 0,
                label = format(mean.response, nsmall = 1),
                fill = NA)) +
  # Specify fill colors.
  scale_fill_identity("Response", breaks = pal, labels = likert.responses,
                      guide = "legend") +
  # Adjust axis labels.
  scale_x_discrete("") +
  scale_y_continuous("Number of responses") +
  # Swap x and y axes.
  coord_flip() +
  # Add the prompt text as the title.
  ggtitle("I like program XYZ.") -> test
#> Warning: Ignoring unknown aesthetics: fill

test + guides(
  fill = guide_legend(label.theme = element_text(margin = margin(l = -18, unit = 'pt')))
)

^{由reprex package于2019年12月7日创建(v0.3.0)}