Mercurial > repos > greg > ideas

comparison create_heatmap.R @ 137:3180393013cc draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author greg
date Mon, 18 Dec 2017 14:45:32 -0500
parents 8d41990f4fc5
children 17e8829bbae2
comparison
equal deleted inserted replaced
136:8d41990f4fc5 137:3180393013cc
1 #!/usr/bin/env Rscript 1 #!/usr/bin/env Rscript
2 2
3 suppressPackageStartupMessages(library("optparse")) 3 suppressPackageStartupMessages(library("optparse"))
4 4
5 option_list <- list( 5 option_list <- list(
6 make_option(c("-i", "--input_dir"), action="store", dest="input_dir", help="IDEAS para files directory"), 6 make_option(c("-i", "--input_dir"), action="store", dest="input_dir", help="IDEAS para files directory"),
7 make_option(c("-o", "--output_dir"), action="store", dest="output_dir", help="PDF output directory") 7 make_option(c("-o", "--output_dir"), action="store", dest="output_dir", help="PDF output directory")
8 ) 8 )
9 9
10 parser <- OptionParser(usage="%prog [options] file", option_list=option_list) 10 parser <- OptionParser(usage="%prog [options] file", option_list=option_list)
11 args <- parse_args(parser, positional_arguments=TRUE) 11 args <- parse_args(parser, positional_arguments=TRUE)
12 opt <- args$options 12 opt <- args$options
14 create_heatmap<-function(data_frame, output_file_name) { 14 create_heatmap<-function(data_frame, output_file_name) {
15 # Plot a heatmap for a .para / .state combination 15 # Plot a heatmap for a .para / .state combination
16 # based on the received data_frame which was created 16 # based on the received data_frame which was created
17 # by reading the .para file. 17 # by reading the .para file.
18 num_columns = dim(data_frame)[2]; 18 num_columns = dim(data_frame)[2];
19 cat("num_columns: ", num_columns, "\n");
20 num_rows = dim(data_frame)[1]; 19 num_rows = dim(data_frame)[1];
21 cat("num_rows: ", num_rows, "\n");
22 p = (sqrt(9 + 8 * (num_columns-1)) - 3) / 2; 20 p = (sqrt(9 + 8 * (num_columns-1)) - 3) / 2;
23 cat("9 + 8 * (num_columns-1): ", 9 + 8 * (num_columns-1), "\n");
24 cat("sqrt(9 + 8 * (num_columns-1)): ", sqrt(9 + 8 * (num_columns-1)), "\n");
25 cat("p: ", p, "\n");
26 data_matrix = as.matrix(data_frame[,1+1:p] / data_frame[,1]); 21 data_matrix = as.matrix(data_frame[,1+1:p] / data_frame[,1]);
27 cat("dim(data_matrix)[1]: ", dim(data_matrix)[1], "\n");
28 cat("dim(data_matrix)[2]: ", dim(data_matrix)[2], "\n");
29 colnames(data_matrix) = colnames(data_frame)[1+1:p]; 22 colnames(data_matrix) = colnames(data_frame)[1+1:p];
30 cat("colnames(data_matrix): ", colnames(data_matrix), "\n");
31 histone_marks = colnames(data_matrix); 23 histone_marks = colnames(data_matrix);
32 cat("histone_marks: ", histone_marks, "\n");
33 rownames(data_matrix) = paste(1:num_rows-1, " (", round(data_frame[,1]/sum(data_frame[,1])*10000)/100, "%)", sep=""); 24 rownames(data_matrix) = paste(1:num_rows-1, " (", round(data_frame[,1]/sum(data_frame[,1])*10000)/100, "%)", sep="");
34 cat("rownames(data_matrix): ", rownames(data_matrix), "\n");
35 # Open the output PDF file. 25 # Open the output PDF file.
36 pdf(file=output_file_name); 26 pdf(file=output_file_name);
37 # Set graphical parameters. 27 # Set graphical parameters.
38 par(mar=c(6, 1, 1, 6)); 28 par(mar=c(6, 1, 1, 6));
39 # Create a vector containing the minimum and maximum values in data_matrix. 29 # Create a vector containing the minimum and maximum values in data_matrix.
40 min_max_vector = range(data_matrix); 30 min_max_vector = range(data_matrix);
41 cat("min_max_vector: ", min_max_vector, "\n");
42 # Create a color palette. 31 # Create a color palette.
43 my_palette = colorRampPalette(c("white", "dark blue"))(n=100); 32 my_palette = colorRampPalette(c("white", "dark blue"))(n=100);
44 defpalette = palette(my_palette); 33 defpalette = palette(my_palette);
45 # Plot the heatmap for the current .para / .state combination. 34 # Plot the heatmap for the current .para / .state combination.
46 plot(NA, NA, xlim=c(0, p+0.7), ylim=c(0, num_rows), xaxt="n", yaxt="n", xlab=NA, ylab=NA, frame.plot=F); 35 plot(NA, NA, xlim=c(0, p+0.7), ylim=c(0, num_rows), xaxt="n", yaxt="n", xlab=NA, ylab=NA, frame.plot=F);
47 axis(1, at=1:p-0.5, labels=colnames(data_matrix), las=2); 36 axis(1, at=1:p-0.5, labels=colnames(data_matrix), las=2);
48 axis(4, at=1:num_rows-0.5, labels=rownames(data_matrix), las=2); 37 axis(4, at=1:num_rows-0.5, labels=rownames(data_matrix), las=2);
49 color = round((t(data_matrix) - min_max_vector[1]) / (min_max_vector[2] - min_max_vector[1]) * 100); 38 color = round((t(data_matrix) - min_max_vector[1]) / (min_max_vector[2] - min_max_vector[1]) * 100);
50 cat("color: ", color, "\n");
51 rect(rep(1:p-1, num_rows), rep(1:num_rows-1, each=p), rep(1:p, num_rows), rep(1:num_rows, each=p), col=color); 39 rect(rep(1:p-1, num_rows), rep(1:num_rows-1, each=p), rep(1:p, num_rows), rep(1:num_rows, each=p), col=color);
52 histone_mark_color = t(col2rgb(terrain.colors(ceiling(p))[1:p])); 40 histone_mark_color = t(col2rgb(terrain.colors(ceiling(p))[1:p]));
53 cat("histone_mark_color: ", histone_mark_color, "\n");
54 41
55 # Specify a color for common feature names like "h3k4me3". 42 # Specify a color for common feature names like "h3k4me3".
56 # These are histone marks frequently used to identify 43 # These are histone marks frequently used to identify
57 # promoter activities in a cell, and are often displayed 44 # promoter activities in a cell, and are often displayed
58 # in shades of red. 45 # in shades of red.
59 for(i in 1:length(histone_marks)) { 46 for(i in 1:length(histone_marks)) {
60 cat("histone_marks[i]: ", histone_marks[i], "\n");
61 if(regexpr("h3k4me3", tolower(histone_marks[i])) > 0) { 47 if(regexpr("h3k4me3", tolower(histone_marks[i])) > 0) {
62 histone_mark_color[i,] = c(255, 0, 0); 48 histone_mark_color[i,] = c(255, 0, 0);
63 cat("histone_mark_color[i]: ", histone_mark_color[i], "\n");
64 } 49 }
65 if(regexpr("h3k4me2", tolower(histone_marks[i])) > 0) { 50 if(regexpr("h3k4me2", tolower(histone_marks[i])) > 0) {
66 histone_mark_color[i,] = c(250, 100, 0); 51 histone_mark_color[i,] = c(250, 100, 0);
67 } 52 }
68 if(regexpr("h3k4me1", tolower(histone_marks[i])) > 0) { 53 if(regexpr("h3k4me1", tolower(histone_marks[i])) > 0) {
97 } 82 }
98 if(regexpr("ctcf", tolower(histone_marks[i])) > 0) { 83 if(regexpr("ctcf", tolower(histone_marks[i])) > 0) {
99 histone_mark_color[i,] = c(200, 0, 250); 84 histone_mark_color[i,] = c(200, 0, 250);
100 } 85 }
101 state_color = get_state_color(data_matrix, histone_mark_color)[,2]; 86 state_color = get_state_color(data_matrix, histone_mark_color)[,2];
102 cat("state_color: ", state_color, "\n");
103 } 87 }
104 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); 88 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);
105 palette(defpalette); 89 palette(defpalette);
106 dev.off(); 90 dev.off();
107 } 91 }
108 92
109 get_state_color <- function(data_matrix, histone_mark_color) { 93 get_state_color <- function(data_matrix, histone_mark_color) {
110 cat("XXX histone_mark_color: ", histone_mark_color, "\n"); 94 range_vector = apply(data_matrix, 1, range);
111 #histone_mark_color = rep("", dim(data_matrix)[2]);
112 #cat("XXX histone_mark_color: ", histone_mark_color, "\n");
113 #cat("XXX order(apply(data_matrix, 2, sd), decreasing=T): ", order(apply(data_matrix, 2, sd), decreasing=T), "\n");
114 #cat("XXX dim(data_matrix)[2]-1: ", dim(data_matrix)[2]-1, "\n");
115 #cat("XXX histone_mark_color: ", histone_mark_color, "\n");
116 #histone_mark_color[order(apply(data_matrix, 2, sd), decreasing=T)] = hsv((1:dim(data_matrix)[2]-1) / dim(data_matrix)[2], 1, 1);
117 #cat("XXX histone_mark_color: ", histone_mark_color, "\n");
118 #histone_mark_color = t(col2rgb(histone_mark_color));
119 #cat("XXX histone_mark_color: ", histone_mark_color, "\n");
120 rg = apply(data_matrix, 1, range);
121 cat("XXX rg: ", rg, "\n");
122 mm = NULL; 95 mm = NULL;
123 cat("XXX dim(data_matrix): ", dim(data_matrix), "\n");
124 cat("XXX dim(data_matrix)[1]: ", dim(data_matrix)[1], "\n");
125 for(i in 1:dim(data_matrix)[1]) { 96 for(i in 1:dim(data_matrix)[1]) {
126 mm = rbind(mm, (data_matrix[i,] - rg[1, i] + 1e-10) / (rg[2, i] -rg[1, i] + 1e-10)); 97 range_val1 = range_vector[1, i] + 1e-10
127 cat("XXX mm: ", mm, "\n"); 98 range_val2 = range_vector[2, i]
99 mm = rbind(mm, (data_matrix[i,] - range_val1) / (range_val2 - range_val1));
128 } 100 }
129 mm = mm^5; 101 mm = mm^5;
130 cat("XXX dim(mm): ", dim(mm), "\n");
131 cat("XXX dim(mm)[2]: ", dim(mm)[2], "\n");
132 if(dim(mm)[2] > 1) { 102 if(dim(mm)[2] > 1) {
133 mm = mm / (apply(mm, 1, sum) + 1e-10); 103 mm = mm / (apply(mm, 1, sum) + 1e-10);
134 cat("XXX mm: ", mm, "\n");
135 } 104 }
136 state_color = mm%*%histone_mark_color; 105 state_color = mm%*%histone_mark_color;
137 cat("XXX state_color: ", state_color, "\n");
138 s = apply(data_matrix, 1, max); 106 s = apply(data_matrix, 1, max);
139 cat("XXX s: ", s, "\n");
140 s = (s - min(s)) / (max(s) - min(s) + 1e-10); 107 s = (s - min(s)) / (max(s) - min(s) + 1e-10);
141 cat("XXX s: ", s, "\n");
142 state_color = round(255 - (255 - state_color) * s/0.5); 108 state_color = round(255 - (255 - state_color) * s/0.5);
143 cat("XXX state_color: ", state_color, "\n");
144 state_color[state_color<0] = 0; 109 state_color[state_color<0] = 0;
145 cat("XXX state_color: ", state_color, "\n");
146 rt = paste(state_color[,1], state_color[,2], state_color[,3], sep=","); 110 rt = paste(state_color[,1], state_color[,2], state_color[,3], sep=",");
147 cat("XXX rt: ", rt, "\n");
148 h = t(apply(state_color, 1, function(x){rgb2hsv(x[1], x[2], x[3])})); 111 h = t(apply(state_color, 1, function(x){rgb2hsv(x[1], x[2], x[3])}));
149 cat("XXX h: ", h, "\n");
150 h = apply(h, 1, function(x){hsv(x[1], x[2], x[3])}); 112 h = apply(h, 1, function(x){hsv(x[1], x[2], x[3])});
151 cat("XXX h: ", h, "\n");
152 rt = cbind(rt, h); 113 rt = cbind(rt, h);
153 cat("XXX rt: ", rt, "\n");
154 return(rt); 114 return(rt);
155 } 115 }
156 116
157 # Read the inputs. 117 # Read the inputs.
158 para_files <- list.files(path=opt$input_dir, pattern="\\.para$", full.names=TRUE); 118 para_files <- list.files(path=opt$input_dir, pattern="\\.para$", full.names=TRUE);