#!/usr/bin/perl
use strict;

my $usage= << "JUS";
 usage: motivplot.pl [options] list-of-files

    The list-of-files is a space separated list of files in the .data format. 
    Wildcards can be used too. Commonly files with ending .merged should be 
    passed. The output is a xmgrace directory that contains .grace and .ps files.

  Options:
    -t   In case data is used that was originally derived from AlignAce, this option
         will delete the AlignAce typical "stairs".

    -p   This forces to draw the program names into the graph legend. Default is
         drawing of hox names. 

JUS

my @options = grep {substr($_, 0, 1) eq '-'} @ARGV;
my @infiles  = grep {substr($_, 0, 1) =~ /^[^-]/} @ARGV;

die "$usage\n" unless scalar(@infiles) != 0;


my $mit_score = 0;
my $grill = 0;
my $tierein = 1;

# Choose options
foreach my $option (@options){
  if    ($option eq '-s')               { $mit_score = 1  }
  if    ($option eq '-t')               { $grill = 1   }
  if    ($option eq '-p')               { $tierein = 0 }
}

my $outdir = "motivplot";

if(!(-e $outdir)) { mkdir($outdir)};

my $scorefile;
my $out;
my $outdatei;
my $reihenfolge;

# Wir starten mit einem offset 
my $score_offset = 0.1;


foreach $scorefile (@infiles){
	my @dateiname;
	@dateiname = split(/\./,$scorefile);
	
	$out = &score($dateiname[0], $scorefile);
	$outdatei = "$scorefile.grace";

	open(FO,">" . $outdir . "/" . $outdatei) or die "error by opening output file";
	print FO $out;
	system("xmgrace $outdir/$outdatei -hardcopy -printfile $outdir/$outdatei.ps");
	
	close(FO);
}

&mehrere;






