#!/usr/bin/perl
# apclass_idxdnacn.pl  name.genexcopy name.apvals.rtab
# add to evigenes/genes/altparsnpdist.pl

use strict;

my($IDX_PAR,$IDX_ALT,$IDX2CN)=(35,85,55); # 55 best? idx2cn 85,35 == max,min, weed,hum differ on best
my $DOGROUP= $ENV{evg}||$ENV{dogroup}||0;
my $OUTALL= $ENV{outall}||0;

# use constant { cALT => -1, cPAR => 1, cUNK => 0 };
#.. switch to these altparsnpdist.pl const:
use constant { 
  ISPAR_CERT => 3, ISPAR_LIKE => 2, ISPAR_MAY => 1, 
  ISALT_CERT => -3, ISALT_LIKE => -2, ISALT_MAY => -1, 
  ISPAR_DUNNO => 0 };
use constant { cALT => ISALT_MAY, cPAR => ISPAR_MAY, cUNK => ISPAR_DUNNO };

print "#apclass Simple_Altpar_classifier: apclass=(idmax>=$IDX_ALT)?alt:(idmax<=$IDX_PAR)?par:(dnacn>=1.5)?par:alt \n";
# opt to output same apvals.rtab, w/ added class calls.

my($ngx,$egid,%tcopy, %clen, %tcall, %ctype, %sim, %ispar)=(0);
my @Icall= (2,8,16,18); # ,20
my @Kcall;
my(@gout); # $DOGROUP

sub MAIN_stub {}
while(<>) {
  if(/^\W/){ 
    # #iname=tmps4d/EVGm000088.msa : pick EVgroup id
    if(/iname=(\S+)/){ 
      my $d=$1; my $i=rindex($d,'/'); if($i >= 0){ $d=substr($d,$i+1); } $d=~s/\.\w+$//; 
      if($DOGROUP and @gout) {  groupout($egid,\@gout,\%sim,\%ispar); @gout=(); %ispar=%sim=(); }
      $egid=$d; print "#iname=$egid\n"; } 
    next; 
  }
  
  chomp; my @v=split"\t"; 
  if(@v<11){ 
    my($id,$cw,$tcopy,$ucla)=@v[0,1,4,6]; 
    $id=~s/hs22ttref:/Hs_/; 
    $tcopy{$id}=$tcopy; $clen{$id}=$cw; $ngx++;
    next; 
  }
  my @nv; my @vout= @v;
  my($id,$jd,$refp,$dnacn,$isp,$idmax,$cp)=@nv= @v[0,1,2,3,4,9,18];
  my @apcalls= @v[@Icall];
  my($cidp,$ctcl,$tcl,$tci,$tcj,$idmax_tc)=(0) x 9;
  if(/^ID/){ 
    $vout[18]= $apcalls[3]= $nv[6]= $cp="Cidpar";  
    #($ctcl,$tcl,$tci,$tcj)=qw(Cijpar Tcl Tci Tcj);
    my @vadd= qw(Cijpar Tcl Tci,j); #? i,j for nv vout
    push @nv, @vadd;  push @vout, @vadd, "Leni,j";  
    push @apcalls,"Cijpar"; @Kcall= @apcalls;
    
  } else { 
    $tci=$tcopy{$id}||$dnacn; $tcj=$tcopy{$jd}||0; 
    $cidp= classxd($idmax,$dnacn); 
    ($ctcl,$tcl,$idmax_tc)= classxdv($idmax,$tci,$tcj);  
    $vout[18]= $nv[6]= $cp= $cidp."_id";  $ctcl .= "_tc";
    $apcalls[3]= $cp;
    my $lni=$clen{$id}||0; my $lnj=$clen{$jd}||0; 
    push @nv, $ctcl,$tcl,"$tci,$tcj"; # ,"$lni,$lnj";
    push @vout, $ctcl,$tcl,"$tci,$tcj","$lni,$lnj";
    push @apcalls,$ctcl;
    
    if($DOGROUP) {
      $sim{$id}{$jd}= $idmax_tc; # $idmax; #?? 
      $ispar{$id}{$jd}= ($ctcl=~/par/)?cPAR :($ctcl=~/alt/)?cALT: cUNK;      
    }
    
    my $cref=$apcalls[0];
    for(my $j=1; $j<5; $j++){ 
      my $c=$apcalls[$j] or next; my $k= $Kcall[$j]; 
      $tcall{$k}{$cref}{$c} ++;
      $ctype{$k}{$c}++;
    }

  }
  
  if(0){ my $nd=$nv[3]; $nv[3]=$nv[6]; $nv[6]=$nd; } # swap cols Dnapar <> Cidpar, dont need this
  
  if($DOGROUP) { push @gout, ($OUTALL)? \@vout : \@nv;  } # save @vout/@nv, print for each $egid group w/ new egroup_ap
  elsif($OUTALL){ print join("\t",@vout)."\n";  }
  else { print join("\t",@nv)."\n";  }

}
if($DOGROUP and @gout) {  groupout($egid,\@gout,\%sim,\%ispar); @gout=(); %ispar=%sim=(); }

