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 )
相关推荐
key065 小时前
电子水母函数解析
数据分析
Brduino脑机接口技术答疑6 小时前
脑机新手指南(二十一)基于 Brainstorm 的 MEG/EEG 数据分析(上篇)
数据挖掘·数据分析
镜舟科技6 小时前
StarRocks × Tableau 连接器完整使用指南 | 高效数据分析从连接开始
starrocks·数据分析·数据可视化·tableau·连接器·交互式分析·mpp 数据库
好开心啊没烦恼8 小时前
Python 数据分析:DataFrame,生成,用字典创建 DataFrame ,键值对数量不一样怎么办?
开发语言·python·数据挖掘·数据分析
永洪科技18 小时前
永洪科技荣获商业智能品牌影响力奖,全力打造”AI+决策”引擎
大数据·人工智能·科技·数据分析·数据可视化·bi
Triv20251 天前
ECU开发工具链1.10版:更强大的测量、校准与数据分析体验.
microsoft·数据分析·汽车电子开发·校准流程自动化·高速信号采集·测试台架集成·实时数据监控
好开心啊没烦恼1 天前
Python 数据分析:numpy,抽提,整数数组索引与基本索引扩展(元组传参)。听故事学知识点怎么这么容易?
开发语言·人工智能·python·数据挖掘·数据分析·numpy·pandas
q567315231 天前
R语言初学者爬虫简单模板
开发语言·爬虫·r语言·iphone
陈敬雷-充电了么-CEO兼CTO1 天前
推荐算法系统系列>推荐数据仓库集市的ETL数据处理
大数据·数据库·数据仓库·数据挖掘·数据分析·etl·推荐算法
马特说1 天前
React金融数据分析应用性能优化实战:借助AI辅助解决18万数据量栈溢出Bug
react.js·金融·数据分析