R语言绘图 | 渐变火山图

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

简单实现

复制代码
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 )
相关推荐
小L爱科研2 小时前
4.7/Q1,GBD数据库最新文章解读
数据库·机器学习·数据分析·回归·健康医疗
kngines3 小时前
【PostgreSQL数据分析实战:从数据清洗到可视化全流程】金融风控分析案例-10.4 模型部署与定期评估
postgresql·数据分析·存储过程·jsonb·pg_cron·ks值·影子测试机制
想看雪的瓜3 小时前
Nature图形复现—两种快速绘制热图的方法
信息可视化·数据挖掘·数据分析
镜舟科技3 小时前
湖仓一体架构在金融典型数据分析场景中的实践
starrocks·金融·架构·数据分析·湖仓一体·物化视图·lakehouse
zm-v-159304339866 小时前
解锁生命周期评价密码:OpenLCA、GREET 与 R 语言的融合应用
r语言·生命周期
Hello world.Joey6 小时前
数据挖掘入门-二手车交易价格预测
人工智能·python·数据挖掘·数据分析·conda·pandas
kngines7 小时前
【PostgreSQL数据分析实战:从数据清洗到可视化全流程】金融风控分析案例-10.3 风险指标可视化监控
postgresql·数据分析·区块链·逾期率·不良贷款率·客户信用评分
Narutolxy16 小时前
大模型数据分析破局之路20250512
人工智能·chatgpt·数据分析
Ai尚研修-贾莲19 小时前
Python语言在地球科学交叉领域中的应用——从数据可视化到常见数据分析方法的使用【实例操作】
python·信息可视化·数据分析·地球科学