#!/usr/bin/perl
# gnodes_chrcov2genecov2b.pl

=item about gnodes_chrcov2genecov2b

  gnodes_chrcov2genecov2b.pl reads chrasm.covtab and  chr-cds.btall/blastn align table, 
    to produce  genes.genexcopy table equivalent to gnodes_sam2genecov (from cds.bam)

  from gnodes_std2genecov.pl, updated to gnodes_sam2genecov22jul.pl algo
  
  current workaround: input genes.genexcopy to get missing gene data: len, nreads, nrdbases, ..
  
=cut

use FindBin;
use lib ("$FindBin::Bin"); # assume evigene/scripts/genes; layout: main, prot/, rnaseq/, ...

use strict;
use Getopt::Long;  

our $GNODES="$FindBin::Bin";  
our $EVIGENES="$GNODES/../";  

my $debug= $ENV{debug}||1;
my $BN=$ENV{binsize}||100; 
my $pMAXDUP= 0.05; #?? need tests
my $RDLEN= $ENV{rdlen}||150; #?? guess, need here
my $MIN_IDENT = 0.40; # UPD7e was 0.65; # lo is best? << keep same as gnodes_sam2covtab.pl, or lower for gene x DNA align deficit
my $MIN_DUPIDENT = 0.98; #UPD7e was 0.98; # was .99/1; hi is best? or 1.0; # == ident equal to 1st/top align, lower if desired

my $CTAG=$ENV{nametag}||$ENV{tag}||"cr2";

my $UCGenePatt='UCG|busco';
my $ContamGenePatt='contam'; #UPD220222, for plants, other?

my ($crclassf,$ingenexf,$chrcdsbtall,$chrcdsblastn,$rdstats,$outtab,$intab,$cdssizes,$cmpgenex)=("") x 9; 
my @intab; # opt to allow many -bam inputs, -bam one.bam two.bam three.bam ... or .sam ;  

my $optok= GetOptions( 
  'covtab|input=s', \@intab, # bam or sam or STDIN ? for samtools view call, add opt many @inbam
  #no: 'stats|readstats|flagstats=s',\$rdstats, 
  'output=s',\$outtab, #? fixme
  'cmpgenex!', \$cmpgenex, 
 
  'crclassf|idclassf=s',\$crclassf, # alt table chr => class for savereadids
  'btall|chrcdsbtall=s', \$chrcdsbtall,
  'blastn|chrcdsblastn=s', \$chrcdsblastn, 'cdssizes=s',\$cdssizes, # only w/ blastn
  'genexcopy=s',\$ingenexf, # alt table chr => class for savereadids
  # 'anntable|annotations=s', \$anntable,
  # 'maxerr=s',\$MINE, #?? reuse for NM:i:(err) filter # replace w/ minident ?
  # 'minident=s',\$MIN_IDENT, #? only used to set MINALN ?
  'maxdup=s', \$pMAXDUP,  #? reuse MIN_DUPIDENT for dup reads/total reads filter |mindupident
  'mindupident=s', \$MIN_DUPIDENT,  # as per sam2covtab; pMAXDUP = 1 - $MIN_DUPIDENT ??
  # 'minrdlen|minreadlen=i',\$MINRDLEN, # add .. not same as MINALN ??
  # 'rdlen|readlen=i',\$RDLEN, # ????;
  # 'UCGeneAnnot=s', \$UCGenePatt, # 
  # 'filterFullAlign!', \$optFullAlignFilter, # -nofilterFull to turn off
  # 'filter1000bases!', \$opt1000filter, # -nofilterFull to turn off
  #'summary|sumtab!', \$dosumtab, 
  'debug!', \$debug, 
  );

if($cmpgenex) {
  #?? genexcopy $ingenexf
  if(@ARGV) { push @intab, grep(/gene.copy/, @ARGV); } # .genexcopy or variants
  cmp_genextab($outtab, @intab);
  exit(0);
}

if(@ARGV) { push @intab, grep(/\.covtab/, @ARGV); }
unless($optok and ($chrcdsbtall or $chrcdsblastn) and @intab) {
  die "usage: gnodes_chrcov2genecov.pl 
    -chrcdsbtall chr_cds.btall  : gnodes annotation chr x cds blastn btall table, for gene loci
    -covtab chr_readset.covtab  : gnodes chrasm_readset.covtab
    -idclass genes.idclass  : gene id table w/ UCG|busco class flag
  ";
  # -output genes_readmap.covtab, genex
  #  -maxdup=$pMAXDUP portion for uniq class, 
}


