查看: 598|回复: 14

[R语言] ​拿捏2种富集条形图绘制方法!

  [复制链接]

管理员

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

主题
806
注册时间
2020.6.16
在线时间
439 小时

发表于 2022.9.22 09:25:58 | 显示全部楼层 |阅读模式
关于富集分析相关内容可戳往期:
《KEGG富集分析及可视化,一把子拿捏!》
《GO富集分析及可视化,一把子拿捏!》
《快速拿捏KEGG/GO/Reactome/Do/MSigDB的GSEA富集分析》
《报错不怕 计算不慌 美图流畅 关于功能富集,它一直很可以》

今天我们从拿到富集结果表开始,跟着nature communications学习下图这种将通路信息叠加在柱子上的富集条形图样式用ggplot2要怎么画。

Nat Commun,2022)

  1. #所需R包载入:
  2. library(dplyr)
  3. library(ggplot2)
  4. library(RColorBrewer)
  5. #载入差异基因富集结果表:
  6. #这里使用自己的富集结果表即可
  7. load("KEGG_diff.Rdata")
  8. View(KEGG_result) #clusterProfiler富集结果表
复制代码


  1. colnames(KEGG_result) #包含信息列查看
复制代码


有两个绘图常用数据是结果表中没有的,先算一下备用(也可以不需要,看自己想用什么数据画图):

  1. ##计算Rich Factor(富集因子):
  2. KEGG_result <- mutate(KEGG_result,
  3. RichFactor = Count / as.numeric(sub("/\\d+", "", BgRatio)))
  4. ##计算Fold Enrichment(富集倍数):
  5. KEGG_result$FoldEnrichment <- apply(KEGG_result,1,function(x){
  6. GeneRatio <- eval(parse(text = x["GeneRatio"]))
  7. BgRatio <- eval(parse(text = x["BgRatio"]))
  8. foldEnrichment <- round(GeneRatio/BgRatio,2)
  9. foldEnrichment
  10. })
  11. head(KEGG_result$RichFactor)
  12. head(KEGG_result$FoldEnrichment)
  13. colnames(KEGG_result)
复制代码


  1. #提取结果前Top20绘图(或自定义所需pathway绘图):
  2. top20 <- KEGG_result[1:20,]
  3. #指定绘图顺序(转换为因子):
  4. top20$pathway <- factor(top20$Description,levels = rev(top20$Description))
复制代码

我们先画一下常规的富集条形图:

  1. ######
  2. #1.常规画法:
  3. #自定义主题:
  4. mytheme <- theme(axis.title = element_text(size = 13),
  5. axis.text = element_text(size = 11),
  6. plot.title = element_text(size = 14,
  7. hjust = 0.5,
  8. face = "bold"),
  9. legend.title = element_text(size = 13),
  10. legend.text = element_text(size = 11))
  11. #Top20富集数目条形图:
  12. p <- ggplot(data = top20,
  13. aes(x = Count, y = pathway, fill = -log10(pvalue)))+
  14. scale_fill_distiller(palette = "RdPu",direction = 1) +
  15. geom_bar(stat = "identity", width = 0.8) +
  16. labs(x = "Number of Gene", y = "pathway", title = "KEGG enrichment barplot") +
  17. theme_bw() + mytheme
  18. p
复制代码


  1. #Top20富集因子条形图(挑选所需数据列绘图即可):
  2. p1 <- ggplot(data = top20,
  3. aes(x = -log10(pvalue), y = pathway, fill = RichFactor)) +
  4. scale_fill_distiller(palette = "RdPu",direction = 1) +
  5. geom_bar(stat = "identity", width = 0.8) +
  6. labs(x = "Number of Gene", y = "pathway", title = "KEGG enrichment barplot") +
  7. theme_bw() + mytheme
  8. p1
复制代码


可以看到常规画法pathway描述是很占空间的,下面我们试试论文的画法把文本信息直接叠放在对应柱子上,画法其实很简单,稍作修改:

  1. ######
  2. #2.论文画法:
  3. mytheme2 <- mytheme + theme(axis.text.y = element_blank()) #先在自定义主题中隐去y轴文本标签显示
  4. top20$text_x <- rep(0.03,20) #新增一列重复数组,使绘图时文本标签能从固定位置开始;
  5. p2 <- ggplot(data = top20,
  6. aes(x = RichFactor, y = pathway)) +
  7. geom_bar(aes(fill = -log10(pvalue)), stat = "identity", width = 0.8, alpha = 0.7) +
  8. scale_fill_distiller(palette = "YlOrRd", direction = 1) +
  9. labs(x = "RichFactor", y = "pathway", title = "KEGG enrichment barplot") +
  10. geom_text(aes(x = text_x, #用新增的重复数组控制文本标签起始位置
  11. label = pathway),
  12. hjust = 0)+ #hjust=0,左对齐
  13. theme_classic() + mytheme2
  14. p2
复制代码


确实更加容易排版,对于较长的pathway或term看起来也更为美观。

好啦,今天的分享就到这里!

参考文献
Yuan, Y., Wang, C., Zhuang, X. et al. PIM1 promotes hepatic conversion by suppressing reprogramming-induced ferroptosis and cell cycle arrest. Nat Commun 13, 5237 (2022).
https://doi.org/10.1038/s41467-022-32976-9

*未经许可,不得以任何方式复制或抄袭本篇文章之部分或全部内容。版权所有,侵权必究。

本文作者:基迪奥-喵酱

本帖子中包含更多资源

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

x
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

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

发表于 2022.9.22 09:33:43 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
0
注册时间
2019.4.24
在线时间
17 小时

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

使用道具 举报

钵水母

Rank: 3Rank: 3

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

发表于 2022.9.22 10:23:42 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
0
注册时间
2016.5.10
在线时间
24 小时

发表于 2022.9.22 21:15:08 | 显示全部楼层
加油第二十天
新的一天加油!
回复 支持 反对

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
0
注册时间
2019.4.24
在线时间
17 小时

发表于 2022.9.23 09:22:05 | 显示全部楼层
加油
新的一天加油!
回复

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
0
注册时间
2016.5.10
在线时间
24 小时

发表于 2022.9.23 14:40:04 | 显示全部楼层
加油的第二十一天
新的一天加油!
回复 支持 反对

使用道具 举报

钵水母

Rank: 3Rank: 3

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

发表于 2022.9.23 16:10:34 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

功夫熊猫

Rank: 10Rank: 10Rank: 10

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

发表于 2022.9.23 16:52:53 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
0
注册时间
2016.5.10
在线时间
24 小时

发表于 2022.9.24 09:23:23 | 显示全部楼层

加油第二十二天
新的一天加油!
回复 支持 反对

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
0
注册时间
2019.4.24
在线时间
17 小时

发表于 2022.9.24 09:31:55 | 显示全部楼层
奋斗
新的一天加油!
回复

使用道具 举报

功夫熊猫

Rank: 10Rank: 10Rank: 10

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

发表于 2022.9.24 10:19:23 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
0
注册时间
2017.11.3
在线时间
314 小时

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

使用道具 举报

中华鲟

Rank: 5Rank: 5

主题
0
注册时间
2019.4.24
在线时间
17 小时

发表于 2022.9.26 09:39:07 | 显示全部楼层
奋斗
新的一天加油!
回复

使用道具 举报

功夫熊猫

Rank: 10Rank: 10Rank: 10

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

发表于 2022.9.26 10:01:11 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

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

本版积分规则

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