烟台做网站电话网站模块结构图
客户要求绘制类似文章中的这种颜色渐变火山图，感觉挺好看的。网上找了一圈，发现有别人已经实现的类似代码，拿来修改后即可使用，这里做下记录，以便后期查找。
简单实现
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 )