sub MAINstub { }

my %genextab; # global data of read_genexcopy
=item  read_genexcopy(orig_genes.genexcopy) for missing rdstats ?

my($nucg,$ngenex,$Cucg)=  ($ingenexf)? read_genexcopy($ingenexf) : (0,0);
if($ngenex>0) {
  # fill in %tw??? my $ngene= scalar(keys %tw); # tw now includes not-isUCGene
  $ngene=$ngenex;
  for my $td (keys %genextab) { my $tw= $genextab{$td}->[0]; $tw{$td}= $tw; $stw+=$tw; }
}

=cut

if( $chrcdsblastn and -f $chrcdsblastn and not ($chrcdsbtall and -f $chrcdsbtall)) {
  $chrcdsbtall= makename($chrcdsblastn,"btall");
  my($okb)= blastn2btall($chrcdsblastn,$cdssizes,$chrcdsbtall);
}

my $ochrgenebins= makename($chrcdsbtall,"bintab");
my($ncgbins)= btall2bintab($chrcdsbtall, $ochrgenebins);

for my $chrcovtab (@intab) {
  my $ogenecov= makename($chrcovtab,$CTAG."genecovtab"); # fixme name
  my($ngbins)= chrcov2genecov($ochrgenebins, $chrcovtab, $ogenecov);
  
  # add: gnodes_std2genecov.pl -inIsCovtab $ogenecov -out $ogenexcopy
  my $ogenexcopy= makename($ogenecov,$CTAG."genexcopy");
  my($okg)= std2genecov($ogenecov,$ogenexcopy);
}

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

