查看: 4990|回复: 69

[R语言] 如何绘制新颖好看的火山图?

  [复制链接]

管理员

Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15

主题
461
注册时间
2020.6.16
在线时间
304 小时

发表于 2021.11.8 09:39:00 | 显示全部楼层 |阅读模式
火山图(Volcano plot)是一种比较“远古”的一种散点图,广泛应用于转录组、蛋白组等组间差异分析结果的展示。图表的横轴一般展示差异倍数的变化,而纵轴表示差异分析结果的可靠性。

我这里对传统的火山图做了进一步的优化,比如通过调整点的大小突出展示感兴趣基因对应的点,并将感兴趣基因的名称以标签的方式展示出来,如下。


那么,如何绘制这般个性又好看的火山图呢?我这里主要用到的还是最常见的ggplot2包。
  1. #设置工作目录;
  2. setwd("C:/Users/MHY/Desktop/火山图的绘制")
  3. dir()
  4. #读入数据;
  5. data <- read.csv("protein_dia_simple.csv",header = T)
  6. head(data)
复制代码


  1. #载入相关的R包;
  2. library(dplyr)
  3. library(ggplot2)
  4. library(ggrepel)
  5. #转成tibble便于后续使用,去掉不需要的列;
  6. dt <- as_tibble(data[c(-2,-3,-5)])
  7. head(dt)
  8. #对Q值取对数;
  9. dt$log10FDR <- -log10(dt$qvalue)
  10. #生成显著上下调数据的分组标签;
  11. dt$group <- case_when(dt$log2fc > 1 & dt$qvalue < 0.05 ~ "Up",
  12.                       dt$log2fc < -1 & dt$qvalue < 0.05 ~ "Down",
  13.                       abs(dt$log2fc) <= 1 ~ "None",
  14.                       dt$qvalue >= 0.05 ~ "None")
  15. head(dt)
  16. #获取表达差异最显著的10个基因;
  17. top10sig <- filter(dt,group!="None") %>% distinct(Symbol,.keep_all = T) %>% top_n(10,abs(log2fc))
  18. top10sig
复制代码


  1. #将差异表达Top10的基因表格拆分成up和down两部分;
  2. up <- filter(top10sig,group=="Up")
  3. up
  4. down <- filter(top10sig,group=="Down")
  5. down
复制代码


  1. #新增一列,将Top10的差异基因标记为2,其他的标记为1;
  2. dt$size <- case_when(!(dt$id %in% top10sig$id)~ 1,
  3.                      dt$id %in% top10sig$id ~ 2)
  4. head(dt)
  5. #提取非Top10的基因表格;
  6. df <- filter(dt,size==1)
  7. head(df)
复制代码


  1. #指定绘图顺序,将group列转成因子型;
  2. df$group <- factor(df$group,
  3.                         levels = c("Up","Down","None"),
  4.                         ordered = T)
  5. #开始绘图,建立映射;
  6. p0 <-ggplot(data=df,aes(log2fc,log10FDR,color=group))
  7. #添加散点;
  8. p1 <- p0+geom_point(size=1.6)
  9. p1
复制代码


  1. #自定义半透明颜色(红绿);
  2. mycolor <- c("#FF9999","#99CC00","gray80")
  3. p21 <- p1 + scale_colour_manual(name="",values=alpha(mycolor,0.9))
  4. p21
复制代码


  1. #其他配色方案:
  2. mycolor <- c("#FF99CC","#99CC00","gray80")
  3. p22 <- p1 + scale_colour_manual(name="",values=alpha(mycolor,0.7))
  4. p22
复制代码


  1. #继续添加Top10基因对应的点;
  2. p2 <- p22+geom_point(data=up,aes(log2fc,log10FDR),
  3.                     color="#FF9999",size=3,alpha=0.9)+
  4.   geom_point(data=down,aes(log2fc,log10FDR),
  5.              color="#7cae00",size=3,alpha=0.9)
  6. p2
