#!/usr/bin/env perl
############################################################
#
# $Id: draw-heatmap,v 1.21 2013/02/20 12:11:56 jvanheld Exp $
#
############################################################

## use strict;

=pod

=head1 NAME

draw-heatmap

=head1 VERSION

$program_version

=head1 DESCRIPTION

Draw a heatmap from a table

=head1 AUTHORS

Sylvain Brohee <sbrohee\@ulb.ac.be>

With the help of Morgane Thomas-Chollier <morgane@bigre.ulb.ac.be> for
Chaos representation

Jacques van Helden <Jacques.van-Helden@univ-amu.fr> for the optio
-r_plot (2016-02-29).

=head1 CATEGORY

util

=head1 USAGE

draw-heatmap [-i inputfile] -o outputfile [-v #] [-chaos] [...] -out_format [png|jpeg]

=head1 INPUT FORMAT

A tab delimited table.

It may contain a header (starting with a '#' symbol). The cells nlt
containing real values will not be taken into account.

=head1 OUTPUT FORMAT

A heatmap in the specified format.

=cut


BEGIN {
    if ($0 =~ /([^(\/)]+)$/) {
	push (@INC, "$`lib/");
    }
}
require "RSA.lib";
use RSAT::util;
use Data::Dumper;
use RSAT::Chaos;
use GD;
use File::Spec;



################################################################
## Main package
package main;
{

  ################################################################
  ## Initialise parameters
  local $start_time = &RSAT::util::StartScript();
  $program_version = do { my @r = (q$Revision: 1.21 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
  #    $program_version = "0.00";

  %main::infile = ();
  %main::outfile = ();

  $main::verbose = 0;
#  $main::in = STDIN;
#  $main::out = STDOUT;

  $r_plot = 0; ## Use R rather than GD library to generate the plot

  ## Output formats
  local $img_format = "png";
  %supported_img_format =(
    #			       ps=>1, ## NOT SUPPORTED YET
    png=>1,
    jpg=>1,
    jpeg=>1,
    pdf=>1, ## Only with option -r_plot
    eps=>1, ## Only with option -r_plot
      );
  $supported_img_formats = join (",", keys %supported_img_format);

  ## Color gradients
  local $gradient = "grey";
  %supported_gradients =(
			 blue=>1,
			 green=>1,
			 red=>1,
			 grey=>1,
			 fire=>1);
  $supported_gradients = join (",", keys %supported_gradients);    
  $rownames = 0;

  $img_format = "png";

  # Maximal and minimal values
  $min_val = "NA";
  $max_val = "NA";

  # Col width and row height
  $main::col_width = 50;
  $main::row_height = 30;
  $main::no_text = 0;
  # draw line 
  $main::lines = 0;
  #chaos
  $main::chaos = 0;

  $main::digits = "NA"; ## Digits to be displayed 

  $null_char="NA";
    
  local $display_min;
  local $display_max;
  local $display_mean;
  local $title = ""; ## Title for the heatmap

  ################################################################
  ## Read argument values
  &ReadArguments();

  if ($gradient eq "grey") {
    $null_color = "#FFFFBB";
    $saturation_color = "#DD0000";
  } else {
    $null_color = "#DDDDDD";
    if (($gradient eq "red") || ($gradient eq "fire")) {
      $saturation_color = "#000000";
    } else {
      $saturation_color = "#FF0000";
    }
  }

  ################################################################
  ## Check argument values
  if (!$main::outfile{output}) {
    &RSAT::error::FatalError("You must specify an output file with the -o option");
  }

  ################################################################
  ## Check -r_plot option.
  if ($r_plot) {
    if ($chaos) {
      &RSAT::error::FatalError("Chaos mode is incompatble with option -r_plot");
    }
    if ($outfile{htmlmap}) {
      &RSAT::error::FatalError("HTML output is incompatble with option -r_plot");
    }
    &Rplot();
    exit();
  } else {
    if (($img_format eq "pdf") || ($img_format eq "eps")) {
      &RSAT::error::FatalError("Output formats pdf and eps are supported only with the option -r_plot");      
    }
  }
  
  ################################################################
  ## Chaos table: no text, no lines, square cells
  if ($chaos) {
    $main::no_text = 1;
    $main::lines = 0;
    my $user_col = 0;		## user specified col
    my $user_row = 0;		## user specified row
    if ($col_width != 50) {
      $user_col = 1;
    }
    if ($row_height != 30) {
      $user_row = 1;
    }
    if ($user_col) {
      ## user has specified both col and row => keep the largest one
      if ($user_row) {
	if ($main::col_width > $main::row_height) {
	  $main::row_height = $main::col_width;
	} else {
	  $main::col_width = $main::row_height;
	}
      } else {
	## user has specified only col
	$main::row_height = $main::col_width;
      }
      ## user has specified only row
    } elsif ($user_row) {
      $main::col_width = $main::row_height; 
      ## user has specified nothing
    } elsif ($main::col_width > $main::row_height) {
      $main::row_height = $main::col_width;
    } else {
      $main::col_width = $main::row_height;
    }
  }

  ################################################################
  ## Open output stream
  $main::out = &OpenOutputFile($main::outfile{output});
  $main::outhtml = &OpenOutputFile($main::outfile{htmlmap}) if (defined $main::outfile{htmlmap});

  ################################################################
  ## If HTML map required, initialization
  my $html_source = "<html><header><title>Draw Heatmap</title></header><body>\n";
  ## get the absolute path of the output image
  $html_source .= "<img src = '".File::Spec->rel2abs($main::outfile{output})."' usemap = '#map' border = 0>\n";
  $html_source .= "<map name = 'map'>\n";

  ################################################################
  ## Read input
  my $min = +9e-300;		# min value of the table
  my $max = -9e+300;		# max value of the table
  my @header = ();		# header of the table (column names)
  my @rownames_list = ();	#array containing the row names
  my @table = ();		# array containing the values
  my $max_row_name_length = 0;
  my $max_header_name_length = 0;

  my $tablecpt = 0;
  my $max_row_elements = 0;
  ($main::in) = &OpenInputFile($main::infile{input});
  while (my $ligne = <$main::in>) {
    next if ($ligne =~ /^;/);
    chomp $ligne;
    my @lignecp = split /\t/, $ligne;
    # Parsing of the header line if any
    if ($ligne =~ /^#/) {
      $ligne =~ s/^#//;
      @lignecp = split /\t/, $ligne;
      for (my $i = 0; $i < scalar @lignecp; $i++) {
	push @header, $lignecp[$i];
	if ($max_header_name_length < length ($lignecp[$i])) {
	  $max_header_name_length = length ($lignecp[$i]);
	}
      }
      next;
    }
    # Parsing of the table
    for (my $i = 0; $i < scalar @lignecp; $i++) {
      my $val = $lignecp[$i];
      $table[$tablecpt][$i] = $val;
      if ($rownames && $i == 0) {
	push @rownames_list, $val;
	if ($max_row_name_length < length ($val)) {
	  $max_row_name_length = length ($val);
	}
	next;
      }
      if (&RSAT::util::IsReal($val)) {
	$min = $val if ($val < $min);
	$max = $val if ($val > $max);
      }
      if ($i > $max_row_elements) {
	$max_row_elements = $i;
      }
    }
    $tablecpt++;
  }
  close $main::in if ($main::infile{input});
  my $row_name_width = $max_row_name_length *5 || $col_width;
  my $header_name_height = $max_header_name_length*10 || $col_width;


  &RSAT::message::Info("max_val=".$max_val, "table_max=".$max) if ($main::verbose >= 4);

  ## Attribution of the minimal and maximal value if specified as arguments
  if (&IsReal($min_val)) {
    $display_min = $min_val;
#    $display_min = &RSAT::stats::min($min_val, $min);
  } else {
    $display_min = $min;
  }
  if (&IsReal($max_val)) {	#&& ($max_val >= $max)) {
    $display_max = $max_val;
#    $display_max = &RSAT::stats::max($max_val, $max);
  } else {
    $display_max = $max;
  }
  $display_mean = ($display_min + $display_max)/2;
  &RSAT::message::Debug(
    "Display min=".$display_min,
    "Display mean=".$display_mean,
    "Display max=".$display_max,
    "min=".$min,
    "max=".$max,
      ) if ($main::verbose >= 5);

  ################################################################
  ## Print verbose
  &Verbose() if ($main::verbose);

  ################################################################
  ## Execute the command
  if ($img_format eq "ps") {

    ## Comment by JvH: apparently there has been some intention to
    ## support the ps format, but the code has not been implemented
    ## yet. I added the error message to avoid having an empty case.
    &RSAT::error::FatalError("Postscript format is not supported yet.");

  } else {
    my $p  = new GD::Image (100+$row_name_width+($col_width*$max_row_elements), $header_name_height+($row_height*($tablecpt+2))) ;
    my %colors = ();
    my $white = $p->colorAllocate(255,255,255);
    my $black = $p->colorAllocate(0,0,0);
    $p->setThickness(1);
      
    $colors{"255255255"} = $white;
    $colors{"000000000"} = $black;
    $p->interlaced('false');
      
    ################################################################
    ## CHAOS
    if ($chaos) {
      # print chaos ATGC angles
      $p->string(gdMediumBoldFont,$row_name_width-7,$header_name_height-7,"C",$black);
      $p->string(gdMediumBoldFont,$row_name_width-7,$header_name_height+($row_height*$tablecpt),"A",$black);
      $p->string(gdMediumBoldFont,$row_name_width+($col_width*$tablecpt)+2,$header_name_height-7,"G",$black);
      $p->string(gdMediumBoldFont,$row_name_width+($col_width*$tablecpt)+2,$header_name_height+($row_height*$tablecpt),"T",$black);
      
      ## calculate chaos word positions if html
      if ($main::outfile{htmlmap}) {
	our $w_length = log($max_row_elements + 1) / log(2);
	%main::oligo_freq = ();
	## generate all possible words
	&generate_words($w_length);

	##	calculate position of Chaos Table
	$main::chaos_table = new RSAT::Chaos();
	$main::chaos_table->init_mapping_table();
	$main::chaos_table->init_chaos_table($w_length);
	@main::chaos = $main::chaos_table->get_chaos_table("word",\%main::oligo_freq);

      }
    }
      
    ## Display header if any
    if ((scalar @header) > 0) {
      for (my $i = 0; $i < scalar @header; $i++) {
	my $xpos = $row_name_width+($col_width*$i);
	my $ypos = $header_name_height;
	my $headeri = $header[$i];
	$p->stringUp(gdMediumBoldFont,$xpos,$ypos,$headeri,$black);
      }
    }
      
    ## Display table
    my $initj = 0;
    $initj = 1 if ($rownames);
    for (my $i = 0; $i < scalar @table; $i ++) {
      my @row = @{$table[$i]};
      for (my $j = $initj; $j < scalar @row; $j ++) {
	my $val = $row[$j];

	## Round the value if required
	if ((&IsReal($val)) && (&IsReal($main::digits))) {
	  $val = sprintf("%.${main::digits}f", $val);
	}

	## Specify colors
	my $current_col = $null_color;
	my $color = $null_color;
	my $textcol = $black;

	## Print rownames
	if ($rownames) {
	  my $row_name_xpos = 5;
	  my $row_name_ypos = 5+$header_name_height+($row_height*$i);
	  $p->string(gdSmallFont, $row_name_xpos,$row_name_ypos, $rownames_list[$i], $textcol);
	}

	## Associate a color from the gradient to the value of the current cell
	if (&RSAT::util::IsReal($val)) {
	  my $display_val = &RSAT::stats::max($val,$display_min);
	  if ($val > $display_max) {
	    $color = $saturation_color;
	  } else {
	    $color = &RSAT::util::getBgColorFromOneScore($display_val, $display_min, $display_max, 0, $gradient);
	  }
	  if ($val > $display_mean) {
	    if (($gradient ne "green") || ($val > $max_val)) {
	      $textcol = $white;
	    }
	  }
	}

	## Get red,green,blue channel intensities corresponding to the color
	my $r = hex(substr($color, 1,2));
	my $g = hex(substr($color, 3,2));
	my $b = hex(substr($color, 5,2));
	my $idcol = join("","$r","$g","$b");
	$current_col = $colors{$idcol};
	if (!defined($current_col)) {
	  $current_col = $p->colorAllocate($r, $g, $b);
	  $colors{"$idcol"} = $current_col;
	}
	my $xpos1 = $row_name_width+($col_width*$j);
	my $xpos2 = $row_name_width+($col_width*$j)+$col_width;
	my $ypos1 = 5+$header_name_height+($row_height*$i);
	my $ypos2 = 5+$header_name_height+($row_height*$i)+$row_height;
	$p->filledRectangle($xpos1, $ypos1, $xpos2, $ypos2, $current_col);

	## Print values if requested
	if ($col_width >= 30 && (!$no_text)) {
	  $p->string(gdSmallFont, ($xpos1+5), ($ypos1+5), $val, $textcol);
	}

	&RSAT::message::Debug("i=".$i, 
			      "j=".$j,
			      "val=".$val,
			      "current_col=".$current_col,
			      "textcol=".$textcol,
			      "r=".$r,
			      "g=".$g,
			      "b=".$b,
	    ) if ($main::verbose >= 5);

	# put the lines only when computing the last row
	if ($lines && $i == (scalar(@table)-1)) {
	  $p->setThickness(2);
	  $vline_x = $xpos2;
	  $vline_topy = $header_name_height;
	  $vline_bottomy = $ypos2;
	  $p->line($vline_x,$vline_topy,$vline_x,$vline_bottomy, $black);
	  $p->setThickness(1);
	}
	if ($main::outfile{htmlmap}) {
	  my $cell_content;
	  if ($chaos) {
	    my $value2print = sprintf "%.3e", $val;         		
	    $cell_content = uc($main::chaos[$i][$j])." : ". $value2print;
	  } else {
	    $cell_content = "$val (";
	    if ((scalar @rownames_list) > 0) {
	      $cell_content .= "Row $rownames_list[$i];";
	    }
	    if ((scalar @header) > 0) {
	      $cell_content .= "Col $header[$j]";
	    }
	    $cell_content .= ")";
	  }	
	  $html_source .= "<area shape = 'rect' coords = '$xpos1,$ypos1,$xpos2,$ypos2' title = '$cell_content'>\n";
	}
      }
      if ($lines) {
	# Add horizontal lines
	$p->setThickness(2);
	$hline_leftx = $row_name_width;
	$hline_leftx += $col_width  if ($rownames);
	$hline_y = 5+$header_name_height+($row_height*$i)+$row_height;
	$hline_rightx = $row_name_width+($col_width*scalar(@row))+$col_width;
	$hline_rightx -= $col_width  if ($rownames);
	$p->line($hline_leftx,$hline_y,$hline_rightx,$hline_y, $black);
	$p->setThickness(1);
      }
    }
    binmode STDOUT;
    my $output_fhandle = &OpenOutputFile($main::outfile{output});
    if ($img_format eq "jpg" || $img_format eq "jpeg") {
      print $output_fhandle $p->jpeg();
    } elsif ($img_format eq "png") {
      print $output_fhandle $p->png();
    } 
    close $output_fhandle;
  }
    
  ################################################################
  ## Print output
  if (defined ($main::outfile{htmlmap})) {
    $html_source .= "</map>\n";
    $html_source .= "</HTML>\n";
    print $main::outhtml $html_source;
  }
  close $main::out if ($main::outfile{output});

  ################################################################
  ## Close output stream
  my $exec_time = &RSAT::util::ReportExecutionTime($start_time); ## This has to be exectuted by all scripts
  warn $exec_time if ($main::verbose >= 1);	## only report exec time if verbosity is specified
  exit(0);
}

################################################################
################### SUBROUTINE DEFINITION ######################
################################################################


################################################################
## Display full help message 
sub PrintHelp {
    system "pod2text -c $0";
    exit()
}

################################################################
## Display short help message
sub PrintOptions {
    &PrintHelp();
}

################################################################
## Read arguments 
sub ReadArguments {
    my $arg;
    my @arguments = @ARGV; ## create a copy to shift, because we need ARGV to report command line in &Verbose()
    while (scalar(@arguments) >= 1) {
      $arg = shift (@arguments);
	## Verbosity
=pod

=head1 OPTIONS

=over 4

=item B<-v #>

Level of verbosity (detail in the warning messages during execution)

=cut
	if ($arg eq "-v") {
	    if (&IsNatural($arguments[0])) {
		$main::verbose = shift(@arguments);
	    } else {
		$main::verbose = 1;
	    }

	    ## Help message
=pod

=item B<-h>

Display full help message

=cut
	} elsif ($arg eq "-h") {
	    &PrintHelp();

	    ## List of options
=pod

=item B<-help>

Same as -h

=cut
	} elsif ($arg eq "-help") {
	    &PrintOptions();

	    ## Input file
=pod

=item B<-i inputfile>

Input file name. This option is mandatory.

=cut
	} elsif ($arg eq "-i") {
	    $main::infile{input} = shift(@arguments);

	    ## Output file
=pod

=item	B<-o outputfile>

Name of the output file. This option is mandatory.

=cut
	} elsif ($arg eq "-o") {
	    $main::outfile{output} = shift(@arguments);

	    ## HTML MAP
=pod

=item	B<-html html_map_file>

If a HTML map file is defined, draw-heatmap then produces a HTML file
that loads the HEATMAP. Moreover, each of the cells is defined so that
when the mouse is over in a web browser, a tooltip displays the row
name, column name and the value of the cell.

For CHAOS game representation, the word corresponding to the cell and
its associated value are given.

=cut
	} elsif ($arg eq "-html") {
	    $main::outfile{htmlmap} = shift(@arguments);
	    ## Row names
=pod

=item B<-rownames>

Use this option if the first column contain the row names.

=cut
	} elsif ($arg eq "-rownames") {
	    $main::rownames = 1;
	    
	    ## text
=pod

=item B<-no_text>

Using this option, the values are not written in the cells of the heatmap.

=cut
	} elsif ($arg eq "-no_text") {
	    $main::no_text = 1;

=pod

=item B<-out_format img_format>

Output format. Supported: png,jpeg

=cut 
	} elsif ($arg eq "-out_format") {
	    $img_format = shift(@arguments);
	    &RSAT::error::FatalError("$img_format\tInvalid output format. Supported: $supported_img_formats")
		unless ($supported_img_format{$img_format});

=pod

=item B<-title>

Title for the graph (only works with option -r_plot so far).

=cut
	} elsif ($arg eq "-title") {
	    $title = shift(@arguments);

=pod

=item B<-gradient>

Color of the intensity gradient of the heatmap. Default is grey.
Supported : green, blue, red, fire, grey. 

=cut
	} elsif ($arg eq "-gradient") {
	    $gradient = shift(@arguments);
	    &RSAT::error::FatalError("$gradient\tInvalid color gradient. Supported: $supported_gradients")
		unless ($supported_gradients{$gradient});

=pod

=item B<-col_width #>

Width of the columns (in pixel). 

If the row height is to small, the label of the heatmap will not be indicated. (Default : 50 px)

=cut
	} elsif ($arg eq "-col_width") {
	    $col_width = shift (@arguments);
	    unless (&IsNatural($col_width) && ($col_width > 0)) {
		&RSAT::error::FatalError($col_width, "Invalid value for the column width. Must be a strictly positive natural number. If the column width is to small, the label of the heatmap will not be indicated.");
	    }

=pod

=item B<-row_height #>

Height of the rows (in pixel). 

If the row height is to small, the label of the heatmap will not be
indicated. (Default : 30 px)

=cut
	} elsif ($arg eq "-row_height") {
	    $row_height = shift (@arguments);
	    unless (&IsNatural($row_height) && ($row_height > 0)) {
		&RSAT::error::FatalError($row_height, "Invalid value for the row height. Must be a strictly positive natural number. If the row height is to small, the label of the heatmap will not be indicated.");
	    }

=pod

=item B<-min #>

Minimal value of the heatmap. By default, this value is the minimal
value of the input file. If the specified value is larger than the
minimal value of the heatmap, then the minimal value of the heatmap
will be used as minimal value.

=cut
	  } elsif ($arg eq "-min") {
	    $min_val = shift (@arguments);
	    unless (&RSAT::util::IsReal($min_val)) {
	      &RSAT::error::FatalError($min_val, "Invalid value for the minimal value. Must be a Real number.");
	    }


=pod

=item B<-max #>

Maximal value of the heatmap. By default, this value is the maximal
value of the input file. If the specified value is smaller than the
maximal value of the heatmap, then the maximal value of the heatmap
will be used as maximal value.

=cut
	} elsif ($arg eq "-max") {
	    $max_val = shift (@arguments);
	    unless (&RSAT::util::IsReal($max_val)) {
		&RSAT::error::FatalError($max_val, "Invalid value for the maximal value. Must be a Real number.");
	    }

=pod

=item B<-digits #>

Round the values to the specified number of digit.

=cut
	  } elsif ($arg eq "-digits") {
	    $digits = shift (@arguments);
	    unless (&RSAT::util::IsNatural($digits)) {
	      &RSAT::error::FatalError($digits, "Invalid value for the minimal value. Must be a Natural number.");
	    }

=pod

=item B<-lines>

Add black vertical and horizontal separations lines between the cells of the heatmap

=cut
	} elsif ($arg eq "-lines") {
	    $lines = 1;


=pod

=item B<-chaos>

The heatmap is a CHAOS Game Representation. This option enables to
label the angles of the figure with the nucleotide letters, activates
-no_text, and col_width equals row_height to obtain squares. see
I<chaos-table> for details on CHAOS Game Representation.

=cut
	} elsif ($arg eq "-chaos") {
	    $chaos = 1;


=pod

=item B<-r_plot>

Use R to generate the heatmap, rather than using the Perl GD module.

=cut
	} elsif ($arg eq "-r_plot") {
	  $Rscript_path = &RSAT::server::GetProgramPath("Rscript",0);
	  unless ($Rscript_path) {
	    &RSAT::message::Warning("Rscript program is not found in the path. Ignoring option -r_plot.");	
	  } else {
	    $r_plot= 1;
	  }
	    
	} else {
	    &FatalError("Invalid option", $arg);

	}
    }


=pod

=back

=cut

}

################################################################
## Verbose message is sent to STDOUT rather than output file  because incompatible wih image files.
sub Verbose {
    print "; draw-heatmap ";
    &PrintArguments();
    printf "; %-22s\t%s\n", "Program version", $program_version;
    if (%main::infile) {
	print "; Input files\n";
	while (my ($key,$value) = each %main::infile) {
	  printf ";\t%-13s\t%s\n", $key, $value;
	}
    }
    if (%main::outfile) {
	print "; Output files\n";
	while (my ($key,$value) = each %main::outfile) {
	  printf ";\t%-13s\t%s\n", $key, $value;
	}
    }
}


################################################################
## Generate all possible words of a given length
sub generate_words {
  our $w_length = shift;	
  my @alphabet = qw(A C G T);
  
  foreach my $previous_word (keys(%main::oligo_freq)){
    delete $main::oligo_freq{$previous_word};
    foreach my $residue (@alphabet){
      my $new_word = $previous_word.$residue;
      $main::oligo_freq{$new_word} = 1;
    }
  }
  
  my @all_words = (keys(%main::oligo_freq));
  unless (@all_words){
    foreach my $residue (@alphabet){
      $main::oligo_freq{$residue} = 1;
    }
    @all_words = (keys(%main::oligo_freq));
  }
  
  my $curr_length = length($all_words[0]);

  ## stop condition
  unless ($curr_length eq $w_length) {
    &generate_words($w_length);	
  }
}



################################################################
## Generate the heatmap using R
## R requires an .R file with the instructions to produce the graph.
## draw-heatmap options will be translated to R commands.
sub Rplot {

  ## Copy or generate inputfile.  Format will be assumed to be RSAT
  ## based with # as header and; comment char.
  my ($in) = &OpenInputFile($infile{input});
  our $tmp_infile = &RSAT::util::make_temp_file("", "draw-heatmap_Rplot_infile", 1);
  my ($in_copy) = &OpenOutputFile($tmp_infile);
  my @header_list=();
  my $in_lines = 0;
  my $in_columns = 0;
  while (<$in>) {
    next if (/^;/); # skip comment lines
    #      next if (/^#/); # We don't want to skip header line
    if (/^#/) {
      ## Get header if exists
      s/^#//;
      chomp();
      @header_list = split("\t+", $_);
      $header = "TRUE";
      print $in_copy $_, "\n";
      next;
    }
    print $in_copy $_;

    ## Count lines (used to compute heatmap height)
    $in_lines++;

    ## Count columns (used to compute heatmap width)
    my @fields = split("\t", $_);
    $in_columns = &RSAT::stats::max($in_columns, scalar(@fields));
  }  
  close $in_copy;
  close $in;
  if ($in_lines == 0) {
    &RSAT::message::FatalError("Input file contains not a single valid line.", $tmp_infile);
  }
  if ($main::verbose >= 3) {
    &RSAT::message::Info("Input table contains", $in_lines, "lines and", $in_columns, "columns.");
  }
  my $input_data_file = $tmp_infile;  ## Use input copy as input for R
  
  ## Open a file to write R instructions
  our $tmp_r_instructions_file = &RSAT::util::make_temp_file("", "draw-heatmap_Rplot_instructions", 1).".R";
  my ($out_R) = &OpenOutputFile($tmp_r_instructions_file);

  ## Color library
  my $r_instructions = ""; 
  $r_instructions .= "## Loading heatmap.simple() function\n";
  $r_instructions .= "source(file.path('".$ENV{RSAT}."', 'R-scripts', 'heatmap.simple.R'))\n";

  ## Read input file
  $r_instructions .= "\n## Loading input table\n";
  $r_instructions .= "in.file <- \"$input_data_file\"\n";
  my $rownames_arg = "NULL";
  if ($rownames) {
    $rownames_arg = "1";
  }
  $r_instructions .= "input.table <-  read.table(file=in.file, sep='\\t', comment.char=';', row.names=".$rownames_arg.", header=".$header.", na.strings='$null_char')\n";

  ## Compute min and max value for the heatmap colors
  if (&IsReal($min_val)) {
    $r_instructions .= "zmin <- ".$min_val."\n";
  } else {
    $r_instructions .= "zmin <- min(input.table)\n";
  }
  if (&IsReal($max_val)) {
    $r_instructions .= "zmax <- ".$max_val."\n";
  } else {
    $r_instructions .= "zmax <- max(input.table)\n";
  }

  ## Start image environment in R according to the output format
  $r_instructions .= "\n## Opening plot file\n";
  $r_instructions .= "outfile<-'".$outfile{output}."'\n";
  $r_width = $in_columns*$col_width + 80;
  $r_height = $in_lines*$row_height + 140;
  if (($img_format eq "pdf") || ($img_format eq "eps")) {
    $r_width = &RSAT::stats::max($r_width/72, 5);
    $r_height = &RSAT::stats::max($r_height/72, 2.5);
  }
  $r_dim = ", width=".($r_width).", height=".($r_height);
  if ($img_format eq "pdf") {
    $r_instructions .= "pdf( file= outfile".$r_dim.")\n";
  } elsif (($img_format eq "jpg") || ($img_format eq "jpeg")) {
    $r_instructions .= "jpg(file= outfile".$r_dim.")\n";
  } elsif ($img_format eq "png") {
    $r_instructions .= "png(file= outfile".$r_dim.")\n";
  } elsif ($img_format eq "eps") {
    $r_instructions .= "eps(file= outfile".$r_dim.")\n";
  } elsif ($img_format eq "gif") {
    &RSAT::error::FatalError("GIF format is not supported in R");
  }

  ## Compute the heatmap options
  my @heatmap_options = ();
  push @heatmap_options, "text.color='auto'";
  push @heatmap_options, "zlim=c(zmin, zmax)";
  if ($main::no_text) {
    push @heatmap_options, "display.values='FALSE'";
  } else {
    push @heatmap_options, "display.values='TRUE'";
  }
  push @heatmap_options, "round.digits=".$main::digits;
  if ($main::title) {
    push @heatmap_options, "main='".$main::title."'";    
  }
  my $heatmap_options = join", ", @heatmap_options;

#  $r_instructions .= "print(heatmap.simple)\n";

  ## Generate the heatmap
  $r_instructions .= "\n## Generating the heatmap\n";
  $r_instructions .= "heatmap.simple(input.table,".$heatmap_options.")\n";

  ## Close output file
  $r_instructions .= "silence <- dev.off()\n";

  ## Print the R instructions
  print $out_R $r_instructions;
  close ($out_R);

  ## Run the R script to generate the graph
  my $rscript_command = $Rscript_path." ".$tmp_r_instructions_file;
  &doit($rscript_command, $dry, $die_on_error, $verbose, $batch, $job_prefix);
  &RSAT::message::Info($rscript_command) if ($main::verbose >= 2);
}

__END__

=pod

=head1 SEE ALSO

=head2 convert-background-model

Heatmaps can be used to provide an intuitive feeling of Markovian
background models provided as transition matrices. Such models can be
obtained with the command.

 convert-background-model -i model.tab -from oligos -to transitions \
   | cut -f 1-5 | heatmap -out_format png -min 0 -max 1 \
      -o model_transition_heatmap.png


=head1 WISH LIST

=over

=item B<-out_format>

Add support for ps and pdf formats>

=item B<-title 'My title text'>

Display a title on the top of the image.

=item B<-xlab 'X label'>

Display the label along the X axis of the image.

=item B<-ylab 'Y label'>

Display the label along the Y axis of the image.

=back

=cut
