comparison create_heatmap.R @ 121:755d4a3754d2 draft

Uploaded
author greg
date Fri, 17 Nov 2017 13:13:37 -0500
parents f8a7bf4ca1a7
children 7229e52fa8e1
comparison
equal deleted inserted replaced
120:cfa683d96cae 121:755d4a3754d2
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"), action="store", dest="input", help="IDEAS para file"), 6 make_option(c("-i", "--input_dir"), action="store", dest="input_dir", help="IDEAS para files directory"),
7 make_option(c("-o", "--output"), action="store", dest="output", help="Output PDF file") 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
36 h = apply(h, 1, function(x){hsv(x[1], x[2], x[3])}); 36 h = apply(h, 1, function(x){hsv(x[1], x[2], x[3])});
37 rt = cbind(apply(t(col2rgb(h)), 1, function(x){paste(x, collapse=",")}) ,h); 37 rt = cbind(apply(t(col2rgb(h)), 1, function(x){paste(x, collapse=",")}) ,h);
38 return(rt); 38 return(rt);
39 } 39 }
40 40
41 create_heatmap<-function(data_frame, statecolor=NULL, markcolor=NULL, cols=c("white","dark blue")) { 41 create_heatmap<-function(data_frame, output_file_name, statecolor=NULL, markcolor=NULL, cols=c("white","dark blue")) {
42 k = dim(data_frame)[2]; 42 k = dim(data_frame)[2];
43 l = dim(data_frame)[1]; 43 l = dim(data_frame)[1];
44 p = (sqrt(9 + 8 * (k - 1)) - 3) / 2; 44 p = (sqrt(9 + 8 * (k - 1)) - 3) / 2;
45 data_matrix = as.matrix(data_frame[,1+1:p] / data_frame[,1]); 45 data_matrix = as.matrix(data_frame[,1+1:p] / data_frame[,1]);
46 colnames(data_matrix) = colnames(data_frame)[1+1:p]; 46 colnames(data_matrix) = colnames(data_frame)[1+1:p];
47 marks = colnames(data_matrix); 47 marks = colnames(data_matrix);
48 rownames(data_matrix) = paste(1:l," (", round(data_frame[,1] / sum(data_frame[,1]) * 10000) / 100, "%)", sep=""); 48 rownames(data_matrix) = paste(1:l," (", round(data_frame[,1] / sum(data_frame[,1]) * 10000) / 100, "%)", sep="");
49 pdf(file=opt$output); 49 pdf(file=output_file_name);
50 par(mar=c(6,1,1,6)); 50 par(mar=c(6, 1, 1, 6));
51 rg = range(data_matrix); 51 rg = range(data_matrix);
52 colors = 0:100/100*(rg[2]-rg[1])+rg[1]; 52 colors = 0:100 / 100 * (rg[2] - rg[1]) + rg[1];
53 my_palette = colorRampPalette(cols)(n=100); 53 my_palette = colorRampPalette(cols)(n=100);
54 defpalette = palette(my_palette); 54 defpalette = palette(my_palette);
55 55
56 plot(NA, NA, xlim=c(0,p+0.7), ylim=c(0,l), xaxt="n", yaxt="n", xlab=NA, ylab=NA, frame.plot=F); 56 plot(NA, NA, xlim=c(0,p+0.7), ylim=c(0,l), xaxt="n", yaxt="n", xlab=NA, ylab=NA, frame.plot=F);
57 axis(1, at=1:p-0.5, labels=colnames(data_matrix), las=2); 57 axis(1, at=1:p-0.5, labels=colnames(data_matrix), las=2);
108 rect(rep(p+0.2,l), 1:l-0.8, rep(p+0.8,l), 1:l-0.2, col=sc); 108 rect(rep(p+0.2,l), 1:l-0.8, rep(p+0.8,l), 1:l-0.2, col=sc);
109 palette(defpalette); 109 palette(defpalette);
110 dev.off(); 110 dev.off();
111 } 111 }
112 112
113 # Read the input. 113 # Read the inputs.
114 data_frame <- read.table(opt$input, comment="!", header=T); 114 para_files <- list.files(path=input_dir, pattern="*.para", full.names=TRUE);
115 create_heatmap(data_frame); 115 for (i in 1:length(para_files) {
116 para_file <- para_files[i];
117 para_file_base_name <- strsplit(para_file, ".para", fixed=TRUE)[1];
118 output_file_name <- paste(opt$output_dir, "/", para_file_base_name, ".pdf", sep="");
119 data_frame <- read.table(para_file, comment="!", header=T);
120 create_heatmap(data_frame, output_file_name);
121 }