复制代码


调整横轴和纵轴绘图区域的范围,重点突出Top10基因;设置y轴范围(上下两端的空白区域设为1),修改刻度标签。

  1. #expansion函数设置坐标轴范围两端空白区域的大小;mult为“倍数”模式,add为“加性”模式;
  2. p3<-p2+labs(y="-log10FDR")+
  3.   scale_y_continuous(expand=expansion(add = c(2, 0)),
  4.                      limits = c(0, 40),
  5.                      breaks = c(0,10,20,30,40),
  6.                      label = c("0","10","20","30","40"))+
  7.   scale_x_continuous(limits = c(-4, 4),
  8.                      breaks = c(-4,-2,0,2,4),
  9.                      label = c("-4","-2","0","2","4"))
  10. p3
复制代码


接下来为top10基因对应的散点添加指引线,我们主要用到geom_text_repel()和geom_label_repel()这两个函数,下面是比较重要的一些参数:
nudge_x/y:数据点与相应数据标签的距离,例如1表示标签在点右/上的1个单位处,而-2.2表示标签在点左/下2.2个单位处;direction:标签分布方向,x表水平分布,y 表示垂直分布,both 表示随机分布;segment.size:指定线段的粗细;point.padding:表示点周围的空余区域,决定连接线端点到到数据点中心的距离,单位为line。

  1. #添加箭头;
  2. set.seed(007)
  3. p4 <- p3+geom_text_repel(data=top10sig,aes(log2fc,log10FDR,label=Symbol),
  4. force=80,color="grey20",size=3,
  5. point.padding = 0.5,hjust = 0.5,
  6. arrow = arrow(length = unit(0.01, "npc"),
  7. type = "open", ends = "last"),
  8. segment.color="grey20",
  9. segment.size=0.2,
  10. segment.alpha=0.8,
  11. nudge_x=0,
  12. nudge_y=1)
  13. p4
复制代码


  1. #自定义图表主题,对图表做精细调整;
  2. top.mar=0.2
  3. right.mar=0.2
  4. bottom.mar=0.2
  5. left.mar=0.2
  6. #隐藏纵轴,并对字体样式、坐标轴的粗细、颜色、刻度长度进行限定;
  7. mytheme<-theme_classic()+
  8. theme(text=element_text(family = "sans",colour ="gray30",size = 12),
  9. axis.line = element_line(size = 0.6,colour = "gray30"),
  10. axis.ticks = element_line(size = 0.6,colour = "gray30"),
  11. axis.ticks.length = unit(1.5,units = "mm"),
  12. plot.margin=unit(x=c(top.mar,right.mar,bottom.mar,left.mar),
  13. units="inches"))
  14. #应用自定义主题;
  15. p4+mytheme
复制代码


  1. #添加辅助线;
  2. p5 <- p3+geom_hline(yintercept = c(-log10(0.05)),
  3. size = 0.7,
  4. color = "orange",
  5. lty = "dashed")+
  6. geom_vline(xintercept = c(-1,1),
  7. size = 0.7,
  8. color = "orange",
  9. lty = "dashed")
  10. p5
复制代码


  1. #添加其他样式的标签;
  2. #为了方便自定义左右区域的标签,这里使用up、down两个独立的子表格;
  3. p6 <- p5+geom_label_repel(
  4. data = up,aes(log2fc,log10FDR,label=Symbol),
  5. nudge_x = 1,
  6. nudge_y = 5,
  7. color = "white",
  8. alpha = 0.9,
  9. point.padding = 0.5,
  10. size = 3,
  11. fill = "#96C93D",
  12. segment.size = 0.5,
  13. segment.color = "grey50",
  14. direction = "y",
  15. hjust = 0.5) +
  16. geom_label_repel(
  17. data = down,aes(log2fc,log10FDR,label=Symbol),
  18. nudge_x = -1,
  19. nudge_y = 3,
  20. color = "white",
  21. alpha = 0.9,
  22. point.padding = 0.5,
  23. size = 3,
  24. fill = "#9881F5",
  25. segment.size = 0.5,
  26. segment.color = "grey50",
  27. direction = "y",
  28. hjust = 0.5)
  29. #应用自定义主题;
  30. p7 <- p6+mytheme
  31. p7
