changeset 66:f0c488b73dbc draft

Uploaded
author greg
date Wed, 20 Dec 2017 11:26:04 -0500
parents 794d2104f83d
children 1a39146a0cea
files create_heatmap.R ideas_genome_tracks.R ideas_genome_tracks.xml
diffstat 3 files changed, 128 insertions(+), 24 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/create_heatmap.R	Wed Dec 20 11:26:04 2017 -0500
@@ -0,0 +1,109 @@
+#!/usr/bin/env Rscript
+
+create_heatmap<-function(data_frame, output_file_name=NULL) {
+    # 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]);
+    colnames(data_matrix) = colnames(data_frame)[1+1:p];
+    histone_marks = colnames(data_matrix);
+    rownames(data_matrix) = paste(1:num_rows-1, " (", round(data_frame[,1]/sum(data_frame[,1])*10000)/100, "%)", sep="");
+    if (!is.null(output_file_name)) {
+        # 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);
+    # Create a 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, num_rows), 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:num_rows-0.5, labels=rownames(data_matrix), las=2);
+    color = round((t(data_matrix) - min_max_vector[1]) / (min_max_vector[2] - min_max_vector[1]) * 100);
+    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);
+    histone_mark_color = t(col2rgb(terrain.colors(ceiling(p))[1:p]));
+
+    # Specify a color for common feature names like "h3k4me3".
+    # These are histone marks frequently used to identify
+    # promoter activities in a cell, and are often displayed
+    # in shades of red.
+    for(i in 1:length(histone_marks)) {
+        if(regexpr("h3k4me3", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(255, 0, 0);
+        }
+        if(regexpr("h3k4me2", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(250, 100, 0);
+        }
+        if(regexpr("h3k4me1", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(250, 250, 0);
+        }
+        if(regexpr("h3k36me3", tolower(histone_marks[i]))>0) {
+            histone_mark_color[i,] = c(0, 150, 0);
+        }
+        if(regexpr("h2a", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(0, 150, 150);
+        }
+        if(regexpr("dnase", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(0, 200, 200);
+        }
+        if(regexpr("h3k9ac", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(250, 0, 200);
+        }
+        if(regexpr("h3k9me3", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(100, 100, 100);
+        }
+        if(regexpr("h3k27ac", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(250, 150, 0);
+        }
+        if(regexpr("h3k27me3", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(0, 0, 200);
+        }
+        if(regexpr("h3k79me2", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(200, 0, 200);
+        }
+        if(regexpr("h4k20me1", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(50, 200, 50);
+        }
+        if(regexpr("ctcf", tolower(histone_marks[i])) > 0) {
+            histone_mark_color[i,] = c(200, 0, 250);
+        }
+        state_color = get_state_color(data_matrix, histone_mark_color)[,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);
+    if (!is.null(output_file_name)) {
+        dev.off();
+    }
+    return(state_color);
+}
+
+get_state_color <- function(data_matrix, histone_mark_color) {
+    range_vector = apply(data_matrix, 1, range);
+    mm = NULL;
+    for(i in 1:dim(data_matrix)[1]) {
+        range_val1 = range_vector[1, i] + 1e-10;
+        range_val2 = range_vector[2, i];
+        mm = rbind(mm, (data_matrix[i,] - range_val1) / (range_val2 - range_val1));
+    }
+    mm = mm^5;
+    if(dim(mm)[2] > 1) {
+        mm = mm / (apply(mm, 1, sum) + 1e-10);
+    }
+    state_color = mm%*%histone_mark_color;
+    s = apply(data_matrix, 1, max);
+    s = (s - min(s)) / (max(s) - min(s) + 1e-10);
+    state_color = round(255 - (255 - state_color) * s/0.5);
+    state_color[state_color<0] = 0;
+    rt = paste(state_color[,1], state_color[,2], state_color[,3], sep=",");
+    h = t(apply(state_color, 1, function(x){rgb2hsv(x[1], x[2], x[3])}));
+    h = apply(h, 1, function(x){hsv(x[1], x[2], x[3])});
+    rt = cbind(rt, h);
+    return(rt);
+}
--- a/ideas_genome_tracks.R	Tue Dec 19 12:53:24 2017 -0500
+++ b/ideas_genome_tracks.R	Wed Dec 20 11:26:04 2017 -0500
@@ -2,7 +2,6 @@
 
 suppressPackageStartupMessages(library("data.table"))
 suppressPackageStartupMessages(library("optparse"))
-suppressPackageStartupMessages(library("viridisLite"))
 
 option_list <- list(
     make_option(c("--build"), action="store", dest="build", help="Genome build"),
@@ -10,6 +9,7 @@
     make_option(c("--email"),  action="store", dest="email", help="User email address"),
     make_option(c("--galaxy_url"),  action="store", dest="galaxy_url", help="Galaxy instance base URL"),
     make_option(c("--hub_name"),  action="store", dest="hub_name", default=NULL, help="Hub name without spaces"),
+    make_option(c("--input_dir_para"), action="store", dest="input_dir_para", help="Directory containing .para outputs from IDEAS"),
     make_option(c("--input_dir_state"), action="store", dest="input_dir_state", help="Directory containing .state outputs from IDEAS"),
     make_option(c("--long_label"), action="store", dest="long_label", help="Hub long label"),
     make_option(c("--output_trackhub"),  action="store", dest="output_trackhub", help="Output hub file"),
@@ -37,7 +37,7 @@
 }
 
 create_track = function(input_dir_state, chrom_len_file, base_track_file_name) {
-    # Create everythin needed, including the bigbed file,
+    # Create everything needed, including the bigbed file,
     # to render the tracks within the UCSC track hub.
     state_files <- list.files(path=input_dir_state, full.names=TRUE);
     genome_size = read.table(chrom_len_file);
@@ -98,15 +98,12 @@
     return(cells);
 }
 
-create_track_db = function(galaxy_url, encoded_dataset_id, input_dir_state, build, chrom_len_file, tracks_dir, hub_name, short_label, long_label, state_indexes, state_colors) {
+create_track_db = function(galaxy_url, encoded_dataset_id, input_dir_para, input_dir_state, build,
+        chrom_len_file, tracks_dir, hub_name, short_label, long_label, state_indexes, state_colors) {
     # Create a trackDb.txt file that includes each state.
+    para_files <- list.files(path=input_dir_para, full.names=TRUE);
     base_track_file_name <- paste(tracks_dir, hub_name, sep="");
     cells = create_track(input_dir_state, chrom_len_file, base_track_file_name);
-    # Create a a character vector of 1024 viridis color hex codes.
-    # This vector could be used even if the state_colors were received
-    # since colors may not have been chosen for all states.
-    viridis_vector <- viridis(1024, alpha=1, begin=0, end=1, direction=1, option="D");
-    colors_used <- vector();
     if (!is.null(state_indexes)) {
         # Split state_indexes into a list of integers.
         s_indexes <- c();
@@ -126,20 +123,12 @@
     track_db = NULL;
     for (i in 1:length(cells)) {
         if (is.null(state_indexes) || !is.element(i, s_indexes)) {
-            # Generate a random number between 1 and 1024 as
-            # the viridis_vector index for the next state color.
-            color_index <- sample(1:1024, 1);
-            # Make sure the color was not previously chosen.
-            while(is.element(color_index, colors_used)) {
-                color_index <- sample(1:1024, 1);
-            }
-            # Append the color to our list of chosen colors.
-            append(colors_used, color_index);
-            # Get the hex code from viridis_vector.
-            color_hex_code <- viridis_vector[color_index];
+            data_frame <- read.table(para_files[i], comment="!", header=T);
+            color <- create_heatmap(data_frame);
         } else {
             # Use the selected color for the current state.
             color_hex_code <- s_colors[i];
+            color <- paste(c(col2rgb(color_hex_code)), collapse=",");
         }
         big_data_url <- get_big_data_url(galaxy_url, encoded_dataset_id, tracks_dir, i, build);
         # trackDb.txt track entry.
@@ -151,7 +140,7 @@
         track_db = c(track_db, paste("priority", i));
         track_db = c(track_db, "itemRgb on");
         track_db = c(track_db, "maxItems 100000");
-        track_db = c(track_db, paste("color", paste(c(col2rgb(color_hex_code)), collapse=","), sep=" "));
+        track_db = c(track_db, paste("color", color, sep=" "));
         track_db = c(track_db, "visibility dense");
         track_db = c(track_db, "");
     }
@@ -189,9 +178,11 @@
 write.table(contents, file=genomes_file_path, quote=F, row.names=F, col.names=F);
 
 # Create the tracks.
+source("create_heatmap.R");
 tracks_dir <- paste(hub_dir, opt$build, "/", sep="");
 dir.create(tracks_dir, showWarnings=FALSE);
-track_db <- create_track_db(opt$galaxy_url, opt$output_trackhub_id, opt$input_dir_state, opt$build, opt$chrom_len_file, tracks_dir, opt$hub_name, opt$short_label, opt$long_label, opt$state_indexes, opt$state_colors);
+track_db <- create_track_db(opt$galaxy_url, opt$output_trackhub_id, opt$input_dir_state, opt$input_dir_state, opt$build,
+        opt$chrom_len_file, tracks_dir, opt$hub_name, opt$short_label, opt$long_label, opt$state_indexes, opt$state_colors);
 
 # Create the trackDb.txt output.
 track_db_file_path <- paste(tracks_dir, "trackDb.txt", sep="");
--- a/ideas_genome_tracks.xml	Tue Dec 19 12:53:24 2017 -0500
+++ b/ideas_genome_tracks.xml	Wed Dec 20 11:26:04 2017 -0500
@@ -4,7 +4,6 @@
         <requirement type="package" version="2.4.27">bedops</requirement>
         <requirement type="package" version="1.10.4">r-data.table</requirement>
          <requirement type="package" version="1.4.4">r-optparse</requirement>
-         <requirement type="package" version="0.2.0">r-viridislite</requirement>
          <requirement type="package" version="332">ucsc-bedtobigbed</requirement>
     </requirements>
     <command detect_errors="exit_code"><![CDATA[
@@ -19,6 +18,7 @@
 #else:
     #set email = $__user__.email
 #end if
+#set input_dir_state = "input_dir_para"
 #set input_dir_state = "input_dir_state"
 #set select_state_color = $select_state_color_cond.select_state_color
 #if str($select_state_color) == 'yes':
@@ -32,6 +32,7 @@
     #set state_indexes = ",".join($state_indexes)
     #set state_colors = ",".join($state_colors)
 #end if
+mkdir $input_dir_para &&
 mkdir $input_dir_state &&
 mkdir '$output_trackhub.files_path' &&
 #for $i in $input:
@@ -40,7 +41,9 @@
     #end if
     #set filename = $i.file_name
     #set name = $i.name
-    #if $name.endswith(".state"):
+    #if $name.endswith(".para"):
+        ln -s $filename $input_dir_para/$name &&
+    #else if $name.endswith(".state"):
         ln -s $filename $input_dir_state/$name &&
     #end if
 #end for
@@ -50,6 +53,7 @@
 --email '$email'
 --galaxy_url $galaxy_url
 --hub_name '$hub_name'
+--input_dir_para '$input_dir_para'
 --input_dir_state '$input_dir_state'
 --long_label '$sanitized_long_label'
 --output_trackhub '$output_trackhub'
@@ -76,7 +80,7 @@
             </param>
             <when value="no" />
             <when value="yes">
-                <repeat name="state_color_repeat" title="State colors" min="1">
+                <repeat name="state_color_repeat" title="state color" min="1">
                     <param name="state_index" type="integer" value="" min="1" label="State index" help="Enter the integer index of the desired state">
                         <validator type="empty_field"/>
                     </param>