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 )
相关推荐
SelectDB15 小时前
Apache Doris 与 SelectDB 是什么关系?从开源技术到面向 Agent 的极速分析数据库
大数据·数据库·数据分析
SelectDB15 小时前
存算分离冷查询提速 7.5 倍!Apache Doris 4.2 Peer Read 实现跨计算组缓存复用
大数据·数据库·数据分析
Thanks_ks16 小时前
【第 003 讲】全面认识 Python:语言起源与设计哲学 | 行业地位与流行趋势 | 技术优势与应用领域 | 技术边界与工程局限
人工智能·python·数据分析·编程语言·python 入门·web 开发·python 之禅
TianFuRuanJian17 小时前
DTEmpower走进中国水科院,助力水利科研数据分析国产化
数据挖掘·数据分析
2601_9679801118 小时前
行代码设置表格格式,一键生成可视化报表
数据分析·办公自动化·python办公·报表自动化·职场提效
xurime18 小时前
Excelize 开源基础库发布 2.11.1 版本更新
数据分析·excel·开源软件·excelize·gitcode
山海鲸可视化21 小时前
数字孪生项目案例 | 智慧城市IOC可视化
人工智能·数据分析·智慧城市·数字孪生·三维模型
quantdash_cc21 小时前
个人开发者用 QuantDash 读取港股行情:00700.HK 的 Python 函数封装与校验实践
python·数据分析·pandas·量化交易·股票数据·quantdash
遇码1 天前
2026-11-01-daw-retry-banner-body
人工智能·ai·rust·数据分析·大模型·agent
databook2 天前
Pandas 与 Polars:语法、性能和资源占用方面的对比
python·数据分析·pandas