print_crosstable();

#-----------------------------

sub groupout {
  return (1) ? groupout_ispar(@_) : groupout_sim(@_);  
}

sub groupout_sim {
  my($egid,$gout,$sim)=@_;
  
  my($SGID)=(0,0); 
  my(@sgid,%sgidx,%sgroup,%gsim);
  my @ids= sort keys %$sim;
  
  # my %simm; 
  # for my $id (@ids) { my $sx=0; 
  #   for my $jd ( @ids) { if($id ne $jd){ my $s= $sim->{$id}{$jd}; $sx=$s if($s > $sx); } }
  #   $simm{$id}= $sx;
  # }
  # @ids= sort{ $simm{$b} <=> $simm{$a} or $a cmp $b } @ids;
  
  # need recursive grouping, remove @sgr id,jd from @ids, add idof(@sgr) and $smax to %sim..
  while(@ids > 0) { # .. group all
  
    my $smax=0; my @sgr=();
    for my $id (@ids) {
    
      for my $jd ( @ids, @sgid) { next if($id eq $jd);
        my $sim= $sim->{$id}{$jd} || $gsim{$id}{$jd} || 0; # ?? not $gsim{$jd} .. it is always > next sim set
        if($sim > $smax) { @sgr= ($id,$jd);  $smax=$sim; } 
        elsif($sim == $smax and $id eq $sgr[0]) { push @sgr, $jd; }
      }
      
    }

    my $sgid= "Pg" . ++$SGID;  push @sgid,$sgid; $sgidx{$sgid}= $smax;
    my @xid=@sgr; ## for my $sgr (@sgr){ push @xid, @$sgr; } 
    my %xid= map{ $_,1 } @xid;
    map{ $sgroup{$_}= $sgid } @xid;
    @ids= grep{ not $xid{$_} } @ids;
    for my $id (@ids) {
      # my $xmin=100; for my $xd (@xid) { my $s= $sim->{$id}{$xd}; $xmin=$s if($s<$xmin); } #  
      my $xmin=0; for my $xd (@xid) { my $s= $sim->{$id}{$xd} || $gsim{$id}{$xd}; $xmin=$s if($s>$xmin); } # ?? 
      $gsim{$id}{$sgid}=$xmin;
    }
  }
   
  for my $vo (@$gout) {
    my($id,$jd)=@$vo;
    my $etid= $egid; my($idp,$jdp);
    if($id =~ /^ID/){ $idp="ETid"; }
    else { 
      $idp= $sgroup{$id}||0;  my $jdp= $sgroup{$jd}||0; 
      my $sim= $sim->{$id}{$jd};
      $idp= "$etid.$idp.$jdp,$sim";
    }
    print join("\t",@$vo,$idp)."\n"; 
  }
}  

