ggrepel
提供了一系列出色的用于注释ggplot2
图形的函数,示例页面包含许多关于如何扩展其功能的好提示,包括将生成的标签移离绘图的两个轴、其他标签等。
然而,没有涵盖的一件事是将标签从使用geom_hline()
和手动绘制的线中移开geom_vline()
,例如在制作带注释的火山图时可能会发生这种情况。
这是一个简单的 MWE 来强调这个问题:
\nlibrary("tidyverse")\nlibrary("ggrepel")\n\ndat <- subset(mtcars, wt > 2.75 & wt < 3.45)\ndat$car <- rownames(dat)\nggplot(dat, aes(wt, mpg, label = car)) +\n geom_point(color = "red") +\n geom_text_repel(seed = 1) + #Seed for reproducibility \n geom_vline(xintercept = 3.216) + #Deliberately chosen "bad" numbers \n geom_hline(yintercept = 19.64) + theme_bw()\n
Run Code Online (Sandbox Code Playgroud)\n\n请注意线条如何与标签文本重叠并使其模糊(是“Horret 4 Drive”还是“Hornet 4 Drive”?)
\n事后稍微调整一下点,你可以做得更好 \xe2\x80\x93 我只是稍微移动了一些标签,让它们脱离了线。\n
是否有可能ggrepel
自动执行此操作?我知道给出的例子并不完全稳定(其他种子给出了可接受的结果),但对于具有大量点的复杂图来说,这肯定是一个问题。
编辑:如果您好奇,下面是一个远不那么“最小”的工作示例(取自bioconductor):
\ndownload.file("https://raw.githubusercontent.com/biocorecrg/CRG_RIntroduction/master/de_df_for_volcano.rds", "de_df_for_volcano.rds", method="curl")\ntmp <- readRDS("de_df_for_volcano.rds")\nde <- tmp[complete.cases(tmp), ]\nde$diffexpressed <- "NO"\n# if log2Foldchange > 0.6 and pvalue < 0.05, set as "UP" \nde$diffexpressed[de$log2FoldChange > 0.6 & de$pvalue < 0.05] <- "UP"\n# if log2Foldchange < -0.6 and pvalue < 0.05, set as "DOWN"\nde$diffexpressed[de$log2FoldChange < -0.6 & de$pvalue < 0.05] <- "DOWN"\n\n# Create a new column "delabel" to de, that will contain the name of genes differentially expressed (NA in case they are not)\nde$delabel <- NA\nde$delabel[de$diffexpressed != "NO"] <- de$gene_symbol[de$diffexpressed != "NO"]\n\n#Actually do plot \nggplot(data=de, aes(x=log2FoldChange, y=-log10(pvalue), col=diffexpressed, label=delabel)) +\n geom_point() + \n theme_minimal() +\n geom_text_repel() +\n scale_color_manual(values=c("blue", "black", "red")) +\n geom_vline(xintercept=c(-0.6, 0.6), col="red") +\n geom_hline(yintercept=-log10(0.05), col="red")\n
Run Code Online (Sandbox Code Playgroud)\n这会产生以下结果,其中文本重叠行问题非常明显:
\n\n我认为没有内置的方法可以做到这一点。
我的一个不优雅的做法是沿着截取线添加不可见的点,然后标签将排斥这些点。
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()
Run Code Online (Sandbox Code Playgroud)
归档时间: |
|
查看次数: |
4947 次 |
最近记录: |