r - 将 ggrepel/geom_text_repel 的标签从 geom_vline() 和 geom_hline() 绘制的线移开

Question

ggrepel 提供了一系列出色的函数用于注释ggplot2 图形和the examples page包含许多关于如何扩展其功能的很好的提示，包括将生成的标签从绘图的轴、其他标签等移开。

但是，没有涉及的一件事是使用 geom_hline() 和 geom_vline() 将标签从手动绘制的线条上移开，这可能会发生，例如, 在 making an annotated volcano plot .

这里有一个简单的 MWE 来突出问题:

library("tidyverse")
library("ggrepel")

dat <- subset(mtcars, wt > 2.75 & wt < 3.45)
dat$car <- rownames(dat)
ggplot(dat, aes(wt, mpg, label = car)) +
    geom_point(color = "red") +
    geom_text_repel(seed = 1) + #Seed for reproducibility 
    geom_vline(xintercept = 3.216) + #Deliberately chosen "bad" numbers 
    geom_hline(yintercept = 19.64) + theme_bw()

这会产生以下输出:

注意线条如何与标签的文本重叠并使其模糊(是“Horret 4 Drive”还是“Hornet 4 Drive”？)

事后稍微调整一下要点，您可以做出更好的拟合——我只是稍微移动了一些标签以使它们脱线。

是否可以让 ggrepel 自动执行此操作？我知道给出的示例并不完全稳定(其他种子给出可接受的结果)，但对于具有大量点的复杂图，这绝对是一个问题。

编辑:如果您很好奇，下面是一个“最小”的工作示例(取自 bioconductor):

download.file("https://raw.githubusercontent.com/biocorecrg/CRG_RIntroduction/master/de_df_for_volcano.rds", "de_df_for_volcano.rds", method="curl")
tmp <- readRDS("de_df_for_volcano.rds")
de <- tmp[complete.cases(tmp), ]
de$diffexpressed <- "NO"
# if log2Foldchange > 0.6 and pvalue < 0.05, set as "UP" 
de$diffexpressed[de$log2FoldChange > 0.6 & de$pvalue < 0.05] <- "UP"
# if log2Foldchange < -0.6 and pvalue < 0.05, set as "DOWN"
de$diffexpressed[de$log2FoldChange < -0.6 & de$pvalue < 0.05] <- "DOWN"

# Create a new column "delabel" to de, that will contain the name of genes differentially expressed (NA in case they are not)
de$delabel <- NA
de$delabel[de$diffexpressed != "NO"] <- de$gene_symbol[de$diffexpressed != "NO"]

#Actually do plot 
ggplot(data=de, aes(x=log2FoldChange, y=-log10(pvalue), col=diffexpressed, label=delabel)) +
    geom_point() + 
    theme_minimal() +
    geom_text_repel() +
    scale_color_manual(values=c("blue", "black", "red")) +
    geom_vline(xintercept=c(-0.6, 0.6), col="red") +
    geom_hline(yintercept=-log10(0.05), col="red")

这会产生以下内容，其中文本重叠线问题非常明显:

Answer 1

我认为没有内置的方法可以做到这一点。

我头顶上的一个不优雅的技巧是沿着截线添加不可见的点，然后标签将远离这些点。

dat <- subset(mtcars, wt > 2.75 & wt < 3.45)
dat$car <- rownames(dat)

xintercept = 3.216
yintercept = 19.64

dat %>%
  mutate(alpha = 1) %>%
  bind_rows(.,
            tibble(wt = seq(from = min(.$wt), to = max(.$wt), length.out = 20), mpg = yintercept, car = '', alpha = 0),
            tibble(wt = xintercept, mpg = seq(from = min(.$mpg), to = max(.$mpg), length.out = 20), car = '', alpha = 0)
  ) %>%
  ggplot(aes(wt, mpg, label = car, alpha = alpha)) +
  geom_point(color = "red") +
  geom_text_repel(seed = 1) + #Seed for reproducibility 
  geom_vline(xintercept = xintercept) +
  geom_hline(yintercept = yintercept) + theme_bw() +
  scale_alpha_identity()