sub groupout_ispar {  # use this, %ispar
  my($egid,$gout,$sim,$ispar)=@_;
  
  my($SGID)=(0,0); 
  my(@sgid,%sgidx,%sgroup,%gsim,%gisalt,%gpar);
  
  my @ids= sort { $clen{$b} <=> $clen{$a} or $a cmp $b } keys %$sim;
  
  my %simm; # ? sort by hi sim may put short alts at top, use clen?
  for my $id (@ids) { 
    my $sx=0; my $ilen= $clen{$id}||1;
    for my $jd (@ids) { if($id ne $jd){ 
      my $jlen= $clen{$jd}||1;
      my $s = $sim->{$id}{$jd} / 100; 
      my $sl= ($jlen<$ilen)? $jlen*$s : $ilen*$s; # try sort by max ident bases
      $sx=$sl if($sl > $sx); 
      } 
    }
    $simm{$id}= $sx;
  }
  @ids= sort{ $simm{$b} <=> $simm{$a} or $a cmp $b } @ids;
  
  # need recursive grouping, remove @sgr id,jd from @ids, add idof(@sgr) and $smax to %sim..
  # NOTE: id can have both alt and par pairs of same evgroup, sort above affects which is final call,
  #  .. can count these ambig. ids, no clear resolution, unless majority vote desired, vs above sort on max-ident
  
  while(@ids > 0) { # .. group all
    my $id= shift @ids; # remove now, starts new apgroup
    #x next if($sgroup{$id});
    my @sgr=($id);
    for my $jd ( @ids ) { #x @sgid 
      #x next if($id eq $jd or $sgroup{$jd});
      #x my $sim= $sim->{$id}{$jd} || $gsim{$id}{$jd} || 0; # ?? not $gsim{$jd} .. it is always > next sim set
      my $isap= $ispar->{$id}{$jd} || cUNK;
      if($isap == cALT) { push @sgr,$jd; }        
      # if( $ispar->{$id}{$jd}==cPAR ) { $isalt=-1; }
      # elsif($gisalt{$id}{$jd}==1) { $isalt=1; }
      # else { $isalt=1; } #?? if not ispar
    }
    
    my $sgid= "p" . ++$SGID;  push @sgid,$sgid; # $sgidx{$sgid}= $smax;
    my @xid=@sgr; ## for my $sgr (@sgr){ push @xid, @$sgr; } 
    my %xid= map{ $_,1 } @xid;
    #x map{ $sgroup{$_}= $sgid; } @xid; #$gisalt{$_}{$sgid}=1; 
    my $ti=0; for my $xid (@xid) { ++$ti; $sgroup{$xid}= $sgid . "t$ti"; } # add altnum, using new sort order?
    @ids= grep{ not $xid{$_} } @ids;
    
    # for my $id (@ids) { # dont need gisalt??
    #   my $xalt=0; 
    #   for my $xd (@xid) { 
    #     if($gisalt{$id}{$xd}) { $xalt=1; }
    #     else {
    #       if( $ispar->{$id}{$xd} ) { $xalt=-1; last; }
    #       else { $xalt=1; }
    #       }
    #     } 
    #   $gisalt{$id}{$sgid}=$xalt;
    # }

  }
   
  for my $vo (@$gout) {
    my($id,$jd)=@$vo;
    my $etid= $egid; my($idp,$jdp);
    if($id =~ /^ID/){ $idp="EGapid"; }
    else { 
      $idp= $sgroup{$id}||0;  
      my $jdp= $sgroup{$jd}||0; 
      my $sim= $sim->{$id}{$jd};
      my $ispar= $ispar->{$id}{$jd}; #?? is this bad
      # my $isalt= $gisalt{$jd}{$idp}; unless($isalt){ $isalt= ($ispar)?-1:1; }
      my $palt=($ispar==cPAR)?"par_e":($ispar==cALT)?"alt_e":"unk_e";
      $idp= "$etid$idp,$palt,$jdp"; #? dont need ,$sim
      #? add palt to tcalls for print_crosstable : $tcall{"APegr"}{$cref}{$palt}++; $ctype{"EGpar"}{$palt}++;
      # .. now it is same as Cijpar:alt/par_tc, may change
    }
    print join("\t",@$vo,$idp)."\n"; 
  }
}  

sub print_crosstable {
  for my $kc (sort keys %tcall) {
    my @cref= sort keys %{$tcall{$kc}};
    my @ct= sort keys %{$ctype{$kc}};
    print "#t ".join("\t",$kc,@ct)."\n"; # ,@cref
    for my $cr (@cref) {
      # my @cest= sort keys %{$tcall{$kc}{$cr}};
      print "#t ".$cr;
      for my $ce (@ct) { my $v=$tcall{$kc}{$cr}{$ce}; print "\t$v"; } print "\n";
    } print "\n";
  }

}

sub _min { return ($_[1] < $_[0]) ? $_[1] : $_[0]; }
sub _max { return ($_[1] > $_[0]) ? $_[1] : $_[0]; }

