#!/usr/bin/perl

############################################################
#	xendex <gi> [-talk=<0..5>] [-e=<evalue>] [-d=<min.dom.>] [-o=<max.overlap>]  [-s=<pos.step>] [-f=<fam.depth>] [-g=<max.gen>] [-talk=<talk.level>]
############################################################

############################################################
#	some pre-defined things for short
############################################################
my $eva_thr = 0.01;
my $dom_len = 50;
my $dom_over = 0.25;
my $dom_step = 5;
my $homotaxon = "Bacteria";
my $identifam = "Chlamydiales";
my $identigen = "Chlamydia";
my $fam_depth = 4;
my $max_genus = 5;
my $talk = 0;	# 0 - result only
		# 1 - overlap analysis
		# 2 - extended hits
		# 3 - unextended hits
		# 4 - hits on the side
		# 5 - BLAST hits

############################################################
#	global variables
############################################################
%taxS;%taxF;%taxG;
$query_len;
@hitlist;
%badpair;

############################################################
#	code start
############################################################

my_args(@ARGV);

die "xendex <gi> [-e=<evalue>] [-d=<min.dom.>] [-e=<max.overlap>]  [-s=<pos.step>] [-f=<fam.depth>] [-talk=<talk.level>]\n" unless($myGlobList[0]);
$eva_thr = $myOptList{"e"} if(defined $myOptList{"e"});
$dom_len = $myOptList{"d"} if(defined $myOptList{"d"});
$dom_over = $myOptList{"o"} if(defined $myOptList{"o"});
$dom_step = $myOptList{"s"} if(defined $myOptList{"s"});
$fam_depth = $myOptList{"f"} if(defined $myOptList{"f"});
$max_genus = $myOptList{"g"} if(defined $myOptList{"g"});
$talk = $myOptList{"talk"} if(defined $myOptList{"talk"});