sub score{

  my $legend = $_[0];
 
  # Oeffne data file
  open(FI,"< $_[1]") or die "error by opening input file";
  my @cwlines = <FI>;

  chop @cwlines;
  my @start;
  my @stop;
  my @score;
  my @motif;
  my @motif_score_lvl;

  my %dubletten=();
  my $cwline;
  my $j = 0;
  my $prog;
  my $tier;
  
  my $nodb_data_exists = 0;
  my $merged_data_exists = 0;


  
  foreach $cwline (@cwlines){

    my @zwischen = split(/\t/,$cwline);
    
    $start[$j] = $zwischen[0];
    $stop[$j] = $zwischen[1];
    
    # um spaeter zwischen in db gefundenen motifs
    # und nicht gefundenen (nodb) unterscheiden zu koennen.
    $motif[$j] = $zwischen[3];
    $motif_score_lvl[$j] = -1;

    if($zwischen[3] =~ m/M/) {
      $merged_data_exists = 1;
    } else { 
      $nodb_data_exists = 1;
    }

    $prog = $zwischen[5];
    $tier = $zwischen[7];

    $score[$j] = $zwischen[2];

    if($prog =~ /meme/i){ #  Logaritmus
      $score[$j] = (((substr($zwischen[2],-2,2)) * 10));
     }
    if($prog =~ /alignace/i){
      #$score[$j] = $zwischen[2];
      $score[$j] = (sprintf("%.0f", $zwischen[2]));
     }
    if($prog =~ /biop/i){
      #$score[$j] = (($zwischen[2] * 1000)-1950);
      #neue webinterface bioprospector
      $score[$j] = (($zwischen[2] * 1000)-2400);
     }
    if($prog =~ /pwmatch/i){
       $score[$j] = (int($zwischen[2] * 10));
     }
    if($prog =~ /tfsearch/i){
      $score[$j] = ($zwischen[2] * 100);
     }
    if($prog =~ /ymf/i){
      $score[$j] = ((sprintf("%.0f", $zwischen[2]))*3);
     }
    $j++;
  }
  
  # Grillen von Treppen
  if($prog =~ /alignace/i && $grill == 1) {
    my %intervall = ();
    my %score_hash = ();
    
    for(my $l=0;$l<=@start;$l++)  {
      # mit Motivl�ge
      #if($intervall{$start[$l]} < $stop[$l]) {
      
      # mit Score
      if($score_hash{$start[$l]} < $score[$l]) {
	$intervall {$start[$l]} = $stop[$l];
	$score_hash {$start[$l]} = $score[$l];
      }
      
    }
    @start = ();
    @stop = ();
    @score = ();
    my $m =0;
    foreach my $hashkey (keys(%intervall)) {
      $start[$m] = $hashkey;
      $stop[$m] = $intervall{$hashkey};
      $score[$m] = $score_hash{$hashkey};
      #print "key: $hashkey, value: $intervall{$hashkey}\n";
      $m++;
    }

  }


  # Wir wollen zwischen 2 Arten von Motifs (Datensaetzen) unterscheiden: 
  # Welche, die ueber MatCompare in der entsprechenden DB (Jaspar,Transfac)
  # gefunden wurden (die Motifnr. ist M00*) oder welche die nicht gefunden wurde
  # (Motifnr. Nat.Zahl).
  my $merged_data;
  my $nodb_data;

  # D.h. es gibt nodb data
  if($merged_data_exists) {
    $merged_data = "@    s0 legend  \"" . $legend . "\"\n";
    $merged_data .= "#" . $prog."\t".$legend."\n&\n";    
  }
  if($nodb_data_exists) {
    $nodb_data = "@    s0 legend  \"nodb\"\n";
    $nodb_data .= "#" . $prog."\tnodb\n&\n";    
  }


  my $i;   # bp position 
  my $k;    
  my $max_score_level = 0;  
  

  for(my $i=0; $i <= 500; $i++){
    
    my $score_level = 0.1;  

    for(my $k = 0; $k < ($#start + 1); $k++){
      
      # Schau ob an dieser bp Position ein Motif k liegt
      if($start[$k] <= $i && $stop[$k] >= $i){
	
	  # Hier kommt ein neues motif
	  if($motif_score_lvl[$k] == -1) {
	    
	    # Waehle einen freien, so kleinen wie moeglichen, score_lvl aus
	    for(my $loop1 = 0.1; $loop1 < 50.0; $loop1 += 0.1 ) {

	      my $lvl_taken = 0;

	      for(my $loop2 = 0; $loop2 < ($#start + 1); $loop2++) {
		
		if($loop1 == $motif_score_lvl[$loop2]) {
		  $lvl_taken = 1;
		  last;
		}
	      } # end of for ($loop2)
	      
	      if($lvl_taken == 0) {
		$motif_score_lvl[$k] = $loop1;
		last;
	      }
	    } # end of for ($loop2) 
	  } # end of if ($motif_score_lvl)
        
	  # Falls ein neues motif an dieser position erscheint brauchen wir das level.
 
	  $score_level += 0.1;

	  # Ist das aktuelle Motif aus der DB oder nicht
	  if($motif[$k] =~ m/M/) {
	    $merged_data .= $i . " " . ($score_offset + $motif_score_lvl[$k])  . "\n";	    
	  } else {
	    $nodb_data .= $i . " " . ($score_offset + $motif_score_lvl[$k])  ."\n";	    
	  }
	  
	  # Falls der letzte bp des Motifs: reset den score_lvl
	  if($stop[$k] == $i) {
	    $motif_score_lvl[$k] = -1;
	  }
      } # end of if ($start)
    } # end of for ($k)
    

    # Jetzt schau ob der score_level maximal ist
    if($score_level > $max_score_level) {
      $max_score_level = $score_level;
    }
  } # end of for ($i)

  # Im naechsten Funkt. Aufruf haben wir einen neuen score_offset
  if( $max_score_level > 1) {
    $score_offset += $max_score_level;
  } else {
    $score_offset += 1.0;
  }
  return $merged_data . $nodb_data;
}


sub mehrere{
	my $out = "";
	my $outanf = "";
	my $k = 0;
	my $prog;
	my $tier;

	# find all grace files
	my @grace_datein = glob "$outdir/*.grace";

	# xmgrace header
	$outanf .= "@    xaxis label \"Position in den 500 Basenpaaren\"\n";
	$outanf .= "@    yaxis off\n";
	$outanf .= "@    legend 0.2, 1\n";
	
	
	# flag ob ein nodb bereits geschrieben wurde
	my $first_nodb = 1;
	my $color = 2;
	
        # open each file
	foreach my $file (@grace_datein){
	
	  if($file !~ m/all.grace/) {
		    
	    open(FI,"< $file") or die "error by opening input file";
	    open(FO,">" .  $outdir . "/all.grace") or die "error by opening output file";

	    my @lines = <FI>; chop @lines; my $line;


	    # Gehe jede Zeile durch und schaue nach headern, 
            # Falls nur ein header fuer den nodb header existiert
            # so wird die Farbe fuers Motif nicht eingesetzt und deswegen 
            # nicht inkrementiert. Das muss danach gemacht werden.
	    
	    my $only_nodb_header = 1;

	    foreach $line (@lines){
	    
	      if($line =~ /#/){
				 
		 my @z = split(/\t/,$line);
		 $prog = substr($z[0],1,10);
		 
		 $tier = $z[1];
		 		 
		 print $prog . " " . $tier."\n";
		 $outanf .= "@\ts".$k." symbol 11\n";
		 $outanf .= "@\t\ts".$k." symbol size 2\n";
		 $outanf .= "@\t\ts".$k." symbol fill color 1\n";
		 $outanf .= "@\t\ts".$k." symbol char 45\n";
		 $outanf .= "@\t\ts".$k." line type 0\n";
		 
		 if($tier =~ m/nodb/) {
		   $outanf .= "@\t\ts".$k." symbol color 1\n";

		   # Falls es der erste nodb eintrag ist...
		   if($first_nodb == 1) {
		     $outanf .= "@\t\ts".$k." legend  \"Nicht in Motif-DB\"\n";
		     $first_nodb = 0;
		   }
		     
		 } else {

		   $only_nodb_header = 0;
		   
		   $outanf .= "@\t\ts".$k." symbol color $color\n";
		   
		   $color++;
		   # Ueberspring farbe gelb (5)
		   if($color == 5) {
		     $color++;
		   }
		   
		   
		   if ($tierein == 1) {
		     $outanf .= "@\t\ts".$k." legend  \"".$tier."\"\n";
		   } else {		   
		     $outanf .= "@\t\ts".$k." legend  \"".$prog."\"\n";
		   }
		 }
		 
		 $k++;
	       		 
	       } # end of if ($line)
	      
	      if($line =~ /@/){
	      }
	      else{
		$out .= $line."\n";
	      }
	    } # end of foreach $line


	    if($only_nodb_header == 1) {
	      $color++;
	      if($color == 5) {
		$color++;
	      }

	      $only_nodb_header = 1;
	    }

	  } # end of else 
	} # end of for $files
      



	$out = $outanf.$out;

	print FO $out;
	close(FO);
	system("xmgrace $outdir/all.grace -hardcopy -printfile $outdir/all.ps");
      }

