首页> 关于我们 >新闻中心>技术分享>新闻详情

跟着nature medicine学作图:具有"弹簧"属性的热图

2021-05-20

今天结合nature medicine中的一篇文章,和大家分享下热图的绘制,主要亮点功能是:

(1)名称太多看不清,如何只展示特定的名称?

(2)数据太密集,如何快速调整单元格的宽和高?



论文页面

image.png

文章链接https://www.nature.com/articles/s41591-020-0944-y

代码及数据https://github.com/ajwilk/2020_Wilk_COVID

拟复现图片样式:Fig2中的热图样式

image.png

图1 拟复现图片样式

代码实现

使用数据:数据大家可以通过上述链接下载,附件是一个rds文件(1.5G,一般电脑慎加载会卡死的), 我们已经下载处理好了一个示例数据(如图2所示)。大家可以通过基因云(https://www.genescloud.cn)的云端文件进行选择使用, 具体可参考下图7 云端数据选择 


name

C1A

C1B

C2

C3

C4

C5

C6

C7

ACKR2

-3.606

-2.4

0

0

-3.273

-3.701

-3.701

0

amphetamine

-2.491

-2.491

-1.944

-2.303

-2.491

-2.664

-2.094

0

anisomycin

-2.218

-2.218

-1.243

-2.218

-2.218

-2.433

-1.074

-0.506

APEX1

-2.236

-2.236

0

-2

-2.236

-2.236

-2

0

arachidonic acid

-2.403

-2.063

-1.679

-1.806

-2.19

-2.19

-0.993

-1.894

atorvastatin

-2.967

-3.13

-2.236

-1.569

-3.13

-2.828

-1.906

-2

bicuculline

-2.942

-2.469

-0.728

-1.107

-2.469

-1.709

-0.397

0

bucladesine

-1.792

-1.611

-0.733

-1.392

-2.718

-2.385

-1.239

-0.179

图2 示例数据

按照惯例,我们先画一个基本的热图。

library(pheatmap)     library(grid)     mat <- read.delim("heatmap.txt",sep="\t",row.names=1) pheatmap(mat)


image.png

图3 初始热图


上图样式不是很好看,存在以下几点需要完善:①颜色不是很好看,且有灰色边框线条;②行名有很多重叠无法识别;③ 热图缺少分组信息, 接下来我们通过代码继续完善。


# 设置颜色 color <- c("blue", "white", "red") myColor <- colorRampPalette(color)(100) # 添加分组信息 annotation_col <- data.frame(Group = factor(rep(c("T", "C"),4))) rownames(annotation_col) <- colnames(mat) # 绘制热图 p1 <- pheatmap(mat,color = myColor,               border_color=NA,               annotation_col = annotation_col)  


image.png

图4 美化后热图一


接下来通过调整单元格高度,使得文字错开。


# 调整单元格高度,避免文字重叠 p1 <- pheatmap(mat,color = myColor,               border_color=NA,               annotation_col = annotation_col,               cellheight=10)



image.png

图5 美化后热图二


上图通过调整单元格高度调整,文字是清晰可分辨了,但是图片的整体高度会被拉长,放在文章里面不太方便查看。那么我们是否可以只展示特定的行名呢? 首先我们来看下文中提及的,可以实现只展示特定行名的函数:

# 展示特定行名函数 add.flag <- function(pheatmap,                     kept.labels,                     repel.degree) {    heatmap <- pheatmap$gtable    new.label <- heatmap$grobs[[which(heatmap$layout$name == "row_names")]]    # keep only labels in kept.labels, replace the rest with ""  new.label$label <- ifelse(new.label$label %in% kept.labels,                            new.label$label, "")    # calculate evenly spaced out y-axis positions  repelled.y <- function(d, d.select, k = repel.degree){    # d = vector of distances for labels    # d.select = vector of T/F for which labels are significant        # recursive function to get current label positions    # (note the unit is "npc" for all components of each distance)    strip.npc <- function(dd){      if(!"unit.arithmetic" %in% class(dd)) {        return(as.numeric(dd))      }            d1 <- strip.npc(dd$arg1)      d2 <- strip.npc(dd$arg2)      fn <- dd$fname      return(lazyeval::lazy_eval(paste(d1, fn, d2)))    }        full.range <- sapply(seq_along(d), function(i) strip.npc(d[i]))    selected.range <- sapply(seq_along(d[d.select]), function(i) strip.npc(d[d.select][i]))        return(unit(seq(from = max(selected.range) + k*(max(full.range) - max(selected.range)),                    to = min(selected.range) - k*(min(selected.range) - min(full.range)),                    length.out = sum(d.select)),                "npc"))  }  new.y.positions <- repelled.y(new.label$y,                                d.select = new.label$label != "")  new.flag <- segmentsGrob(x0 = new.label$x,                           x1 = new.label$x + unit(0.15, "npc"),                           y0 = new.label$y[new.label$label != ""],                           y1 = new.y.positions)    # shift position for selected labels  new.label$x <- new.label$x + unit(0.2, "npc")  new.label$y[new.label$label != ""] <- new.y.positions    # add flag to heatmap  heatmap <- gtable::gtable_add_grob(x = heatmap,                                     grobs = new.flag,                                     t = 4,                                     l = 4  )    # replace label positions in heatmap  heatmap$grobs[[which(heatmap$layout$name == "row_names")]] <- new.label    # plot result  grid.newpage()  grid.draw(heatmap)    # return a copy of the heatmap invisibly  invisible(heatmap) }

函数写好了,接下来我们看看具体效果。本示例随机抽取20个行名,添加到原来的热图中。具提代码如下,最终效果图如图6所示。

# 这里随机抽取20个基因进行展示 gene_name<-sample(rownames(mat),20) add.flag(p1,kept.labels = gene_name,repel.degree = 0.2)


image.png

图6 美化后热图三


到此我们就成功的通过代码实现了一幅含有分组信息,只展示特定行名的热图,那么如何不通过代码实现呢?接下来,给大家分享下基因云(https://www.genescloud.cn)的“交互热图”,帮助你“0”代码快速制作漂亮的上述图表,同时还提供多种样式的在线调整。


无代码实现


1 准备数据

为了方便大家学习实践,基因云平台已整合该文章数据,进入“交互热图”绘图页面,直接通过【文件上传→云端文件→公共数据】按照路径: Home>ref_data>COVID-19_data>交互热图,即可选择使用。



image.png

image.png

图7 云端数据选择

2 提交绘图

选择好数据和分组文件后,一键提交绘图。

image.png


图8 快速提交页面

3 参数调整

(1)显示特定基因名称:在图表调整里面,选择【显示名称→行/行列】,下方会出现所有行名列表,可随意勾选你想要展示的名称。

2.gif

图9 显示特定基因名称


(2)随意伸缩单元格宽高:在图表调整栏,随意拖动【单元格宽度/高度】对应的滑动控制条,可随意更改热图单元格的宽和高。

3.gif

图10 调整单元格长宽


赶紧来试一试吧,百度搜索“派森诺基因云”或者直接访问https://www.genescloud.cn/home,进入“云图汇”搜索“交互热图”尝试体验,并提宝贵建议至平台消息中心-》反馈列表,或者发送到邮箱: gc_support@personalbio.cn。"派森诺基因云" 一直持续上心上新,接下来会有更多好图好工具陆续和大家见面,欢迎大家关注并进行体验。