if($dom_over*2>$dom_len){
 die "MAX domain overlap (".$dom_over.") should be less than half of the MIN domain lenght (".$dom_len.")\n";
}
foreach my $gi (@myGlobList){
 @hitlist=();				# hit list empty
 run_blast($gi);			# collect hits
 get_tax($gi);				# collect tax data
 clean_list();				# purge the same family
 for(my $pos=$dom_len+1;$pos<=$query_len-$dom_len+1;$pos+=$dom_step){
  my $hita="";my $sidea="";my $hitb="";
  foreach my $hit (@hitlist){
   my ($gi,$ev,$r1,$r2) = split/\t/,$hit;
   my $dl = $r2-$r1+1;
   ###	print "HIT ".$hit."\tat the pos ".$pos."\n";
   next if($dl<$dom_len);		# skip very short hits
   next if(($pos-$r1)/$dl>$dom_over && ($r2-$pos)/$dl>$dom_over);	# skip pos overlaps
   my $mid = ($r1+$r2)/2;
   my $side = ($pos-$mid<0)?(1):(-1);
   ###	print "HIT ".$hit."\ton the side ".$side."\n";
   next if($side==$sidea);
   if($sidea){
    $hitb = $hit;
    if($talk>=4){
     print "POS:\t".$pos."\n\tLO:\t".($pos-$r1)/$dl."\n\tRO:\t".($r2-$pos)/$dl."\n";
     print "\tB:\t".$hit."\n";
    }
    last;
   }else{
    $hita = $hit;
    if($talk>=4){
     print "POS:\t".$pos."\n\tLO:\t".($pos-$r1)/$dl."\n\tRO:\t".($r2-$pos)/$dl."\n";
     print "\tB:\t".$hit."\n";
    }
    $sidea = $side;
   }
  }
  next unless($hita and $hitb);
  next if($badpair{$hita."\t".$hitb});
  ###	exit;
  my @ha = split/\t/,$hita;my $la = $ha[3] - $ha[2] + 1;
  my @hb = split/\t/,$hitb;my $lb = $hb[3] - $hb[2] + 1;
  if((min($ha[3],$hb[3])-max($ha[2],$hb[2]))/min($la,$lb)>$dom_over){
   $badpair{$hita."\t".$hitb}=1;
   next;
  }
  if($talk>=3){
   print "POS\t".$pos."\n";
   print "unextended A\t".$hita."\n";
   print "unextended B\t".$hitb."\n";
  }
#	look for possible extension of hita
  foreach my $hit (@hitlist){
   last if($hit eq $hita);
   my @hx = split/\t/,$hit;my $lx = $hx[3] - $hx[2] + 1;
   my $tx1 = max($hx[2],$hb[2]);
   my $tx2 = min($hx[3],$hb[3]);
   if(($hx[2]-$ha[2])/min($la,$lx)<=$dom_over &&
      ($ha[3]-$hx[3])/min($la,$lx)<=$dom_over &&
      ($tx2-$tx1)/min($lb,$lx)<=$dom_over){
    $hita = $hit;
    ###	print "\taccept\n";
    last;
   }
  }
#	look for possible extension of hitb
  foreach my $hit (@hitlist){
   last if($hit eq $hitb);
   my @hx = split/\t/,$hit;my $lx = $hx[3] - $hx[2] + 1;
   my $tx1 = max($hx[2],$ha[2]);
   my $tx2 = min($hx[3],$ha[3]);
   if(($hx[2]-$hb[2])/min($lb,$lx)<=$dom_over &&
      ($hb[3]-$hx[3])/min($lb,$lx)<=$dom_over &&
      ($tx2-$tx1)/min($la,$lx)<=$dom_over){
    $hitb = $hit;
    ###	print "\taccept\n";
    last;
   }
  }
# have a pair of non-overlapping hits
  if($talk>=2){
   print "extended A\t".$hita."\n";
   print "extended B\t".$hitb."\n";
  }
  next if($badpair{$hita."\t".$hitb});
  my @ha = split/\t/,$hita;my $la = $ha[3] - $ha[2] + 1;
  my @hb = split/\t/,$hitb;my $lb = $hb[3] - $hb[2] + 1;
  my $taxa = $taxS{$ha[0]};
  my $taxb = $taxS{$hb[0]};
  if($taxa eq $taxb ){
   $badpair{$hita."\t".$hitb}=1;
   next;
  }
  if($talk>=1){
   print "taxonomy A\t".$taxa."\n";
   print "taxonomy B\t".$taxb."\n";
  }
# have a pair of non-overlapping hits of different taxons
  $kill_pair = 0;
  %genlist = ();
  if($taxa ne $homotaxon){	# analyze overlaps of hita
   foreach my $hit (@hitlist){
    last if($hit eq $hita);
    my @hx = split/\t/,$hit;my $lx = $hx[3] - $hx[2] + 1;
    if(($hx[2]-$ha[2])/min($lx,$la)<=$dom_over &&
       ($ha[3]-$hx[3])/min($lx,$la)<=$dom_over){		# have overlap
     my $taxx = $taxS{$hx[0]};
     if($talk>=1){
      print "A overlapped by\t".$hit."\t".$taxx."\t".$taxG{$hx[0]}."\n";
     }
     if($taxx eq $taxa){				# overlap by the same taxon
      $badpair{$hita."\t".$hitb} = 1;
      $kill_pair=1;
      last;
     }elsif($taxx eq $homotaxon){
      $genlist{$taxG{$hx[0]}} = 1;
     }
    }
   }
   next if($kill_pair);
   if(scalar(keys %genlist)>$max_genus){
    $badpair{$hita."\t".$hitb} = 1;
    last;
   }
  }
  %genlist = ();
  if($taxb ne $homotaxon){	# analyze overlaps of hitb
   foreach my $hit (@hitlist){
    last if($hit eq $hitb);
    my @hx = split/\t/,$hit;my $lx = $hx[3] - $hx[2] + 1;
    if(($hx[2]-$hb[2])/min($lx,$lb)<=$dom_over &&
       ($hb[3]-$hx[3])/min($lx,$lb)<=$dom_over){		# have overlap
     my $taxx = $taxS{$hx[0]};
     if($talk>=1){
      print "B overlapped by\t".$hit."\t".$taxx."\t".$taxG{$hx[0]}."\n";
     }
     if($taxx eq $taxb){				# overlap by the same taxon
      $badpair{$hita."\t".$hitb} = 1;
      $kill_pair=1;
      last;
     }elsif($taxx eq $homotaxon){
      $genlist{$taxG{$hx[0]}} = 1;
     }
    }
   }
   next if($kill_pair);
   if(scalar(keys %genlist)>$max_genus){
    $badpair{$hita."\t".$hitb} = 1;
    last;
   }
  }
  print $gi." (".$query_len.")   Pos = ".$pos."\n";
  print "\t".$hita."\t".$taxa."\t".$taxG{$ha[0]}."\n";
  print "\t".$hitb."\t".$taxb."\t".$taxG{$hb[0]}."\n";
  last;
 }
}

