# 跟着Nature Methods学画图：R语言画热图（pheatmap）展示基因表达量

2021/02/20 19:37

## 我们用这个表达量文件先做一个简单的热图

###### 读入数据
df<-read.csv("NM/NK_markers_1.csv",header=T,row.names = 1)head(df)
###### 最简单的热图
library(pheatmap)pdf(file = "NM/hp-1.pdf",width = 4,height = 10)pheatmap(df,fontsize = 3)dev.off()

add.flag <- function(pheatmap,                     kept.labels,                     repel.degree) {    # repel.degree = number within [0, 1], which controls how much   #                space to allocate for repelling labels.  ## repel.degree = 0: spread out labels over existing range of kept labels  ## repel.degree = 1: spread out labels over the full y-axis    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)}

source("useful_R_function/add_flag.r")

gene_name<-sample(rownames(df),10)

source("useful_R_function/add_flag.r")library(grid)gene_name<-sample(rownames(df),10)p1<-pheatmap(df)add.flag(p1,         kept.labels = gene_name,         repel.degree = 0.2)

###### 接下来是简单的美化

source("useful_R_function/add_flag.r")df<-read.csv("NM/NK_markers_1.csv",header=T,row.names = 1)head(df)library(pheatmap)library(grid)gene_name<-sample(rownames(df),10)paletteLength <- 100mycolor<-colorRampPalette(c("blue","white","red"))(100)mycolormyBreaks <- unique(c(seq(min(df), 0, length.out=ceiling(paletteLength/2) + 1),                      seq(max(df)/paletteLength, max(df),                         length.out=floor(paletteLength/2))))p1<-pheatmap(df,color = mycolor,breaks = myBreaks)pdf(file = "NM/hp-2.pdf",width = 4,height = 8)add.flag(p1,         kept.labels = gene_name,         repel.degree = 0.2)dev.off()

0
0 收藏

0 评论
0 收藏
0