复制代码


好啦,以上就是今天分享的全部内容,你学会了吗?


本文作者:基迪奥-莫北

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
新的一天加油!
回复

使用道具 举报

帝王蝶

Rank: 4

主题
0
注册时间
2021.1.28
在线时间
13 小时

发表于 2021.11.8 11:42:10 | 显示全部楼层
顶!!!!!!!!!!!!
回复

使用道具 举报

钵水母

Rank: 3Rank: 3

主题
0
注册时间
2020.11.23
在线时间
2 小时

发表于 2021.11.8 14:01:52 | 显示全部楼层
学到了学到了!!!!!
回复 支持 反对

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
1
注册时间
2016.8.25
在线时间
92 小时

发表于 2021.11.8 15:15:30 | 显示全部楼层
收藏收藏
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
0
注册时间
2020.11.21
在线时间
76 小时

发表于 2021.11.8 19:20:14 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

功夫熊猫

Rank: 10Rank: 10Rank: 10

主题
3
注册时间
2017.9.8
在线时间
79 小时

发表于 2021.11.9 08:04:50 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

钵水母

Rank: 3Rank: 3

主题
0
注册时间
2021.4.14
在线时间
9 小时

发表于 2021.11.9 08:57:47 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
0
注册时间
2020.2.12
在线时间
81 小时

发表于 2021.11.9 09:03:14 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
0
注册时间
2020.11.21
在线时间
76 小时

发表于 2021.11.9 11:22:24 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

钵水母

Rank: 3Rank: 3

主题
0
注册时间
2021.4.14
在线时间
1 小时

发表于 2021.11.9 12:03:40 | 显示全部楼层
亲测好,希望多这样的坛友发布新的code
怎么这么难,生活不易啊
回复 支持 反对

使用道具 举报

功夫熊猫

Rank: 10Rank: 10Rank: 10

主题
3
注册时间
2017.9.8
在线时间
79 小时

发表于 2021.11.10 08:11:09 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
0
注册时间
2017.6.6
在线时间
148 小时

灌水之王


发表于 2021.11.10 08:26:49 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
0
注册时间
2017.6.6
在线时间
148 小时

灌水之王


发表于 2021.11.10 08:36:44 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
0
注册时间
2017.6.6
在线时间
148 小时

灌水之王


发表于 2021.11.10 08:37:47 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
0
注册时间
2020.11.21
在线时间
76 小时

发表于 2021.11.10 17:35:35 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

帝王蝶

Rank: 4

主题
0
注册时间
2021.1.28
在线时间
13 小时

发表于 2021.11.14 14:44:41 | 显示全部楼层
顶!!!!!!!!!!!!!!!!!!!!
回复

使用道具 举报

帝王蝶

Rank: 4

主题
0
注册时间
2021.6.22
在线时间
16 小时

发表于 2021.11.14 15:10:03 | 显示全部楼层
学习
回复

使用道具 举报

功夫熊猫

Rank: 10Rank: 10Rank: 10

主题
3
注册时间
2017.9.8
在线时间
79 小时

发表于 2021.11.15 08:22:43 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

帝王蝶

Rank: 4

主题
0
注册时间
2019.3.26
在线时间
7 小时

发表于 2021.11.16 22:24:27 | 显示全部楼层
这有点难啊
回复 支持 反对

使用道具 举报

功夫熊猫

Rank: 10Rank: 10Rank: 10

主题
3
注册时间
2017.9.8
在线时间
79 小时

发表于 2021.11.17 08:14:53 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

快速回复 返回顶部 返回列表