sub run_blast
{
 my $gi = $_[0];
 my ($ra1,$ra2,$hev,$sev,$hgi,$tmp);
 print STDERR "[".$gi."]\n";
 foreach my $line (split/\n/,`gi2fasta $gi | splishpgp nr | blast2flat`){
 #foreach my $line (split/\n/,`cat tmp.fa | splishpgp nr | blast2flat`){
 ###	print STDERR "[".$line."]\n";
  ($tmp) = ($line =~ m/^QLEN\t(.+)$/);
  if($tmp){
   $query_len = $tmp;next;
  }
  ($tmp) = ($line =~ m/^HGI\t(.+)$/);
  if($tmp){
   $hgi = $tmp;
   $hev = 1000.0;
   $ra1 = 1000000000;$ra2 = 0;
   next;
  }
  ($tmp) = ($line =~ m/^EVALUE\t(.+)$/);
  if($tmp){
   $sev = $tmp;
   $hev = $tmp if($tmp<$hev);
   last if($hev>$eva_thr);
   next;
  }
  ($tmp) = ($line =~ m/^QRANGE\t(.+)$/);
  if($tmp){
   next if($sev>$eva_thr);
   my ($qr1,$qr2) = ($tmp =~ m/(\d+)\.\.(\d+)/);
   $ra1 = $qr1 if($qr1<$ra1);
   $ra2 = $qr2 if($qr2>$ra2);
   next;
  }
  ($tmp) = ($line =~ m/^END_HIT/);
  if($tmp){
   push @hitlist,join "\t",($hgi,$hev,$ra1,$ra2);
   if($talk>=5){
    print $hitlist[@hitlist-1]."\n";
   }
  }
 }
}

sub get_tax
{
 my $cmd = "gi2taxnode -table -complete ".$_[0];
 foreach my $hit (@hitlist){
  my ($gi) = split/\t/,$hit;
  $cmd .= " ".$gi;
 }
 my $first = 1;
 foreach my $tab (split/\n/,`$cmd`){
  my ($gi,$txa) = split/\t/,$tab;
  my @tax = split /\s+;\s+/,$txa;
  my ($gn,$sp) = split/\s+/,$tax[@tax-1];
  $taxS{$gi} = $tax[0];
  $taxG{$gi} = $gn;
  if($first){
   $homotaxon = $tax[0];
   $identifam = $tax[@tax - $fam_depth];
   $identigen = $gn;
   $first = 0;
  }
  $taxF{$gi} = 0;
  $taxF{$gi} = 1 if($tax[0] eq $homotaxon);
  $taxF{$gi} = 2 if($txa =~ m/\b$identifam\b/);
  $taxF{$gi} = 3 if($gn eq $identigen);
  ###	print (join ("\t",($gi,$taxS{$gi},$taxG{$gi},$taxF{$gi},$gn."_".$sp))); print "\n";
 }
 ###	print $homotaxon."\t".$identifam."\t".$identigen."\n";
 ###	exit;
}

sub clean_list
{
 my @tmp = @hitlist;
 @hitlist = ();
 foreach my $hit (@tmp){
  my ($gi,$rest) = split/\t/,$hit;
  next if($taxF{$gi}>=2);		# skip the same family
  push @hitlist,$hit;
  ###	print $hit."\t".$taxS{$gi}."\t".$taxG{$gi}."\n";
 }
 ###	exit;
}

sub max
{
 my $max = shift;
 while(@_){
  my $x = shift;
  $max = $x if($x>$max);
 }
 return $max;
}

sub min
{
 my $min = shift;
 while(@_){
  my $x = shift;
  $min = $x if($x<$min);
 }
 return $min;
}

sub my_args
{
 my $nop = scalar @_;
 for($i=0;$i<$nop;$i++){
  if($_[$i]=~m/^-[^=]+=$/){
   my $new = $_[$i].$_[$i+1];
   splice @_,$i,2,$new;
  }
 }
 foreach my $arg (@_){
  my ($opt) = ($arg =~ m/-(\w+)/);
  my ($val) = ($arg =~ m/-\w+=(.*)/);
  if($opt){
   $myOptList{$opt} = $val;
  }else{
   push @myGlobList,glob $arg;
  }
 }
}
