#!/usr/bin/perl -w
#Author: Feng Cheng
use warnings;
use strict;

my $in1 = $ARGV[0]; #-datafile--
my $in2 = $ARGV[1]; #-gene--
my $nums = $ARGV[2]; #-non-ortholog--
my $out = $ARGV[3]; #-TD--
my $eval = 1e-20;

&process($in1,$in2,$nums,$out,$eval);

sub process {
  my ($in1,$in2,$nums,$out,$eval) = @_;

  my (%i2chr,%i2gene,%gene2i);
  &readGene($in1,\%i2chr,\%i2gene,\%gene2i);

  my %pgene;
  &readData($in2,\%pgene,$eval);

  &output($out,\%i2chr,\%i2gene,\%gene2i,\%pgene,$nums);

}

sub output {
  my ($out,$i2chr,$i2gene,$gene2i,$pgene,$nums) = @_;
  my ($startg,$flag,$td,$j,$gnum,%i2rec);
  my @is = keys %$i2chr;
  my $in = @is;
  my $i = 1;
  open(my $FW,">$out");
  while($i<$in) {
    if($i==1) {
      $td = $i2gene->{$i};
      $i2rec{$i} = "Y";
      #$startg = $i2gene->{$i};
      $flag = 1;
      $gnum = 0;
      $j = $i+1;
    }
    else {
      #$td = $i2gene->{$i};
      $j = $i+1;
      $flag = 1;
      $gnum = 0;
    }    

    my $recG = $in + 100;
    while($flag==1 && $j<=$in) {
      while(exists($i2rec{$j})) {
        $gnum += 1;
        $j += 1;
      }
      my $stepg = $i2gene->{$j};
      my $stepchr = $i2chr->{$j};
      #print "$i\t$j\n";
      my @tds = split(/;/,$td);
      my $num = @tds;
      my $lbe = 0;

      if($gnum<=$nums) {
        for(my $k=0;$k<$num;$k+=1) {
          my ($pg1,$pg2) = ($stepg.":".$tds[$k],$tds[$k].":".$stepg);
          my $ti = $gene2i->{$tds[$k]};
          my $pchr = $i2chr->{$ti};
          if($pchr eq $stepchr) {  
            if(exists($pgene->{$pg1}) || exists($pgene->{$pg2})) {   #-tune here to define the array--
              $lbe = 1;
            }
          }
        }
      }
      if($lbe==0) {
        if($j<$recG && !exists($i2rec{$j})) {
          $recG = $j;
        }
        $gnum += 1;
        if($gnum>$nums) {
          $flag = 0;
          if($num>1) {
            print $FW "$num\t$td\n";
          } 
          #$i = $j;
          $i = $recG;
          $td = $i2gene->{$i};
          $i2rec{$i} = "Y";
          #$startg = $i2gene->{$i};
        }
      }
      if($lbe==1) {
        $td .= ";$stepg";
        $i2rec{$j} = "Y";
      }
      if($j==$in) {
        $i = $j;
      }
      if($flag==1) {
        if($j==$in) {
          my @ttds = split(/;/,$td);
          my $tnum = @ttds;
          if($tnum>1) {
            print $FW "$tnum\t$td\n";
          }
        }
        $j += 1;
      }
    }
  }
  close($FW);
}

sub readGene {
  my ($in,$i2chr,$i2gene,$gene2i) = @_;
  #my $out = $in.".sorted";
  #open(my $FR1,$in);
  #open(my $FW,">$out");
  #my @input1 = map{[$_,(split(/\t/))[1],(split(/\t/))[2],(split(/\t/))[3]]} <$FR1>;
  #my @input2 = sort{$a->[1] cmp $b->[1] || $a->[2] <=> $b->[2] || $a->[3] <=> $b->[3]} @input1;
  #my @sorted = map{$_->[0]} @input2;
  #for(@sorted) {
  #  print $FW "$_";
  #}
  #close($FR1);
  #close($FW);

  my $i = 1;
  #open(my $FR2,$out);
  open(my $FR1,$in);
  while($_=<$FR1>) {
    chomp;
    my @temp = split(/\t/);
    $i2chr->{$i} = $temp[0];
    $i2gene->{$i} = $temp[1];
    $gene2i->{$temp[1]} = $i;
    $i += 1;
  }
  close($FR1);
  #unlink $out;
}

sub readData {
  my ($in,$pgene,$eval) = @_;

  open(my $FR,$in);
  while($_=<$FR>) {
    chomp;
    my @temp = split(/\t/);
    #if($temp[0] ne $temp[1] && $temp[10]<$eval) {
    if($temp[1] ne $temp[3]) {
      my $pg1 = $temp[1].":".$temp[3];
      my $pg2 = $temp[3].":".$temp[1];
      if(!exists($pgene->{$pg1}) && !exists($pgene->{$pg2})) {
        $pgene->{$pg1} = "Y";
      }
    }
  }
  close($FR);
}


