pheatmap
ComplexHeatmap handbook
中文介绍
实例
我的简单一个例子，注意只要理解注释文件要与heatmap文件列名行名一致就行，这一点与pheatmap其实是一致的
rm(list=ls())
suppressMessages(library(ComplexHeatmap))
suppressMessages(library(circlize))
suppressMessages(library(pheatmap))
suppressMessages(library(RColorBrewer))
pathway_data<-read.table("～/Modules_list/IPA/modules_all_IPA.txt",row.names = 1,sep = "\t",check.names = F,header = T)
nes<-read.csv("～/enrichment_nes.csv",check.names = F,header = T,row.names = 2)
padj<-read.csv("～/enrichment_padj.csv",check.names = F,header = T,row.names = 2)
precentage<-read.table("～/Modules_list/module_precentage.txt",sep="\t",row.names = 1,header =T )
precentage<-precentage[row.names(nes),]
ann<-data.frame(nes$Lob_Inflam,padj$Lob_Inflam)
row.names(ann)<-row.names(nes)
colnames(ann)<-c("NES","padj")
ann<-cbind(ann,precentage)
#define colors
col_fun1 = colorRamp2(c(10, 10, 250), c("#54C6DC", "black", "yellow"))
col_fun2 = colorRamp2(c(0, 100), c("white", "#E7298A"))
col_fun3 =colorRamp2(c(-3, 2.2), c("#BEBADA","#FB8072"))
col1 = colorRamp2(c(0, 5,15), c("navy", "white","firebrick3"))
col2=brewer.pal(5, "Set3")
pathway_data<-pathway_data[1:20,]
ha1 = HeatmapAnnotation(Novel_genes = anno_barplot(ann$nove_gene, height = unit(1.5, "cm"),
gp = gpar(fill = col2)))
ha2=HeatmapAnnotation(Known_transcripts = ann$known_transcripts,
Novel_transcripts = ann$novel_transcripts,
Lob_Inflam_NES=ann$NES,
col = list(Known_transcripts=col_fun1,Novel_transcripts=col_fun2,Lob_Inflam_NES=col_fun3),
height = unit(0.5, "cm"))
Heatmap(pathway_data, top_annotation = ha1,bottom_annotation = ha2,
cluster_rows=T,cluster_columns = F,
col=col1)
例子2
data_matrix<-data[,c(3,6)]
col_fun1 = colorRamp2(c(0,4), c("white", "#E7298A"))
ha=rowAnnotation( Events=data$Feature_type,
Gene_type = data$Gene_type,
log_pvalue = data$`-log10(pvalue)`,
col = list(Events=c("ES"="#D9D9D9","IR"="#BC80BD","ALT3"="#80B1D3","ALT5"="#FFED6F"),
log_pvalue=col_fun1,
Gene_type=c("lncRNA"= "#FFFFB3" , "protein_coding"="#8DD3C7")))
#row_ha = rowAnnotation(log_pvalue = data$`-log10(pvalue)`,Gene_type = data$Gene_type)
col1 = colorRamp2(c(0, 0.4,1), c("navy", "white","firebrick3"))
#col1 = colorRamp2(c(0, 0.5,1), c("blue", "black","yellow"))
#col1 = colorRamp2(c(0,1), c("blue","yellow"))
Heatmap(data_matrix, right_annotation = ha,
cluster_rows=T,cluster_columns = F,
col=col1,border = F)
image.png
例子3
prepare_heatmap_data<-function(data_median){
data_median_rt<-data_median %>% spread(key = transcript_id,-new_sample)
row.names(data_median_rt)<-as.character(data_median_rt$new_sample)
data_median_rt<-data_median_rt[,-1]
data_median_rt_zsocre<-t(apply(data_median_rt,2,FUN = function(x){return(scale(x,center = T,scale = T))}))
colnames(data_median_rt_zsocre)<-as.character(row.names(data_median_rt))
colnames(data_median_rt_zsocre)<-sapply(colnames(data_median_rt_zsocre),FUN = function(x){return(gsub('.$', '', x))})
return(data_median_rt_zsocre)
}
human_data_zscore<-na.omit(prepare_heatmap_data(human_data_median))
prepare_ann<-function(degs,data_zscore){
row_ann<-degs[,c("transcript_id","type","class_code_define")]
row.names(row_ann)<-as.character(row_ann$transcript_id)
row_ann<-row_ann[row.names(data_zscore),]
col_ann<-data.frame(samples=colnames(data_zscore),treatment=sapply(colnames(data_zscore),FUN = function(x){return(gsub('.$', '', x))}))
row.names(col_ann)<-as.character(colnames(data_zscore))
return(list(row_ann=row_ann,col_ann=col_ann))
}
human_row_ann<-prepare_ann(degs=human_degs,data_zscore = human_data_zscore)$row_ann
human_col_ann<-prepare_ann(degs=human_degs,data_zscore = human_data_zscore)$col_ann
mouse_row_ann<-prepare_ann(degs=mouse_degs,data_zscore = mouse_data_zscore)$row_ann
mouse_col_ann<-prepare_ann(degs=mouse_degs,data_zscore = mouse_data_zscore)$col_ann
pal_npg("nrc")(6)
pal_jco()(6)
human_row_ha = rowAnnotation(Transcript_Type = human_row_ann$type,Type = human_row_ann$class_code_define,
col = list(Transcript_Type = c("lncRNA" ="red", "others" = "#3C5488FF", "processed_pseudogene" = "#00A087FF","protein_coding"="grey"),
Type=c("Different" = "#EFC000FF", "Matched" = "#0073C2FF","Uncertain" = "#868686FF") ))
human_col_ha=columnAnnotation(Treatment=human_col_ann$treatment,
col = list(Treatment = c("Fast" = "#E64B35FF","AL"="#4DBBD5FF"))
)
col1 = colorRamp2(c(-2, 0,2), c("navy", "white","firebrick3"))
Heatmap(human_data_zscore, right_annotation = human_row_ha,top_annotation = human_col_ha,
cluster_rows=T,cluster_columns = T,
col=col1,border = F,show_row_names =F)
image.png
例子4
set.seed(14437)
frequence_degs_zscore_matrix<-as.matrix(frequence_degs_zscore[,1:8])
ha1 = HeatmapAnnotation(Gene_Change = anno_summary(height = unit(1, "cm")))
ht_list1<-Heatmap(frequence_degs_zscore$degs_status, name = "Gene_Change", top_annotation = ha1, width = unit(1, "cm"),col =c("Yes"= "#FFED6F", "Not"="#8DD3C7"))
ha2 = HeatmapAnnotation(summary = anno_summary(height = unit(1, "cm")))
ht_list2<-Heatmap(frequence_degs_zscore$motif, name = "Motif", top_annotation = ha2, width = unit(1, "cm"),col = c("GGACT" = "#EFC000FF", "GGACC" = "#0073C2FF","GGACA" = "#868686FF","AGACT"="#DF3D8C"))
# ha3 = HeatmapAnnotation(summary = anno_summary(height = unit(1, "cm")))
# ht_list3<-Heatmap(frequence_degs_zscore$new_type, name = "Gene_Type", top_annotation = ha3, width = unit(1, "cm"),col = c("lncRNA" ="red", "others" = "#3C5488FF", "processed_pseudogene" = "#00A087FF","protein_coding"="grey"))
col = colorRamp2(c(-2, 0,2), c("navy", "white","firebrick3"))
ht_list_main= Heatmap(frequence_degs_zscore_matrix, name = "Z-score",col = col,
rect_gp =gpar(col = "white", lwd = 0.01),
cluster_rows=T,cluster_columns = T,show_row_names=F,border="black",border_gp = gpar(col = "black", lty = 2),
width = 1,height = 2)
ht_list_main+ht_list1+ht_list2
image.png
环状heatmap
suppressMessages(library(dendextend))
suppressMessages(library(circlize))
suppressMessages(library(ComplexHeatmap))
tpm_pick_zsocre<-t(scale(t(tpm_pick)))
dend<-as.dendrogram(hclust(dist(tpm_pick_zsocre)))
#check the dend list to determine the n
n=4
dend<-dend %>% set("branches_k_color",k=n)
plot(dend)
mat2<-t(tpm_pick_zsocre[order.dendrogram(dend),])
lable1 <- row.names(mat2)
lable2 <- colnames(mat2)
col_fun <- colorRamp2(c(-2, 0, 2), c("navy", "white", "firebrick3"))
col_mat <- col_fun(mat2)
nr <- nrow(mat2)
nc <- ncol(mat2)
###start to plot
#set the par
par(mar <- c(0,0,0,0)) # the empty are
circos.clear();
circos.par(canvas.xlim = c(-1,1),#the smaller number the bigger figure
canvas.ylim = c(-1,1),
cell.padding = c(0,0,0,0),
gap.degree = 90)
factors <- "a"
circos.initialize(factors, xlim = c(0, ncol(mat2)))
#prepaer the main part
circos.track(ylim = c(0, nr),bg.border = NA,track.height = 0.1*nr,
panel.fun = function(x, y) {
for(i in 1:nr) {
circos.rect(xleft = 1:nc - 1, ybottom = rep(nr - i, nc),
xright = 1:nc, ytop = rep(nr - i + 1, nc),
border = "black",#change the colr
col = col_mat[i,])
circos.text(x = nc,
y = 8.1 -i,#you can chenge here to ajust the location of your sample name
labels = lable1[i],
facing = "downward", niceFacing = TRUE,
cex = 0.5,#chang the size
adj = c(-0.2, 0))
}
})
#the leable outside the heatmap
for(i in 1:nc){
circos.text(x = i-0.35,#chang the relative location of leable to the heatmap cell
y = 7,
labels = lable2[i],
facing = "clockwise", niceFacing = TRUE,
cex = 0.4,adj = c(-0.6, 0))#use the adjust to ajust the location
}
##add the hcluster inside the heatmap
max_height <-max(attr(dend, "height"))
circos.track(ylim = c(0, max_height),bg.border = NA,track.height = 0.1,#ajust the height value to put it inside
panel.fun = function(x, y){
circos.dendrogram(dend = dend,
max_height = max_height)
})
circos.clear()
###add the legend
lgd <- Legend(at = c(-2,-1, 0, 1, 2), col_fun = col_fun,
title_position = "topcenter",title = "Z-score")
draw(lgd, x = unit(0.6, "npc"), y = unit(0.8, "npc"))
image.png
