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 )
相关推荐
Asa121381 天前
R语言实现多组学因子分析(MOFA)
数据分析
漂着的圆木1 天前
Agent 功能参与度:Copilot 怎么算
sql·数据分析·agent·githubcopilot·度量
paopaokaka_luck2 天前
智慧社区综合服务小程序(人脸识别、AI问答、Echarts图形化分析)
前端·javascript·spring boot·spring·数据分析·echarts
Aloudata2 天前
语义层和SQL Copilot:一个降低写SQL门槛,一个统一业务逻辑
大数据·人工智能·数据分析·data agent·语义层
IT研究室2 天前
最新大数据毕业设计选题推荐-基于大数据的信用等级数据分析与可视化-大数据-Spark-Hadoop-Bigdata
大数据·信息可视化·数据分析·spark·课程设计
paopaokaka_luck2 天前
考研政治刷题小程序(AI推荐题目、ECharts数据分析、章节练习与专项训练、模拟考试、错题本与收藏夹、学习打卡与目标管理、题库和组卷维护)
前端·javascript·spring boot·spring·数据分析·echarts
2601_960620372 天前
2026校招市场策略岗项目准备指南:调研/竞品/活动/竞赛4类项目
数据分析
SelectDB2 天前
同等资源下 Apache Doris 4.2 vs StarRocks 4.1.1:1TB SSB 与 TPC-H 性能实测
大数据·数据库·数据分析
SelectDB2 天前
Doris vs ClickHouse:企业 OLAP 走向下一阶段,两种技术路线如何选择
大数据·数据库·数据分析
AI职业加油站2 天前
数据要素价值释放年:大数据治理工程师,站上职业新风口
人工智能·学习·职场和发展·数据分析·职场发展