Mercurial > repos > greg > ideas
changeset 133:7d49fc24e06a draft
Uploaded
author | greg |
---|---|
date | Fri, 15 Dec 2017 10:25:34 -0500 |
parents | 8ce93420010c |
children | 91db24a1384d |
files | create_heatmap.R |
diffstat | 1 files changed, 87 insertions(+), 86 deletions(-) [+] |
line wrap: on
line diff
--- a/create_heatmap.R Tue Dec 12 10:47:26 2017 -0500 +++ b/create_heatmap.R Fri Dec 15 10:25:34 2017 -0500 @@ -11,112 +11,113 @@ args <- parse_args(parser, positional_arguments=TRUE) opt <- args$options -state_color <- function(statemean, markcolor=NULL) -{ - if(length(markcolor) == 0) { - markcolor = rep("", dim(statemean)[2]); - markcolor[order(apply(statemean, 2, sd), decreasing=T)] = hsv((1:dim(statemean)[2]-1) / dim(statemean)[2], 1, 1); - markcolor = t(col2rgb(markcolor)); +create_heatmap<-function(data_frame, output_file_name) { + # Plot a heatmap for a .para / .state combination + # based on the received data_frame which was created + # by reading the .para file. + num_columns = dim(data_frame)[2]; + num_rows = dim(data_frame)[1]; + p = (sqrt(9 + 8 * (num_columns - 1)) - 3) / 2; + data_matrix = as.matrix(data_frame[,1+1:p] / data_frame[,1]); + column_names(data_matrix) = column_names(data_frame)[1+1:p]; + marks = column_names(data_matrix); + row_names(data_matrix) = paste(1:num_rows, " (", round(data_frame[,1]/sum(data_frame[,1])*10000)/100, "%)", sep=""); + + # Open the output PDF file. + pdf(file=output_file_name); + # Set graphical parameters. + par(mar=c(6, 1, 1, 6)); + # Create a vector containing the minimum and maximum values in data_matrix. + min_max_vector = range(data_matrix); + # Define colors for the palette. + colors = 0:100 / 100 * (min_max_vector[2] - min_max_vector[1]) + min_max_vector[1]; + # Create the color palette. + my_palette = colorRampPalette(c("white", "dark blue"))(n=100); + defpalette = palette(my_palette); + # Plot the heatmap for the current .para / .state combination. + 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=column_names(data_matrix), las=2); + axis(4, at=1:num_rows-0.5, labels=row_names(data_matrix), las=2); + rect(rep(1:p-1, num_rows), rep(1:num_rows, each=p), rep(1:p, num_rows), rep(1:num_rows, each=p), + col=round((t(data_matrix)-min_max_vector[1])/(min_max_vector[2]-min_max_vector[1])*100)); + 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); + } + state_color = get_state_color(data_matrix, markcolor)[,2]; } + rect(rep(p+0.2,num_rows), 1:num_rows-0.8, rep(p+0.8,num_rows), 1:num_rows-0.2, col=state_color); + palette(defpalette); + dev.off(); +} - rg = apply(statemean, 1, range); - mm = NULL; +get_state_color<-function(statemean, markcolor) { + rg=apply(statemean, 1, range); + mm=NULL; for(i in 1:dim(statemean)[1]) { - mm = rbind(mm, (statemean[i,] - rg[1,i] + 1e-10) / (rg[2,i] - rg[1,i] + 1e-10)); + mm = rbind(mm, (statemean[i,]-rg[1,i]+1e-10)/(rg[2,i]-rg[1,i]+1e-10)); } - mm = mm^6; + mm = mm^5; if(dim(mm)[2] > 1) { mm = mm / (apply(mm, 1, sum) + 1e-10); } mycol = mm%*%markcolor; s = apply(statemean, 1, max); - s = (s - min(s)) / (max(s) - min(s) + 1e-10); + s = (s-min(s)) / (max(s)-min(s) + 1e-10); + mycol = round(255-(255-mycol)*s/0.5); + mycol[mycol<0] = 0; + rt = paste(mycol[,1], mycol[,2], mycol[,3], sep=","); h = t(apply(mycol, 1, function(x){rgb2hsv(x[1], x[2], x[3])})); - h[,2] = h[,2] * s; h = apply(h, 1, function(x){hsv(x[1], x[2], x[3])}); - rt = cbind(apply(t(col2rgb(h)), 1, function(x){paste(x, collapse=",")}) ,h); + rt = cbind(rt, h); return(rt); } -create_heatmap<-function(data_frame, output_file_name, statecolor=NULL, markcolor=NULL, cols=c("white","dark blue")) { - k = dim(data_frame)[2]; - l = dim(data_frame)[1]; - p = (sqrt(9 + 8 * (k - 1)) - 3) / 2; - data_matrix = as.matrix(data_frame[,1+1:p] / data_frame[,1]); - colnames(data_matrix) = colnames(data_frame)[1+1:p]; - marks = colnames(data_matrix); - rownames(data_matrix) = paste(1:l," (", round(data_frame[,1] / sum(data_frame[,1]) * 10000) / 100, "%)", sep=""); - pdf(file=output_file_name); - par(mar=c(6, 1, 1, 6)); - rg = range(data_matrix); - 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(data_matrix), las=2); - axis(4, at=1:l-0.5, labels=rownames(data_matrix), 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(data_matrix)-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); - } - } - } - sc = state_color(data_matrix, markcolor)[,2]; - } - rect(rep(p+0.2,l), 1:l-0.8, rep(p+0.8,l), 1:l-0.2, col=sc); - palette(defpalette); - dev.off(); -} - # Read the inputs. para_files <- list.files(path=opt$input_dir, pattern="\\.para$", full.names=TRUE); for (i in 1:length(para_files)) { para_file <- para_files[i]; para_file_base_name <- strsplit(para_file, split="/")[[1]][2] output_file_name <- gsub(".para", ".pdf", para_file_base_name) - output_file_path <- paste(opt$output_dir, "/", output_file_name, sep=""); + output_file_path <- paste(opt$output_dir, output_file_name, sep="/"); data_frame <- read.table(para_file, comment="!", header=T); create_heatmap(data_frame, output_file_path); }