相关性热图分析_聚类分析热图解读

相关性热图分析_聚类分析热图解读corr本期图片❝Jiang,Y.,Sun,A.,Zhao,Y.etal.Proteomicsidentifiesnewtherapeutictargetsofearly-stagehepatocellularcarci

03312889a70eebabd5b2d548630ac13f.jpeg

corr

本期图片

c054b10e99dd86a60f9459ef1697a329.png

Jiang, Y., Sun, A., Zhao, Y. et al. Proteomics identifies new therapeutic targets of early-stage hepatocellular carcinoma. Nature 「567」, 257–261 (2019). https://doi.org/10.1038/s41586-019-0987-8

复现结果

9abdaee023f30c9631bf5e96e6b89a36.png

image-

示例数据和代码领取

木舟笔记永久VIP企划

「权益:」

  1. 「木舟笔记所有推文示例数据及代码(「在VIP群里」实时更新」)。

    7f37ed3f282d1cd94991463400a2eb94.png

    data+code
  2. 木舟笔记「科研交流群」

「收费:」

「169¥/人」。可添加微信:mzbj0002 转账(或扫描下方二维码),或直接在文末打赏。木舟笔记「2022VIP」可直接支付「70¥」升级。

点赞在看 本文,分享至朋友圈集赞30个保留30分钟,可优惠20¥

4b8e52ccf7c2b8fe2bc24e4f23119256.png

绘图

法一是用corrgram包内的pairs函数实现,包内没有纯色填充方式需要设置自定义函数。

setwd(dir = 'F:/MZBJ/Corrplot') df = read.csv('sample_data.csv', row.names = 1) df = log(df+1) library(corrgram) pairs(df)

3a8981a94623201b11891fff7e747fa3.png

默认格式绘制已经接近了接下来我们自定义panel函数来绘制上下两部分

