Question

考虑以下玩具示例

library(tibble)
library(ggplot2)
library(ggrepel)

df <- tribble(
    ~x,  ~y, ~name,            ~initials,
    0,   0,  "Hadley Wickam",    "HW",
    0,   1,  "Ross Ihaka",       "RI",
    1,   0,  "Robert Gentleman", "RG",
    1,   1,  "Yihui Xie",        "YX"
)

ggplot(df, aes(x, y, label = initials)) +
    geom_point() +
    geom_text_repel()

它显示一组带标签的点，其中标签是某些特定值的缩写。我想要做的是添加类似于通常的点形引导的缩写指南，但使用缩写而不是形状。

所以我想要达到这样的目的：

我知道当所有缩写都是单字母的情况下有一个解决方案，但不幸的是，这不是我的情况。

任何想法如何做到这一点？

Answer 1

不完美，但可能是一个起点。关键是要将initials和name对分配给无意义的aes（在此示例中使用fill，在其他情况下可能会很棘手），然后覆盖scale_*()中的关键表示。

在theme中进行一些调整可能会有用，特别是这会占用很多屏幕空间：

library(tibble)
library(ggplot2)
library(ggrepel)

df <- tribble(
  ~x,  ~y, ~name,            ~initials,
  0,   0,  "Hadley Wickam",    "HW",
  0,   1,  "Ross Ihaka",       "RI",
  1,   0,  "Robert Gentleman", "RG",
  1,   1,  "Yihui Xie",        "YX"
)

ggplot(df, aes(x, y, 
               label = initials, 
               fill = paste(initials, name, sep = '\t-\t'))
       ) +
  geom_point() +
  geom_text_repel() +
  scale_fill_discrete('Names', guide = guide_legend(override.aes = list(alpha = 0), title.hjust = .5)) +
  theme(legend.key = element_blank())

由reprex package（v0.2.0）创建于2018-05-10。

Answer 2

这是一个需要手动挖掘底层grob的hack，但基本思路类似于@ GGamba的方法：

第1步。使用基于name变量的形状图例创建ggplot对象。相应的geom图层是不可见的（alpha = 0）;这就是传说。

（我在geom_text_repel与geom_text进行了交易，因为我认为问题可以超出ggrepel包。）

library(grid)

p <- ggplot(df, aes(x, y, label = initials, color = factor(y))) +
  geom_text() +
  geom_point(aes(shape = name), alpha = 0) +
  scale_shape_manual(values = sort(unique(df$initials)),
                     guide = guide_legend(override.aes = list(alpha = 1,  
                                                              size = 5)))

在这里我们观察到sort(unique(df$initials)) = c("HW", "RG", "RI", "YX")也是2个字母的字符串，只有第一个字母显示在图例中。无所谓，无论如何我们都会改变它。

第2步。将ggplot对象转换为grob对象，＆amp;检查哪个grob对应正确的图例。

gp <- ggplotGrob(p)

> gp$grobs[[15]]$grobs[[2]]
TableGrob (8 x 6) "layout": 14 grobs
    z     cells       name                               grob
1   1 (1-8,1-6) background rect[legend.background..rect.5267]
2   2 (2-2,2-5)      title        text[guide.title.text.5245]
3   3 (4-4,2-2) key-3-1-bg        rect[legend.key..rect.5255]
4   4 (4-4,2-2)  key-3-1-1           points[GRID.points.5256]
5   5 (5-5,2-2) key-4-1-bg        rect[legend.key..rect.5258]
6   6 (5-5,2-2)  key-4-1-1           points[GRID.points.5259]
7   7 (6-6,2-2) key-5-1-bg        rect[legend.key..rect.5261]
8   8 (6-6,2-2)  key-5-1-1           points[GRID.points.5262]
9   9 (7-7,2-2) key-6-1-bg        rect[legend.key..rect.5264]
10 10 (7-7,2-2)  key-6-1-1           points[GRID.points.5265]
11 11 (4-4,4-4)  label-3-3        text[guide.label.text.5247]
12 12 (5-5,4-4)  label-4-3        text[guide.label.text.5249]
13 13 (6-6,4-4)  label-5-3        text[guide.label.text.5251]
14 14 (7-7,4-4)  label-6-3        text[guide.label.text.5253]

在这种情况下，图例位于gp$grobs[[15]]，第二个grob（gp$grobs[[15]]$grobs[[2]]）对应于形状图例。检查这个grob显示了凹槽4,6,8和＆amp; 10对应于四个名称的图例键内容。

第3步。用正确的标签替换图例键嵌入。

initials <- sort(unique(df$initials))

for(i in seq_along(initials)){
  gp$grobs[[15]]$grobs[[2]]$grobs[[2 + 2 * i]] <- 
    grid.text(label = initials[i], draw = FALSE)
}

第4步。检查结果。

grid.draw(gp)

Answer 3

在即将推出的ggplot2 2.3.0中，您可以直接设置label美学的比例和图例，避免需要网格黑客攻击或盗用无关的美学。但是，我注意到这只适用于geom_text()，而不适用于geom_text_repel()。我认为这是ggrepel中的一个错误。

library(tibble)
library(ggplot2)

df <- tribble(
  ~x,  ~y, ~name,            ~initials,
  0,   0,  "Hadley Wickam",    "HW",
  0,   1,  "Ross Ihaka",       "RI",
  1,   0,  "Robert Gentleman", "RG",
  1,   1,  "Yihui Xie",        "YX"
)

ggplot(df, aes(x, y, label = initials)) +
  geom_point() +
  geom_text() +
  scale_discrete_identity(
    aesthetics = "label",
    name = "Names",
    breaks = df$initials,
    labels = df$name,
    guide = "legend"
  ) +
  theme(legend.title = element_text(hjust = 0.5))

传奇造型并不是很棒，但你可以重新定义关键绘图功能，以获得你想要的任何东西：

library(tibble)
library(ggplot2)

df <- tribble(
  ~x,  ~y, ~name,            ~initials,
  0,   0,  "Hadley Wickam",    "HW",
  0,   1,  "Ross Ihaka",       "RI",
  1,   0,  "Robert Gentleman", "RG",
  1,   1,  "Yihui Xie",        "YX"
)

# custom key drawing function
# modified from: https://github.com/tidyverse/ggplot2/blob/22691ab1e14a9b615efb9f690d5dbaa599273496/R/legend-draw.r#L175
draw_key_text2 <- function(data, params, size) {
  grid::textGrob(
    data$label, 1., 0.5,
    hjust = 1, # right justified
    rot = data$angle,
    gp = grid::gpar(
      col = scales::alpha(data$colour, data$alpha),
      fontfamily = data$family,
      fontface = data$fontface,
      fontsize = .8*11 # match font size to label font
    )
  )
}

# careful, the following code changes the legend for all geom_text() calls
# for the remainder of the R session.
# Undo via: GeomText$draw_key <- draw_key_text
GeomText$draw_key <- draw_key_text2 


ggplot(df, aes(x, y, label = initials)) +
  geom_point() +
  geom_text() +
  scale_discrete_identity(
    aesthetics = "label",
    name = "Names",
    breaks = df$initials,
    labels = paste0("—  ", df$name),
    guide = "legend"
  ) +
  theme(
    legend.key = element_blank(),
    legend.title = element_text(hjust = 0.5)
  )

由reprex package（v0.2.0）创建于2018-05-12。

ggplot2添加缩写指南

3 个答案: