• 主页
  • 课程

    关于课程

    • 课程归档
    • 成为一名讲师
    • 讲师信息
    同等学历教学

    同等学历教学

    免费
    阅读更多
  • 特色
    • 展示
    • 关于我们
    • 问答
  • 事件
  • 个性化
  • 博客
  • 联系
  • 站点资源
    有任何问题吗?
    (00) 123 456 789
    weinfoadmin@weinformatics.cn
    注册登录
    恒诺新知
    • 主页
    • 课程

      关于课程

      • 课程归档
      • 成为一名讲师
      • 讲师信息
      同等学历教学

      同等学历教学

      免费
      阅读更多
    • 特色
      • 展示
      • 关于我们
      • 问答
    • 事件
    • 个性化
    • 博客
    • 联系
    • 站点资源

      未分类

      • 首页
      • 博客
      • 未分类
      • R语言-制作热图

      R语言-制作热图

      • 发布者 Sam 蔡
      • 分类 未分类
      • 日期 2019年10月25日
      • 评论 0评论

      热图(heatmap)用不同的颜色和颜色的深浅来展示数据之间的差异,直观、美丽、大方,深受科研工作者的喜爱,尤其是转录组类的文章里,几乎必有一幅热图用来展示差异表达基因。很多工具都可以完成热图的制作,比如我们最常使用的excel;还有一款比较好用的制作热图的工具是CJ大神开发的工具TBtools,在公众号生信札记有比较详细的教程,感兴趣的可以自行搜索相关教程;今天这篇文章主要介绍利用R语言的 pheatmap 包和ggplot2 包制作热图的简单小例子。pheatmap是R语言中专门用来制作热图的工具包;ggplot2是R语言中最常用的可视化工具包。R语言中还有一个专门用来绘制热图的工具包ComplexHeatmap,功能比pheatmap强大,帮助文档非常详细,感兴趣的可以自行查阅帮助文档,在这篇文章中就不做过多介绍。

      利用pheatmap制作热图

      这部分内容主要来自教程 https://flowingdata.com/2010/01/21/how-to-make-a-heatmap-a-quick-and-easy-solution/。原文用到的数据集:NBA basketball statistics from last season。可是回头再看这篇教程的写作时间已经是2010年了。“上一个赛季(lastseason)”那岂不是要追溯到2008-2009赛季了?那个时候科比还在,卡特未老,麦迪虽已巅峰不在,干拔跳投却依旧销魂;艾弗森虽然远赴掘金,但那份桀骜与坚持依旧感动着无数球迷;那时候纳什还在太阳,小斯还是劲爆的小霸王,再加上防守悍将马里昂,即使是与拥有GDP的马刺也能大战上六场;那时的姚明带领火箭闯进了季后赛第二轮,并与当年的总冠军湖人队大战了7场 ,同时还上演了王者归来的震撼表演;那时的隆多还在绿军,风城之子才刚刚在芝加哥联合中心球馆绽放…… 那是最好的时代 — It was the best of times.

      哈哈哈……好像有点扯远了,今天的主题是学习R语言制作热图的,不是来怀旧的哈!

      读入数据、查看数据维度、查看变量名称
      nba<- read.csv("http://datasets.flowingdata.com/ppg2008.csv",sep=",")
      
      dim(nba)
      
      colnames(nba)

      数据集包括21个变量,总共50个样本,各个变量的含义如图二

      接下来通过散点图添加标签的方式看一下数据集里都包括哪些人

      Name<-gsub("","\n",nba$Name)
      
      df<-data.frame(A=sort(rep(1:10,5)),B=rep(1:10,5),Name=Name)
      
      head(df)
      
      library(ggplot2)
      
      ggplot(data=df,aes(x=A,y=B))+geom_point()+
      
        geom_text(aes(label=Name),vjust=1.1)+
      
        xlim(0,11)+ylim(0,10)+theme_bw()+
      
        labs(x="",y="")

      韦德、科比、诺维斯基。。。满眼都是青春的样子呀!

      小知识点

      gsub()函数用来将球员名字中的空格替换为换行符,第一个位置是要被替换的字符;第二个位置是替换为的字符;第三个位置是要替换的内容。

      热图制作

      数据格式转换

      首先对数据简单处理,包括将数据按照场均得分重新排序;行名改为球员的名字;去掉数据中的第一列;然后把最初读入的数据框转化为pheatmap()函数要求的矩阵格式

      nba<- nba[order(nba$PTS),]
      
      row.names(nba)<- nba$Name
      
      nba<- nba[,2:20]
      
      nba_matrix<- data.matrix(nba)
      热图制作

      单一函数出图

      library(pheatmap)
      
      pheatmap(nba_matrix)

      接下来通过参数调整细节,包括去掉行和列的聚类(因为这组数据里没有没有太大的意义,转录组数据的如图聚类通常保留)、对数据按照列进行标准化、去掉图例、改变配色等,还有其他参数调节可以通过help(package=”pheatmap”)函数查阅帮助文档

      pheatmap(nba_matrix,cluster_cols= F, cluster_rows = F, col=cm.colors(256), scale="column", legend = F)

      这里遇到的问题:原教程中输出的图片是按照场均得分从大到小由上往下依次排列的,自己重复出来的是由小到大排列,如何更改顺序暂时还不知道如何实现。

      基于ggplot2绘制热图(数据集同上)

      ggplot2绘制热图使用到的函数是geom_tile()函数,简单理解就是根据位置坐标添加色块

      geom_tile()函数简单小例子
      library(ggplot2)
      
      library(ggpubr)
      
      p1<-ggplot(data=df,aes(x=A,y=B))+
      
       geom_point()+ggtitle("geom_point()")
      
      p2<-ggplot(data=df,aes(x=A,y=B))+
      
        geom_tile()+ggtitle("geom_tile()")
      
      ggarrange(p1,p2,ncol=2,labels=c("A","B"))
      绘图

      这部分内容主要来自教程 https://www.r-bloggers.com/ggplot2-quick-heatmap-plotting/

      代码

      library(plyr)
      
      library(reshape)
      
      library(ggplot2)
      
      nba<- read.csv("http://datasets.flowingdata.com/ppg2008.csv",sep=",")
      
      nba$Name<- with(nba, reorder(Name, PTS))
      
      nba.m<- melt(nba)
      
      nba.m<- ddply(nba.m, .(variable), transform,rescale = rescaler(value))
      
      p<-ggplot(nba.m,aes(variable, Name)) + 
      
        geom_tile(aes(fill = rescale), colour ="white") + 
      
        scale_fill_gradient(low = "white",high = "steelblue")+
      
        theme_grey(base_size = 9) + 
      
        labs(x = "", y = "") + 
      
        scale_x_discrete(expand = c(0, 0)) +
      
        scale_y_discrete(expand = c(0, 0)) + 
      
        theme(legend.position ="none",axis.ticks = element_blank(), 
      
             axis.text.x = element_text(size =base_size *0.8, angle = 330, hjust = 0, 
      
      colour ="grey50"))

      melt()、rescaler()函数来自reshape包

      ddply()函数来自plyr包

      这三个函数的用法自己还不是非常明白;印象里这两个包已经比较老了,应该是已经有新的包替代了

      相对于原教程改动的地方

      原文rescaler()函数少了一个字母r

      theme_blank()和theme_text()函数已经不再使用,相应的替换为element_blank() 和element_text()

      小知识点

      ggplot作图底部通常不贴着x轴,比如柱形图

      df<-data.frame(A=sample(1:10,5),
      
                     B=LETTERS[1:5])
      
      ggplot(data=df,aes(x=B,y=A))+geom_bar(stat="identity")

      请关注“恒诺新知”微信公众号,感谢“R语言“,”数据那些事儿“,”老俊俊的生信笔记“,”冷🈚️思“,“珞珈R”,“生信星球”的支持!

      • 分享:
      Sam 蔡
      Sam 蔡

      上一篇文章

      R语言-定量变量的统计描述(二)
      2019年10月25日

      下一篇文章

      送你个对象
      2019年10月27日

      你可能也喜欢

      2-1675088548
      lncRNA和miRNA生信分析系列讲座免费视频课和课件资源包,干货满满
      30 1月, 2023
      9-1675131201
      如何快速批量修改 Git 提交记录中的用户信息
      26 1月, 2023
      8-1678501786
      肿瘤细胞通过改变CD8+ T细胞中的丙酮酸利用和琥珀酸信号来调控抗肿瘤免疫应答。
      7 12月, 2022

      留言 取消回复

      要发表评论,您必须先登录。

      搜索

      分类

      • R语言
      • TCGA数据挖掘
      • 单细胞RNA-seq测序
      • 在线会议直播预告与回放
      • 数据分析那些事儿分类
      • 未分类
      • 生信星球
      • 老俊俊的生信笔记

      投稿培训

      免费

      alphafold2培训

      免费

      群晖配置培训

      免费

      最新博文

      Nature | 单细胞技术揭示衰老细胞与肌肉再生
      301月2023
      lncRNA和miRNA生信分析系列讲座免费视频课和课件资源包,干货满满
      301月2023
      如何快速批量修改 Git 提交记录中的用户信息
      261月2023
      logo-eduma-the-best-lms-wordpress-theme

      (00) 123 456 789

      weinfoadmin@weinformatics.cn

      恒诺新知

      • 关于我们
      • 博客
      • 联系
      • 成为一名讲师

      链接

      • 课程
      • 事件
      • 展示
      • 问答

      支持

      • 文档
      • 论坛
      • 语言包
      • 发行状态

      推荐

      • iHub汉语代码托管
      • iLAB耗材管理
      • WooCommerce
      • 丁香园论坛

      weinformatics 即 恒诺新知。ICP备案号:粤ICP备19129767号

      • 关于我们
      • 博客
      • 联系
      • 成为一名讲师

      要成为一名讲师吗?

      加入数以千计的演讲者获得100%课时费!

      现在开始

      用你的站点账户登录

      忘记密码?

      还不是会员? 现在注册

      注册新帐户

      已经拥有注册账户? 现在登录

      close
      会员购买 你还没有登录,请先登录
      • ¥99 VIP-1个月
      • ¥199 VIP-半年
      • ¥299 VIP-1年
      在线支付 激活码

      立即支付
      支付宝
      微信支付
      请使用 支付宝 或 微信 扫码支付
      登录
      注册|忘记密码?