Mercurial > repos > greg > ideas
view create_heatmap.R @ 105:14659ab1e709 draft
Uploaded
author | greg |
---|---|
date | Tue, 14 Nov 2017 10:34:47 -0500 |
parents | |
children | c89bf5bf4661 |
line wrap: on
line source
#!/usr/bin/env Rscript suppressPackageStartupMessages(library("optparse")) option_list <- list( make_option(c("-i", "--input"), action="store", dest="input", help="IDEAS para file"), make_option(c("-o", "--output"), action="store", dest="output", help="Output PDF file") ) parser <- OptionParser(usage="%prog [options] file", option_list=option_list) args <- parse_args(parser, positional_arguments=TRUE) opt <- args$options create_heatmap<-function(data_matrix, statecolor=NULL, markcolor=NULL, cols=c("white","dark blue")) { k = dim(data_matrix)[2]; l = dim(data_matrix)[1]; p = (sqrt(9 + 8 * (k - 1)) - 3) / 2; m = as.matrix(data_matrix[,1+1:p]/data_matrix[,1]); marks = colnames(m); rownames(m) = paste(1:l-1," (", round(data_matrix[,1] / sum(data_matrix[,1]) * 10000) / 100, "%)", sep=""); pdf(file=opt$output); par(mar=c(6,1,1,6)); rg = range(m); colors = 0:100/100*(rg[2]-rg[1])+rg[1]; my_palette = colorRampPalette(cols)(n=100); defpalette = palette(my_palette); plot(NA, NA, xlim=c(0,p+0.7), ylim=c(0,l), xaxt="n", yaxt="n", xlab=NA, ylab=NA, frame.plot=F); axis(1, at=1:p-0.5, labels=colnames(m), las=2); axis(4, at=1:l-0.5, labels=rownames(m), las=2); rect(rep(1:p-1,l), rep(1:l-1,each=p), rep(1:p,l), rep(1:l,each=p), col=round((t(m)-rg[1])/(rg[2]-rg[1])*100)); if(length(statecolor)==0) { if(length(markcolor)==0) { markcolor=t(col2rgb(terrain.colors(ceiling(p))[1:p])); for(i in 1:length(marks)) { if(regexpr("h3k4me3",tolower(marks[i]))>0) { markcolor[i,]=c(255,0,0); } if(regexpr("h3k4me2",tolower(marks[i]))>0) { markcolor[i,]=c(250,100,0); } if(regexpr("h3k4me1",tolower(marks[i]))>0) { markcolor[i,]=c(250,250,0); } if(regexpr("h3k36me3",tolower(marks[i]))>0) { markcolor[i,]=c(0,150,0); } if(regexpr("h2a",tolower(marks[i]))>0) { markcolor[i,]=c(0,150,150); } if(regexpr("dnase",tolower(marks[i]))>0) { markcolor[i,]=c(0,200,200); } if(regexpr("h3k9ac",tolower(marks[i]))>0) { markcolor[i,]=c(250,0,200); } if(regexpr("h3k9me3",tolower(marks[i]))>0) { markcolor[i,]=c(100,100,100); } if(regexpr("h3k27ac",tolower(marks[i]))>0) { markcolor[i,]=c(250,150,0); } if(regexpr("h3k27me3",tolower(marks[i]))>0) { markcolor[i,]=c(0,0,200); } if(regexpr("h3k79me2",tolower(marks[i]))>0) { markcolor[i,]=c(200,0,200); } if(regexpr("h4k20me1",tolower(marks[i]))>0) { markcolor[i,]=c(50,200,50); } if(regexpr("ctcf",tolower(marks[i]))>0) { markcolor[i,]=c(200,0,250); } } } statecolor = stateColor(m, markcolor)[,2]; } rect(rep(p+0.2,l), 1:l-0.8, rep(p+0.8,l), 1:l-0.2, col=statecolor); palette(defpalette); dev.off(); #return(statecolor); } # Read the input. data_matrix <- read.table(opt$input, header=T); create_heatmap(data_matrix);