panel.fill<- function(x, y, digits = 2, prefix = "",col = "red", cex.cor, ...) {   par(usr = c(0, 1, 0, 1))#设置panel大小   r <- abs(cor(x, y))#计算相关性,此处使用的绝对值   txt <- format(r, digits = digits)[1]#相关性洗漱保留两位小数   col <- colorRampPalette(c("grey",'grey','grey', 'red'))(100)#生成一组色阶用于相关性系数映射   rect(0, 0, 1, 1, col = col[ceiling(r * 100)])#按相关性系数值从色阶中提取颜色   text(0.5, 0.5, txt, cex = 1.5,col = '#77787b', font = 2 )#设置文本格式 } pairs(df,       lower.panel = panel.fill,       gap = 0)

47b41544103f383ff8eadf8a48fb0b2b.png

panel.point <- function(x, y, ...){          r <- abs(cor(x, y))   col <- colorRampPalette(c("grey",'grey','grey', 'red'))(100)     rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], #将panel范围填充为对应颜色        col = col[ceiling(r * 100)],lwd = 2)   plot.xy(xy.coords(x, y), type = "p", #绘制散点图           pch = 20,            cex = .2,           ...) } pairs(df,       upper.panel = panel.point,       lower.panel = panel.fill,       gap = 0)

6a3a25fee1ce43f87b619f2bfe266d1c.png

text.panel <- function(x, y, txt, cex, ...) { text(x, y, txt, cex = cex, font = 2)   box(lwd = 1) } pairs(df,       upper.panel = panel.point,       lower.panel = panel.fill,       text.panel = text.panel,       gap = 0)

989f21c4ad9e2948a0630d11599c453d.png

法二是尝试用GGally包来实现一下,ggplot的语法相对来说更易读。实现直接绘制一下看看是什么情况。

library(GGally) library(ggplot2) ggpairs(df,1:4)

0bdfab6d94130a8404b666fa98d0defd.png

image-

先绘制上三角部分

GGup <- function(data, mapping, ...,                   method = "pearson") {      x <- GGally::eval_data_col(data, mapping$x)#提取x,y值   y <- GGally::eval_data_col(data, mapping$y)      cor <- cor(x, y, method = method, use="pairwise.complete.obs")#计算相关系数   df <- data.frame(x = x, y = y)   df <- na.omit(df)   col <- colorRampPalette(c("grey",'grey','grey', 'red'))(100) #生成色阶以便后面映射提取      cor_col = col[ceiling(cor * 100)]#按照相关系数来提取色阶中的颜色   pp <- ggplot(df) +     geom_text(data = data.frame(       xlabel = min(x,na.rm = T),       ylabel = min(y,na.rm = T),        labs = round(cor,2)),       aes(x = xlabel, y = ylabel, label = labs),       size = 10,       fontface = "bold",       inherit.aes = FALSE     )+     theme_bw()+     theme(panel.background = element_rect(fill =  cor_col))   return(pp) } ggpairs(df, 1:4, upper = list(continuous = wrap(GGup)))

e8399f6503aa61fc6369dda107e6fb2a.png

然后是下三角

GGdown <- function(data, mapping, ...,                     method = "pearson") {   x <- GGally::eval_data_col(data, mapping$x)   y <- GGally::eval_data_col(data, mapping$y)   col <- colorRampPalette(c("grey",'grey','grey', 'red'))(100)     cor <- cor(x, y, method = method, use="pairwise.complete.obs")   cor_col = col[ceiling(cor * 100)]      df <- data.frame(x = x, y = y)   df <- na.omit(df)      pp <- ggplot(df, aes(x=x, y=y)) +     ggplot2::geom_point( show.legend = FALSE, size = 1) +     theme_bw()+     theme(panel.background = element_rect(fill =  cor_col))   return(pp) } ggpairs(df, 1:4,         upper = list(continuous = wrap(GGup)),         lower = list(continuous = wrap(GGdown)))

fa1462f8df56883ef751ba6a4dc88c04.png

image-026274

最后是对角线注释

GGdiag = function(data, mapping, ...){   name= deparse(substitute(mapping))#提取出映射变量名(并非变量名本身,可用性尝试一下不进行下一步)   name = str_extract(name, "x = ~(.*?)\\)", 1)#对变量名进行处理提取出变量名   ggplot(data = data) +     geom_text(aes(x = 0.5, y = 0.5, label = name), size = 5)+     theme_bw()+     theme(panel.background = element_blank())#将变量名绘制于图中央 } ggpairs(df, 1:4,         upper = list(continuous = wrap(GGup)),         lower = list(continuous = wrap(GGdown)),         diag = list(continuous = wrap(GGdiag)))

d098c10201207cfc74275c695da6066f.png

最后再调整一下风格,完成。

ggpairs(df,         upper = list(continuous = wrap(GGup)),         lower = list(continuous = wrap(GGdown)),         diag = list(continuous = wrap(GGdiag)))+   theme(panel.grid = element_blank(),         axis.text =  element_blank(),         strip.background = element_blank(),         strip.text = element_blank())

d9d87f533e6b994ce120c8af9dc40dc1.png

往期内容

  1. 资源汇总 | 2022 木舟笔记原创推文合集(附数据及代码领取方式)

  2. CNS图表复现|生信分析|R绘图 资源分享&讨论群!

  3. R绘图 | 浅谈散点图及其变体的作图逻辑

  4. 这图怎么画| 有点复杂的散点图

  5. 这图怎么画 | 相关分析棒棒糖图

  6. 组学生信| Front Immunol |基于血清蛋白质组早期诊断标志筛选的简单套路

  7. (免费教程+代码领取)|跟着Cell学作图系列合集

  8. Q&A | 如何在论文中画出漂亮的插图?

  9. 跟着 Cell 学作图 | 桑葚图(ggalluvial)

  10. R实战 | Lasso回归模型建立及变量筛选

  11. 跟着 NC 学作图 | 互作网络图进阶(蛋白+富集通路)(Cytoscape)

  12. R实战 | 给聚类加个圈圈(ggunchull)

  13. R实战 | NGS数据时间序列分析(maSigPro)

  14. 跟着 Cell 学作图 | 韦恩图(ggVennDiagram)


8668cb19551323a61cff0bcb726cb813.png

木舟笔记矩阵

今天的文章
相关性热图分析_聚类分析热图解读分享到此就结束了,感谢您的阅读。

版权声明:本文内容由互联网用户自发贡献,该文观点仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 举报,一经查实,本站将立刻删除。
如需转载请保留出处:https://bianchenghao.cn/81256.html

(0)
编程小号编程小号

相关推荐

发表回复

您的电子邮箱地址不会被公开。 必填项已用 * 标注