sub makename { my($basen,$suf)=@_; $basen=~s/.gz//; $basen=~s/\.\w+$//; return "$basen.$suf"; }

=item cmp_genextab
  merge several genexcopy tables of same gene set, diff read sets

  head -22000 genexf/hu*{SRR3189741,SRR12564436,SRR9087597}*cc9p.geneacopy | grep -v '#' | cut -f1,2,5,7,9 | perl -ne \
'if(/^==. \w+.human18nc_cds1t_(\w+)_mim.cc9p.geneacopy/){ $sid=$1; $sid{$sid}++; } 
elsif(/^Gene_ID/){ @hd=split; @hda=splice(@hd,0,2); $hdb=join",",@hd;  } 
elsif(/^\w/) { ($gd,$gw,$tc,$cla,$cnz)=@v=split; $val{$gd}{$sid}="$tc,$cla,$cnz"; $gw{$gd}=$gw; } 
END{ @sid=sort keys %sid; print join("\t",@hda,@sid)."\n"; for $gd (sort keys %val) { 
  $gw=$gw{$gd}; print "$gd\t$gw"; for $sid (@sid){ $val=$val{$gd}{$sid}||"na"; print "\t$val"; } print "\n"; } } ' \
    > srlr_chm13c.genexupd.tab

head srlr_chm13c.genexupd.tab
Gene_ID                 Glen    SRR12564436_lrnano              SRR3189741_srill                 SRR9087597pbhi
human18nc_NM_000014t1   4425    0.9,dups,11.5,11,4119,93.1      1.0,uniq,61.3,61,4390,99.2      0.9,dups,22.3,21,3791,85.7
human18nc_NM_000015t1   873     1.4,dups,16.8,17,873,100.0      1.1,uniq,62.9,64,873,100.0      1.1,uniq,25.5,26,873,100.0
human18nc_NM_000016t1   1266    1.2,uniq,12.9,14,1237,97.7      1.1,uniq,64.6,65,1237,97.7      1.0,uniq,22.0,24,1237,97.7
human18nc_NM_000017t1   1239    0.2,skew,7.2,3,1204,97.2        0.9,uniq,53.0,53,1239,100.0     1.0,uniq,17.8,23,1206,97.3
human18nc_NM_000018t1   1968    0.1,skew,3.1,1,1554,79.0        0.8,uniq,47.8,48,1968,100.0     1.0,uniq,19.7,23,1833,93.1
human18nc_NM_000019t1   1284    1.0,uniq,10.8,12,1284,100.0     0.9,uniq,54.2,55,1284,100.0     1.2,uniq,28.1,29,1156,90.0

=cut

sub cmp_genextab {
  my($outtab, @ingenex)= @_;
  
  my $outh= *STDOUT; 
  if($outtab) {
    rename($outtab,"$outtab.old") if(-s $outtab);
    open($outh, '>', $outtab);
  }
  
  my @IC= map{ $_ - 1 } (1,2,5,7,9); # Gene_ID Glen tCopy Class Cnz
  my($hdb,@hda,%sidx,%sid,%val,%gw, @sid);
  for my $ingx (@ingenex) {
    my($sid)= $ingx =~ (m,([^\/]+)$,) ? $1 : $ingx; $sid=~s/\.\w+$//;
    $sidx{$ingx}= $sid; push @sid, $sid;
  }
  
  # cut out common prefix/suffix in %sidx .. problems possible
  if(1) {
    my $sida= $sid[0]; # shift @sid;
    my($sl,$pi,$si)=(0) x 3; my($spre,$sprex,$ssuf)=("") x 3;
    $sl=length($sida); $pi= $si= -1;
    foreach my $sidb (@sid) { next if($sidb eq $sida);
      my @sa=split"",$sida; my @sb=split"",$sidb;
      my @ra= reverse @sa; my @rb= reverse @sb;
      for(my $i=0; $i<$sl; $i++) { if($sa[$i] ne $sb[$i]){ $pi= ($i<2) ? 0 : ($pi>=0 and $pi < $i)? $pi : $i; last; } }
      for(my $i=0; $i<$sl; $i++) { if($ra[$i] ne $rb[$i]){ $si= ($i<2) ? 0 : ($si>=0 and $si < $i)? $si : $i; last; } }
    }
    if($pi>0) { $spre= substr($sida,0,$pi); } #$sprex="Pr" if($pi>5); 
    if($si>0) { $ssuf= substr($sida,$sl-$si); }
    if(1 or $spre or $ssuf) {
      my @snu=(); my %snu; my $dups=0; my @ingx= @ingenex; # sort keys %sidx;
      for my $ingx (@ingx){ my $s= $sidx{$ingx}; $s=~s/^$spre/$sprex/ if($spre); $s=~s/$ssuf$// if($ssuf); 
         push @snu,$s; ++$snu{$s}; $dups++ if(1 < $snu{$s}); } 
      for my $i (0..$#ingx){ my $ingx=$ingx[$i]; my $sold= $sidx{$ingx}; my $snu=$snu[$i]; 
        # if($dups and $snu{$snu}>1) { $snu.=".$i"; } 
        $snu=sprintf"%02d_%s",1+$i,$snu; # $snu=$i."_".$snu;
        $sidx{$ingx}=$snu; 
      }
    }
  }
  
  for my $ingx (@ingenex) {
    open(IN,$ingx) or next;
    my $sid= $sidx{$ingx}; $sid{$sid}++;
    while(<IN>) {
      if(/^\W/){ next; }
      my @v= (split)[@IC];
      if(/^Gene_ID/){ my @hd=@v; @hda=splice(@hd,0,2); $hdb=join",",@hd;  } 
      elsif(/^\w/) { my($gd,$gw,$tc,$cla,$cnz)=@v; $val{$gd}{$sid}="$cla,$tc,$cnz"; $gw{$gd}=$gw; } 
    } close(IN);
  }
  
  my(%clas,%clan);
  my @sid=sort keys %sid; # use @ingenex input order?
  print $outh "# gnodes_genexcopy_compare: column tuple = class,tCopy,avCov,mdCov,gLen,pCovspan\n";
  for my $ingx (@ingenex){ my $sid= $sidx{$ingx}; print $outh "#col $sid=$ingx\n"; }
  print $outh join("\t",@hda,@sid,'Gclass')."\n"; 
  for my $gd (sort keys %val) { 
    my $gw=$gw{$gd}; 
    print $outh "$gd\t$gw"; 
    # add end of each gene row: eq/ne ? pairwise col A-B eq/ne ?
    my @scla=();
    for my $si (0..$#sid){ 
      my $sid=$sid[$si];
      my $val=$val{$gd}{$sid}||"na"; 
      print $outh "\t$val"; 
      
      my ($cla)= $val=~m/^(\w+)/; $clan{$cla}++;
      $clas{$sid}{$cla}{n}++;
      push @scla,$cla; 
#       for(my $j=0; $j<$si; $j++) { 
#         my $jid=$sid[$j]; my $jc=$scla[$j];
#         my $eq= ($jc eq $cla)?'eq':'ne';
#         $clas{$sid}{$cla}{$eq}{$jid}++;
#       }
    } 
    
    # print $outh "\n";
    #? add eq/ne stat here, ie gene class is stable/unstable
    my %scla=(); map{ $scla{$_}++ } @scla; my $nscla=0;
    my $sscla=join",", map{ $nscla++; "$_:$scla{$_}" } sort{ $scla{$b}<=>$scla{$a} } keys %scla;
    my $geq=($nscla>1)?"ne":"eq"; print $outh "\tgcla.$geq=$sscla;\n"; 

    for my $si (0..$#sid) { 
      my $sid= $sid[$si];
      my $cla= $scla[$si]; 
      for(my $j=0; $j<=$#sid; $j++) { 
        my $jid=$sid[$j]; my $jc=$scla[$j];
        my $eq= ($jc eq $cla)?'eq':'ne';
        $clas{$sid}{$cla}{$eq}{$jid}++;
      }
    } 

  }  
  
  print $outh "# class comparison\n";
  my @clan=sort{ $clan{$b}<=>$clan{$a} } keys %clan;
  for my $si (0..$#sid) {
    my $sid=$sid[$si];
    # print $outh "# $sid: ";
    for my $cla (@clan) {
      my $n= $clas{$sid}{$cla}{n}||0;
      print $outh "# $sid $cla:$n ";
      for(my $j=0; $j<=$#sid; $j++) { 
        my $jid=$sid[$j];
        my $eq= $clas{$sid}{$cla}{'eq'}{$jid}||0;
        my $ne= $clas{$sid}{$cla}{'ne'}{$jid}||0;
        my $peq= ($n<1)?0:sprintf"%.0f",100*$eq/$n;
        print $outh "\t$jid eq/ne $peq,$eq/$ne";
      }
      print "\n";
    }
  
  }
}

# blastn2btall($blastn,$obtall);
# env ndupout=9999999 $evigene/scripts/makeblastscore3.pl  -pMINLOW 0.50 -tandupok -spans=2  \
# -size ../arath18tair1cds.fa.qual -out at22vcan2d_chrs-arath18tair1cds.nubtall at22vcan2d_chrs-arath18tair1cds.i90blastn
sub blastn2btall {
  my($blastn,$cdssizes,$obtall)= @_;
  
  # my $cdssizes="FIXME.fa.qual"; # required ??
  $ENV{ndupout}=9999999;  # or upd22sep opt: -ndupout=9999999
  my @cmd= ("$GNODES/../makeblastscore3.pl", "-pMINLOW=0.50", "-tandupok", "-spans=2",
          "-size", $cdssizes, "-out", $obtall, $blastn);
  warn "#run: ",join(" ",@cmd),"\n" if $debug;
  my $err= system(@cmd);
  if($err) { warn "ERR: ",join(" ",@cmd),"\n"; }
  return($obtall,$err);
}

# $evigene/scripts/genoasm/gnodes_std2genecov.pl -debug -inIsCovtab  -idclass arath18tair1cds.idclass \
#   -out at18cds_$pt.cl9n.genebcopy -input chrcovf/at22vcan2d_chrs_ERR8666067_ab_mim.cl9n.genecovtab
sub std2genecov {
  my($ingenecov,$ogenexcopy)= @_;
  
  my @cmd= ("$GNODES/gnodes_std2genecov.pl", "-inIsCovtab", 
           "-out", $ogenexcopy, "-input", $ingenecov);
  push @cmd, "-idclass", $crclassf if($crclassf);
  push @cmd, "-debug" if $debug;
  warn "#run: ",join(" ",@cmd),"\n" if $debug;
  my $err= system(@cmd);
  if($err) { warn "ERR: ",join(" ",@cmd),"\n"; }
  return($ogenexcopy,$err);
}

sub btall2bintab {
  my($inbtall, $ochrgenebins)=@_;
  
  sub binx{ 
    my($xbe)=@_; my($xb,$xe)=split"-",$xbe; my($bb,$be)= map{ int($_/100) } ($xb,$xe); 
    my @bx; for(my $ib=$bb; $ib<=$be; $ib++) { push @bx, 100*(1+$ib); } 
    my $db= $bx[0] - $xb; my $de= $bx[-1] - $xe;  return($db,$de,@bx);
  }  
  
  warn "#btall2bintab($inbtall, $ochrgenebins)\n" if $debug;
  if(-s $ochrgenebins) { warn "#reusing: $ochrgenebins\n"; return 1; }
  
  my($ok,$inh,$fn)= openRead($inbtall);
  open(OUT, ">$ochrgenebins");
  print OUT '#'.join("\t",qw(ChrID ChrBin CBlen GeneID GeneBin GBlen ChrOr GeneRank))."\n";
  # ($lcr,$cb,$clen,$gid,$gb,$glen,$cor,$grank)

  my($nout,$lcr,$lgid,$nmiss)=(0) x 9;
  while(<$inh>) {
    next if(/^\W/); my @v=split; 
    my($gid,$cr,$bs,$ida,$al,$gw,$cw,$gsp,$csp,$gdup,$cdup)=@v;
    map{ $_="" if($_ eq "0d"); } ($gdup,$cdup); 
    my $grank=$ida; if($gid eq $lgid) { $grank--; } 
    my($gspa,$gdupa)= map{ (s,^(.+)/,,)?$1:0; } ($gsp,$gdup); 
    my($cor,$cdor)  = map{ (s/:(.)$//)?$1:0; } ($csp,$cdup); 
    my @gx= grep/^\d/, split",", "$gsp,$gdup"; 
    my @cx= grep/^\d/, split",", "$csp,$cdup";
    my $nx=@cx; $lcr=$cr;  $lgid=$gid;
    # if($nx != @gx) { } # problem, do what?
    for(my $i=0; $i<$nx; $i++) { 
      my $gx=$gx[$i]; my $cx=$cx[$i]; 
      unless($gx and $cx) { $nmiss++; next; } # #? stop/skip; still have cases of missing gx 
      if($cx=~s/^(\w+)://) { $lcr=$1; $cor=$cdor; $grank--; } 
      my $rev=($cor eq "-")?1:0;
      my ($gbb,$gbe,@gb)= binx($gx); 
      my ($cbb,$cbe,@cb)= binx($cx); my $nb1= @cb - 1;
      for(my $j=0; $j<=$nb1; $j++) { 
        my $gb=$gb[$j]||0; my $cb= ($rev)? $cb[$nb1 - $j] : $cb[$j];  
        my($glen,$clen)=(100,100);
        if($j==0) { $glen=$gbb; $clen=($rev)?$cbe:$cbb; } 
        elsif($j==$nb1) { $glen=$gbe; $clen=($rev)?$cbb:$cbe; }
        print OUT join("\t",$lcr,$cb,$clen,$gid,$gb,$glen,$cor,$grank)."\n"; $nout++;
        } 
      }
    } 
  close($inh); close(OUT);
  warn "#btall2bintab nout=$nout, missgx=$nmiss to $ochrgenebins\n" if $debug;
  return($nout,$ochrgenebins);    
}

sub chrcov2genecov {
  my($chrgenebins, $chrcovtab, $ogenecov)= @_;
  
  # my $GIDP=$ENV{gidp}||"AT.G|[NX]M_|EVm|t1"; #?? dont need now
  # my $DOMAX=$ENV{domax}||0; # no
  use constant DOMAX => 0;
  
  warn "#chrcov2genecov($chrgenebins, $chrcovtab, $ogenecov)\n" if $debug;
  if(-s $ogenecov) { warn "#reusing: $ogenecov\n"; return 1; }

  my($ncg,$nout,%can,%gan)= (0,0);
  my($ok,$inh,$fn)= openRead($chrgenebins);
  
  while(<$inh>) {
    if(/^\W/){ next; } 
    my($cr,$cb,@av)= split; 
    my($cap,$gid,$gb,$gap,$cor,$grank)=@av; 
    push @{ $can{$cr}{$cb} }, [$gid,$gb,$cap,$grank,$cor]; 
    $gan{$gid}{$gb}=[0,0,0,0]; $ncg++;
  } close($inh);

  my @covcom=();
  ($ok,$inh,$fn)= openRead($chrcovtab);
  while(<$inh>) { 
    if(/^\W/){ push @covcom, $_ if(/^#/); next; } 
    my($cr,$cb,@av)= split;  
    my($cCDS,$cTE,$cUNK)= splice(@av,0,3); 
    my($act,$acm,$acu,$acp)=@av;
    if(my $cana=$can{$cr}{$cb}) { 
      for my $canb (@$cana) { 
        my($gid,$gb,$cap,$grank,$cor)=@$canb; 
        $cap /= 100; 
        if(DOMAX) {
          if($gan{$gid}{$gb}->[4] < $grank) { $gan{$gid}{$gb}->[4]= $grank; 
            for my $i (0,1,2,3){ my $av= $cap * $av[$i]; $gan{$gid}{$gb}->[$i]= $av; } 
          }
        } else {
          for my $i (0,1,2,3){ my $av= $cap * $av[$i]; $gan{$gid}{$gb}->[$i] += $av; } 
        }
      }
    }
  } close($inh); 

  # FIXME here, copy chrcovtab readstat # comments to ogenecov
  open(OUT, ">$ogenecov");
  my @covhdr=qw(ChrID	Pos	CovT CovM CovU aCovT aCovM	aCovU	aCovP);# gnodes covtab header
  print OUT '#'.join("\t",@covhdr)."\n"; 
  my @ctu=(0) x 3;
  for my $gid (sort keys %gan) {
    for my $gb (sort{$a <=> $b} keys %{$gan{$gid}}) { 
      # my @tmup= @{$gan{$gid}{$gb}};
      my @tmup= map{ sprintf"%.0f",$_ }  @{$gan{$gid}{$gb}};
      print OUT join("\t",$gid,$gb,@ctu,@tmup)."\n"; $nout++;
    }
  } 
  if(@covcom) { print OUT "# comments from $chrcovtab\n"; print OUT @covcom; } 
  close(OUT);
  return($nout,$ogenecov);    
}

# ($nucg,$ngene,$cmd)=  read_genexcopy($genexcopyf);
sub read_genexcopy {
  my($genexcopy)=@_;
  my($nucg,$ngene,$cmd,$cav,$cerr)= (0) x 9;
  my($ok,$inh)= openRead($genexcopy); 
  unless($ok) { warn "# Fail to read $genexcopy\n"; return (0,0); }
  # my %genextab; # change to global
  while(<$inh>) {
    if(/^\W/){
      # Uniq Gene Cov Depth n=954, .. C.Map/W=38.4, 38.0 +/-1.26 (mdn,ave,sem) 
      if(/Uniq Gene Cov Depth n=(\d+)/ and not $cmd ) {  
        $nucg=$1;
        if( m/C.Map.W=([\d\.]+), ([\d\.]+)\W+([\d\.]+)/ ) { ($cmd,$cav,$cerr)= ($1,$2,$3);}
        elsif( m/C.Map.W=([\d\.]+)/) { $cmd=$1; }      
      }
    } else { # per gene
      # (Gene_ID Glen Nread Rdlen tCopy C.M Uniq Merr C.nz S.Dup,Unq,Nt,Equ,UCG);
      # my($gid,$glen,$nrd,$rdlen,$tcopy,$cm,$cla,$merr,$cnz,$sdune)= @v;
      my($gid,@gv)= split;
      unless($gid eq 'Gene_ID'){ $genextab{$gid}= \@gv; $ngene++; }
    }
  } close($inh);
  
  warn "# in.genexcopy nucg=$nucg, ngene=$ngene Cmap=$cmd of $genexcopy\n" if($debug);
  return($nucg,$ngene,$cmd); #? ,$cav,$cerr
}

sub openRead {
  my($fn)=@_; my($ok,$inh)=(0); 
  return(0,undef,$fn) unless($fn and -f $fn);
  if($fn =~ /\.gz/) { $ok= open($inh,"gunzip -c $fn |"); } else { $ok= open($inh,$fn); }
  return($ok,$inh,$fn);
}

__END__