sub classxd { 
  my($idmax,$cna,$cnb)=@_; 
  my $cn=$cna; if($cnb>0){ $cn=($idmax < $IDX2CN)? _max($cna,$cnb) : _min($cna,$cnb); }  
  my $cidp=($idmax>=$IDX_ALT)?"alt" : ($idmax<=$IDX_PAR)?"par": ($cn >= 1.50)?"par" : "alt"; 
  return (wantarray)? ($cidp,$cn) : $cidp; 
}
sub classxdv { 
  my($idmax,$cna,$cnb)=@_; 
  # my($IDX_ALT1C,$IDX_PAR2C)= ($IDX_ALT + 0.1, $IDX_PAR - 0.1); # test.. bad??
  my($IDX_ALT1C,$IDX_PAR2C)= ($idmax + 0.05, $idmax - 0.05); # test..
  my $cn=$cna; if($cnb>0){ $cn=($idmax < $IDX2CN)? _max($cna,$cnb) : _min($cna,$cnb); }  
  my ($cidp,$idxc)=($idmax>=$IDX_ALT)?("alt",$idmax) : ($idmax<=$IDX_PAR)?("par",$idmax)
    : ($cn >= 1.50)?("par",$IDX_PAR2C) : ("alt",$IDX_ALT1C); 
  return (wantarray)? ($cidp,$cn,$idxc) : $cidp; 
}


=item runs

genexf/
genexf/arath18tair1cds_SRR10178325_ab_mim.ca9t.genexcopy@
genexf/arath18tair1cds_SRR10178325ab_mim.stdt_genexcopy@
genexf/at18tair_cds-at22vcan2d_chrs.genexcopy
genexf/at18tair_cds_SRR10178325_ab_mim.cc9t.genexcopy@

./apclass_idxdnacn.pl genexf/at18tair_cds-at22vcan2d_chrs.genexcopy at18tmps4d_try6apval3c.rtab 

#apclass Simple_Altpar_classifier: apclass=(idmax>=85)?alt:(idmax<=35)?par:(dnacn>=1.5)?par:alt 
ID      JD      Refpar  Cidpar  Ispar   S_idmax Dnapar  Cijpar  Tcl     Tci,j
AT3G24870t1     AT3G24870t2     alt_r   alt_id  alt_i   96.9    2.0     alt_tc  2.1     2.1,2.1
AT3G24870t1     AT3G24870t3     alt_r   alt_id  par_i   95.3    2.0     alt_tc  2.1     2.1,2.1
AT3G24870t1     AT3G24870t4     alt_r   alt_id  alt_i   96.9    2.0     alt_tc  2.1     2.1,2.1
AT3G24870t1     AT3G24880t2     par_r   par_id  par_i   28.2    2.0     par_tc  2.1     2.1,2.1
...
AT5G10695t1     AT5G10695t2     alt_r   alt_id  alt_i   100     0.3     alt_tc  0.3     0.3,1.0
AT5G10695t2     AT5G10695t1     alt_r   alt_id  alt_i   100     0.3     alt_tc  0.3     1.0,0.3

only Cijpar changes w/ genexcopy 
genexf/at18tair_cds-at22vcan2d_chrs.genexcopy
#t B_par        alt_ta  par_ta  unk_ta
#t alt_r        2462    168     1838
#t par_r        508     680     22

#t S_par        alt_sn  par_sn
#t alt_r        4396    72
#t par_r        198     1012

#t Cidpar       alt_id  par_id   * best of all, using same Dnapar for all ID,JD
#t alt_r        4396    72
#t par_r        102     1108

#t Cijpar       alt_tc  par_tc  for chrs.genexcopy
#t alt_r        4404    64
#t par_r        166     1044

genexf/at18tair_cds_SRR10178325_ab_mim.cc9t.genexcopy  ?? excess false-par why? alt-dup rdmap?
#t Cijpar       alt_tc  par_tc
#t alt_r        4420    48
#t par_r        232     978

genexf/arath18tair1cds_SRR10178325_ab_mim.ca9t.genexcopy  Cijpar best
#t Cijpar       alt_tc  par_tc
#t alt_r        4406    62
#t par_r        146     1064

genexf/arath18tair1cds_SRR10178325ab_mim.stdt_genexcopy  Cijpar 2nd best
#t Cijpar       alt_tc  par_tc
#t alt_r        4406    62
#t par_r        144     1066

