客户要求绘制类似文章中的这种颜色渐变火山图,感觉挺好看的。网上找了一圈,发现有别人已经实现的类似代码,拿来修改后即可使用,这里做下记录,以便后期查找。

简单实现
library(tidyverse)library(ggrepel)library(ggfun)library(grid)
####---- Load Data ----####df <- read.table( "diffexp.txt", header = TRUE, sep = "\t", row.names = 1)
####----plot----#### ggplot(data = df) + geom_point( aes(x = log2FoldChange, y = -log10(padj), color = log2FoldChange, size = -log10(padj))) + geom_point(data = df %>% tidyr::drop_na() %>% dplyr::filter(regulated != "no") %>% dplyr::arrange(desc(-log10(padj))) %>% dplyr::slice(1:20), aes(x = log2FoldChange, y = -log10(padj), fill = log2FoldChange, size = -log10(padj)), shape = 21, show.legend = F, color = "#000000") + geom_text_repel(data = df %>% tidyr::drop_na() %>% dplyr::filter(regulated != "no") %>% dplyr::arrange(desc(-log10(padj))) %>% dplyr::slice(1:15) %>% dplyr::filter(regulated == "up"), aes(x = log2FoldChange, y = -log10(padj), label = gene), box.padding = 0.5, nudge_x = 0.5, nudge_y = 0.2, segment.curvature = -0.1, segment.ncp = 3, direction = "y", hjust = "left" ) + geom_text_repel(data = df %>% tidyr::drop_na() %>% dplyr::filter(regulated != "no") %>% dplyr::arrange(desc(-log10(padj))) %>% dplyr::slice(1:15) %>% dplyr::filter(regulated == "down"), aes(x = log2FoldChange, y = -log10(padj), label = gene), box.padding = 0.5, nudge_x = -0.2, nudge_y = 0.2, segment.curvature = -0.1, segment.ncp = 3, segment.angle = 20, direction = "y", hjust = "right" ) + scale_color_gradientn( colours = c("#3288bd", "#66c2a5","#ffffbf", "#f46d43", "#9e0142"), values = seq(0, 1, 0.2)) + scale_fill_gradientn( colours = c("#3288bd", "#66c2a5","#ffffbf", "#f46d43", "#9e0142"), values = seq(0, 1, 0.2)) + geom_vline(xintercept = c(-log2(1.5), log2(1.5)), linetype = 2) + geom_hline(yintercept = -log10(0.05), linetype = 4) + scale_size(range = c(1,7)) + theme_bw() + theme(panel.grid = element_blank(), legend.background = element_roundrect(color = "#808080", linetype = 1), axis.text = element_text(size = 13, color = "#000000"), axis.title = element_text(size = 15), plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5) ) + annotate(geom = "text", x = 2.5, y = 0.25, label = "p = 0.05", size = 5) + coord_cartesian(clip = "off") + annotation_custom( grob = grid::segmentsGrob(y0 = unit(-10, "pt"), y1 = unit(-10, "pt"), arrow = arrow(angle = 45, length = unit(.2, "cm"), ends = "first"), gp = grid::gpar(lwd = 3, col = "#74add1") ), xmin = range(df$log2FoldChange)[1]/10*9, xmax = range(df$log2FoldChange)[1]/10*4, ymin = range(-log10(df$padj))[2]/10*9.5, ymax = range(-log10(df$padj))[2]/10*9.5 ) + annotation_custom(grob = grid::textGrob( label = "Down", gp = grid::gpar(col = "#74add1") ), xmin = range(df$log2FoldChange)[1]/10*9, xmax = range(df$log2FoldChange)[1]/10*4, ymin = range(-log10(df$padj))[2]/10*9.5, ymax = range(-log10(df$padj))[2]/10*9.5 ) + annotation_custom(grob = grid::segmentsGrob( y0 = unit(-10, "pt"), y1 = unit(-10, "pt"), arrow = arrow(angle = 45, length = unit(.2, "cm"), ends = "last"), gp = grid::gpar(lwd = 3, col = "#d73027") ), xmin = range(df$log2FoldChange)[2]/10*9, xmax = range(df$log2FoldChange)[2]/10*4, ymin = range(-log10(df$padj))[2]/10*9.5, ymax = range(-log10(df$padj))[2]/10*9.5 ) + annotation_custom( grob = grid::textGrob( label = "Up", gp = grid::gpar(col = "#d73027") ), xmin = range(df$log2FoldChange)[2]/10*9, xmax = range(df$log2FoldChange)[2]/10*4, ymin = range(-log10(df$padj))[2]/10*9.5, ymax = range(-log10(df$padj))[2]/10*9.5 )
