pheatmap的annotation_color參數(shù)需要一個(gè)列表對(duì)象,并且列表名要與行和列注釋數(shù)據(jù)框的列名相同踱启,同時(shí)列表每個(gè)元素的是一個(gè)向量俏讹,向量名要與變量名相同,手動(dòng)設(shè)置很麻煩纵势,因此就寫了一個(gè)函數(shù)
可以自己上傳顏色踱阿,也可以用默認(rèn)的顏色
get_anno_for_heatmap2<-function(annocol,annorow=NULL,color=NULL,only.color=F){
require(plyr)
require(stringr)
if(is.null(color)){
require(RColorBrewer)
color=c(brewer.pal(12,"Set3"),brewer.pal(8,"Set2"),brewer.pal(9,"Set1"),brewer.pal(8,"Dark2"))
}
# annocolor=do.call(as.list,list(x=annocol))
# annocolor=lapply(annocolor,function(x){if(is.factor(x)){x=levels(x);a=color[1:length(x)];names(a)=x;return(a)}else{x=unique(x);a=color[1:length(x)];names(a)=x;return(a)}})
# if(!is.null(annorow)){
# annocolor.row<-do.call(as.list,list(x=annorow))
# annocolor.row=lapply(annocolor.row,function(x){if(is.factor(x)){x=levels(x);a=color[1:length(x)];names(a)=x;return(a)}else{x=unique(x);a=color[1:length(x)];names(a)=x;return(a)}})
# }else{annocolor.row=NULL}
# annocolor=c(annocolor,annocolor.row)
annocolor_col<-as.list(annocol)
annocolor_row<-as.list(annorow)
annocolor<-c(annocol,annorow)
annocolor<-lapply(annocolor,function(x){if(is.factor(x)){x=levels(x);return(x)}else{x=unique(x);return(x)}})
annocolor<-do.call(c,annocolor)
annocolor<-data.frame(var_name=as.factor(str_replace(names(annocolor),"[0-9]{1,}$","")),
var=annocolor,
color=color[1:length(annocolor)])
annocolor<-split(annocolor,annocolor$var_name)
annocolor<-lapply(annocolor,function(x){a=x$var;b=as.character(x$color);names(b)=a;return(b)})
if(only.color){
anno_res<-annocolor
}else{anno_res<-list(annocol=annocol,
annorow=annorow,
annocolor=annocolor)}
return(anno_res)
}