|
105
|
1 #!/usr/bin/env Rscript
|
|
|
2
|
|
|
3 suppressPackageStartupMessages(library("optparse"))
|
|
|
4
|
|
|
5 option_list <- list(
|
|
136
|
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")
|
|
105
|
8 )
|
|
|
9
|
|
|
10 parser <- OptionParser(usage="%prog [options] file", option_list=option_list)
|
|
|
11 args <- parse_args(parser, positional_arguments=TRUE)
|
|
|
12 opt <- args$options
|
|
|
13
|
|
133
|
14 create_heatmap<-function(data_frame, output_file_name) {
|
|
|
15 # Plot a heatmap for a .para / .state combination
|
|
|
16 # based on the received data_frame which was created
|
|
|
17 # by reading the .para file.
|
|
|
18 num_columns = dim(data_frame)[2];
|
|
136
|
19 cat("num_columns: ", num_columns, "\n");
|
|
133
|
20 num_rows = dim(data_frame)[1];
|
|
136
|
21 cat("num_rows: ", num_rows, "\n");
|
|
|
22 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");
|
|
133
|
26 data_matrix = as.matrix(data_frame[,1+1:p] / data_frame[,1]);
|
|
136
|
27 cat("dim(data_matrix)[1]: ", dim(data_matrix)[1], "\n");
|
|
|
28 cat("dim(data_matrix)[2]: ", dim(data_matrix)[2], "\n");
|
|
135
|
29 colnames(data_matrix) = colnames(data_frame)[1+1:p];
|
|
136
|
30 cat("colnames(data_matrix): ", colnames(data_matrix), "\n");
|
|
|
31 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="");
|
|
|
34 cat("rownames(data_matrix): ", rownames(data_matrix), "\n");
|
|
133
|
35 # Open the output PDF file.
|
|
|
36 pdf(file=output_file_name);
|
|
|
37 # Set graphical parameters.
|
|
|
38 par(mar=c(6, 1, 1, 6));
|
|
|
39 # Create a vector containing the minimum and maximum values in data_matrix.
|
|
|
40 min_max_vector = range(data_matrix);
|
|
136
|
41 cat("min_max_vector: ", min_max_vector, "\n");
|
|
|
42 # Create a color palette.
|
|
133
|
43 my_palette = colorRampPalette(c("white", "dark blue"))(n=100);
|
|
|
44 defpalette = palette(my_palette);
|
|
|
45 # Plot the heatmap for the current .para / .state combination.
|
|
135
|
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);
|
|
|
47 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);
|
|
136
|
49 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);
|
|
|
52 histone_mark_color = t(col2rgb(terrain.colors(ceiling(p))[1:p]));
|
|
|
53 cat("histone_mark_color: ", histone_mark_color, "\n");
|
|
133
|
54
|
|
136
|
55 # Specify a color for common feature names like "h3k4me3".
|
|
|
56 # These are histone marks frequently used to identify
|
|
|
57 # promoter activities in a cell, and are often displayed
|
|
|
58 # in shades of red.
|
|
|
59 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) {
|
|
|
62 histone_mark_color[i,] = c(255, 0, 0);
|
|
|
63 cat("histone_mark_color[i]: ", histone_mark_color[i], "\n");
|
|
133
|
64 }
|
|
136
|
65 if(regexpr("h3k4me2", tolower(histone_marks[i])) > 0) {
|
|
|
66 histone_mark_color[i,] = c(250, 100, 0);
|
|
133
|
67 }
|
|
136
|
68 if(regexpr("h3k4me1", tolower(histone_marks[i])) > 0) {
|
|
|
69 histone_mark_color[i,] = c(250, 250, 0);
|
|
133
|
70 }
|
|
136
|
71 if(regexpr("h3k36me3", tolower(histone_marks[i]))>0) {
|
|
|
72 histone_mark_color[i,] = c(0, 150, 0);
|
|
133
|
73 }
|
|
136
|
74 if(regexpr("h2a", tolower(histone_marks[i])) > 0) {
|
|
|
75 histone_mark_color[i,] = c(0, 150, 150);
|
|
133
|
76 }
|
|
136
|
77 if(regexpr("dnase", tolower(histone_marks[i])) > 0) {
|
|
|
78 histone_mark_color[i,] = c(0, 200, 200);
|
|
133
|
79 }
|
|
136
|
80 if(regexpr("h3k9ac", tolower(histone_marks[i])) > 0) {
|
|
|
81 histone_mark_color[i,] = c(250, 0, 200);
|
|
133
|
82 }
|
|
136
|
83 if(regexpr("h3k9me3", tolower(histone_marks[i])) > 0) {
|
|
|
84 histone_mark_color[i,] = c(100, 100, 100);
|
|
133
|
85 }
|
|
136
|
86 if(regexpr("h3k27ac", tolower(histone_marks[i])) > 0) {
|
|
|
87 histone_mark_color[i,] = c(250, 150, 0);
|
|
133
|
88 }
|
|
136
|
89 if(regexpr("h3k27me3", tolower(histone_marks[i])) > 0) {
|
|
|
90 histone_mark_color[i,] = c(0, 0, 200);
|
|
133
|
91 }
|
|
136
|
92 if(regexpr("h3k79me2", tolower(histone_marks[i])) > 0) {
|
|
|
93 histone_mark_color[i,] = c(200, 0, 200);
|
|
133
|
94 }
|
|
136
|
95 if(regexpr("h4k20me1", tolower(histone_marks[i])) > 0) {
|
|
|
96 histone_mark_color[i,] = c(50, 200, 50);
|
|
133
|
97 }
|
|
136
|
98 if(regexpr("ctcf", tolower(histone_marks[i])) > 0) {
|
|
|
99 histone_mark_color[i,] = c(200, 0, 250);
|
|
|
100 }
|
|
|
101 state_color = get_state_color(data_matrix, histone_mark_color)[,2];
|
|
|
102 cat("state_color: ", state_color, "\n");
|
|
118
|
103 }
|
|
136
|
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);
|
|
133
|
105 palette(defpalette);
|
|
|
106 dev.off();
|
|
|
107 }
|
|
118
|
108
|
|
136
|
109 get_state_color <- function(data_matrix, histone_mark_color) {
|
|
|
110 cat("XXX histone_mark_color: ", histone_mark_color, "\n");
|
|
|
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;
|
|
|
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]) {
|
|
|
126 mm = rbind(mm, (data_matrix[i,] - rg[1, i] + 1e-10) / (rg[2, i] -rg[1, i] + 1e-10));
|
|
|
127 cat("XXX mm: ", mm, "\n");
|
|
118
|
128 }
|
|
133
|
129 mm = mm^5;
|
|
136
|
130 cat("XXX dim(mm): ", dim(mm), "\n");
|
|
|
131 cat("XXX dim(mm)[2]: ", dim(mm)[2], "\n");
|
|
118
|
132 if(dim(mm)[2] > 1) {
|
|
|
133 mm = mm / (apply(mm, 1, sum) + 1e-10);
|
|
136
|
134 cat("XXX mm: ", mm, "\n");
|
|
118
|
135 }
|
|
136
|
136 state_color = mm%*%histone_mark_color;
|
|
|
137 cat("XXX state_color: ", state_color, "\n");
|
|
|
138 s = apply(data_matrix, 1, max);
|
|
|
139 cat("XXX s: ", s, "\n");
|
|
|
140 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);
|
|
|
143 cat("XXX state_color: ", state_color, "\n");
|
|
|
144 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=",");
|
|
|
147 cat("XXX rt: ", rt, "\n");
|
|
|
148 h = t(apply(state_color, 1, function(x){rgb2hsv(x[1], x[2], x[3])}));
|
|
|
149 cat("XXX h: ", h, "\n");
|
|
118
|
150 h = apply(h, 1, function(x){hsv(x[1], x[2], x[3])});
|
|
136
|
151 cat("XXX h: ", h, "\n");
|
|
133
|
152 rt = cbind(rt, h);
|
|
136
|
153 cat("XXX rt: ", rt, "\n");
|
|
118
|
154 return(rt);
|
|
|
155 }
|
|
|
156
|
|
121
|
157 # Read the inputs.
|
|
122
|
158 para_files <- list.files(path=opt$input_dir, pattern="\\.para$", full.names=TRUE);
|
|
|
159 for (i in 1:length(para_files)) {
|
|
121
|
160 para_file <- para_files[i];
|
|
122
|
161 para_file_base_name <- strsplit(para_file, split="/")[[1]][2]
|
|
|
162 output_file_name <- gsub(".para", ".pdf", para_file_base_name)
|
|
133
|
163 output_file_path <- paste(opt$output_dir, output_file_name, sep="/");
|
|
121
|
164 data_frame <- read.table(para_file, comment="!", header=T);
|
|
122
|
165 create_heatmap(data_frame, output_file_path);
|
|
121
|
166 }
|