........
* for IDX2CN=85, ie max(cni,cnj) instead of min(cni,cnj) for hi idmax
#t Cijpar       alt_tc  par_tc * using IDX2CN=85, ie max(cni,cnj) for chrs.genexcopy
#t alt_r        4398    70
#t par_r        104     1106

#t Cijpar       alt_tc  par_tc * for IDX2CN=85, max(cni,cnj) for tair_cds_SRR.genexcopy
#t alt_r        4406    62
#t par_r        194     1016

#t Cijpar       alt_tc  par_tc * for IDX2CN=85, max(cni,cnj) for tair1cds_SRR.genexcopy
#t alt_r        4401    67
#t par_r        128     1082


=item human vs arath

human22tt_try6 .. Cijpar beats Cidpar, lower alt_r:par_e vs small par_r:alt_e
  Ispar  Cidpar	Cijpar  Rpart   Ref    Est	 
 25164  25034   25474  25776   alt_r alt_e
  1214   1344     904    602   alt_r par_e
  1450    558     642    756   par_r alt_e
 15556  16448   16364  16250   par_r par_e

at18tmps4d_try6
   Ispar Cidpar Cijpar	Rpart 	Ref	Est  
   4396   4396 	4406	4428	alt_r	alt_e
     72     72 	  62	40	alt_r	par_e
    198    102 	 146	120	par_r	alt_e
   1012   1108 	1064	1090	par_r	par_e

./apclass_idxdnacn.pl genexf/human22ttref_mrna-human22ttot_chr.genexcopy human22tt_try6apval3c.rtab | tail -20
#t Cidpar       alt_id  par_id
#t alt_r        25034   1344
#t par_r        558     16448

#t Cijpar       alt_tc  par_tc  for IDX2CN=55, alt_r:par_tc worse for IDX2CN=85
#t alt_r        25376   1002     alt_r:e, par_r:e == 904, 642 for IDX2CN=35, ie min(cni,cnj)
#t par_r        582     16424

#t S_par        alt_sn  par_sn
#t alt_r        25164   1214
#t par_r        1450    15556


=item rtab

ID	JD	Refpar	Dnapar	Ispar	par_score	Naln	Nsnp	S_par	S_idmax	S_var	S_ident	d3Codon	S_peak	S_iCBI S_MMF	B_par	B_ident	C_par	C_cid

class:
Refpar:3  Ispar:5==S_par:9 B_par:17 C_par:19 Cijpar:21
@Icall= (2,8,16,18,20)

=item test

# tweak ctcl: if(idmax < 55) tcl=max(tci,tcj) else tcl=min(tci,tcj)
perl -ne 'BEGIN{ print "#apclass Simple_Altpar_classifier: apclass=(idmax>=85)?par:(idmax<=35)?alt:(dnapar>=1.5)?par:alt \n"; } 
if(/^\W/){ print if(/iname=/); next; } @v=split"\t"; if(@v<11){ ($id,$cw,$tcopy,$ucla)=@v[0,1,4,6]; 
$id=~s/hs22ttref:/Hs_/; $tcopy{$id}=$tcopy; $clen{$id}=$cw; next; }
($id,$jd,$refp,$dnacn,$isp,$idmax,$cp)=@nv=@v[0,1,2,3,4,9,18]; 
if(/^ID/){ $nv[6]= $cp="Cid_par"; ($ctcl,$tcl,$tci,$tcj)=qw(Cijpar Tcl Tci Tcj); }
else { $tci=$tcopy{$id}||0; $tcj=$tcopy{$jd}||0; $tcl=($tci>$tcj)?$tcj:$tci; $cidp=classxd($idmax,$dnacn); $ctcl=classxd($idmax,$tcl||$dnacn);  
$nv[6]= $cp=$cidp."_id"; } if(1){ $nd=$nv[3]; $nv[3]=$nv[6]; $nv[6]=$nd; }
 print join("\t",@nv,$ctcl."_tc",$tcl,"$tci,$tcj")."\n"; 
 sub classxd{ my($idmax,$dnacn)=@_; my $cidp=($idmax>=85)?"alt" : ($idmax<=35)?"par": ($dnacn >= 1.50)?"par" : "alt"; $cidp; }' \
   human22ttref_mrna-human22ttot_chr.genexcopy human22tt_try6apval3c.rtab \
   > human22tt_ap3class4d.rtab

=cut
