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 )
相关推荐
Katecat996631 天前
夜间收费站与道路场景多类型车辆检测与分类:基于Faster R-CNN R50 PAFPN的实现_1
分类·r语言·cnn
Piar1231sdafa1 天前
红枣目标检测Cascade R-CNN改进版_FPN结构优化详解
目标检测·r语言·cnn
天桥下的卖艺者1 天前
R语言绘制复杂加权数据(nhanes数据)多模型生存分析决策曲线
开发语言·r语言
yousuotu2 天前
基于 Python 实现亚马逊销售数据分析
数据挖掘·数据分析
Tiger Z2 天前
《R for Data Science (2e)》免费中文翻译 (第15章) --- Regular expression(1)
数据分析·r语言·数据科学·免费书籍
镜舟科技2 天前
活动回顾 | 镜舟科技出席鲲鹏开发者创享日・北京站
starrocks·数据分析·开源·数字化转型·华为鲲鹏·lakehouse·镜舟科技
Aloudata2 天前
大火的 ChatBI,是如何实现灵活的自然语言数据分析?
数据挖掘·数据分析·chatbi·dataagent·自然语言问数
方圆工作室2 天前
纯HTML/CSS健康数据分析平台
css·数据分析·html
free-elcmacom2 天前
Python实战项目<3>赛制分数分析
开发语言·前端·python·数据分析
Dekesas96952 天前
【深度学习】基于Faster R-CNN的黄瓜幼苗智能识别与定位系统,农业AI新突破
人工智能·深度学习·r语言