#!/usr/bin/env perl
# nktpar.pl / newicktreeparse.pl

=item about 

  read newick tree, calc branch lengths (root>node, node<leaf), 
  print common_branch distance for 2 leaves (eg genes) for dist/sim matrix
  
  usage: muscle -in geneseq.fa > geneseq.msa; muscle -in  geneseq.msa -maketree > malign.newick for sequence tree 
         nktpar.pl malign.newick > malign.dist/sim
  .. for muscle v3, not v5 which drops -maketree :(
  
  evigene/scripts/omcl/newickparse.pl
  
  2020Nov, D. Gilbert
  
=cut

use strict;
use constant VERSION =>  '2022.11.20'; 

my $debug= $ENV{debug}||0;
my $iname= $ARGV[0]||"stdin";
my $otype= $ENV{otype}||0;
if($otype) { $otype=($otype =~ /^s/i)?'sim':($otype=~/^d/i)?'dist':($otype=~/^e/i)?'eqgene':'dist'; }
else {
  $otype= $ENV{sim}?'sim':'dist'; # distance or sim matrix output
  $otype='eqgene' if($ENV{eqgene});
}
my $MINALT=$ENV{pminalt}||99.0; # eqgene
my $nparalog=$ENV{nparalog}||0; # genexcopy.tcopy == nparalog; from tr2dupgeneclass1a.pl
my $MIN_MINALT=$ENV{pminminalt}|| 97.0; # force paralog at lower idents, dunno what default, 95..98 
# optname: pminminalt >> pmustparalog? parmust? mustpar? palt_lowbound?
$MIN_MINALT= _min($MIN_MINALT, $MINALT - 0.1); #?? not -2
#  my $cmd="env prt=1 nparalog=$npar otype=eg $EVIGENES/omcl/newickparse.pl $otre > $oegtab";

my $doprt= $ENV{prt}||0;
my $doprtdist=$ENV{prtdist}||0;
my $obranch= $ENV{cpath}||0;
my $halfmat=$ENV{halfmat}||0;

print "#iname=$iname\n" if($debug or $doprt);
my $t=""; my %an=(); my @com;
while(<>){ 
  if(/^\w/){ my($id,$an)=split" ",$_,2;
    if($an){ my($di)= $an=~ s/(:[\de\.\-]+)\s*$//?" $1":""; $an{$id}=$an; $_="$id$di\n"; } 
  } elsif(s/(#.*)$//){ push @com,$1; } 
  s/\s*\n/ /; $t.=$_; 
  # one newick tree ends at ');' .. stop here? or nkpar2c(@t)
} 
#print "#tin= $t\n\n" if($ENV{prt});

my @t=split/([\(\)\,])/,$t; 
for my $i (0..$#t) { 
  if($t[$i] =~ /^\)/){ if($t[$i+1] =~ /:([\de\.\-]+)/) { $t[$i].=$t[$i+1]; $t[$i+1]=undef; } }
}
print "#itree=",join("",@t),"\n\n" if($doprt);

# nktp1b(@t) if($ENV{pr1});

my($rootc,$idn,$lidn,$tmore)= nkpar2c(@t); #ret( $root, \%idn, \@lidn, \@tmore)
my @ids= sort keys %$idn; my $nid=@ids;

if($ENV{prd1}) {
#...  old dist1 ....................
print "#... tree ...\n";
trepr($rootc, 1);

print "#... dist1 : idist_walk ...\n";
print join("\t","ID",@ids)."\n";
for my $id (@ids) {
  my $idnode= $idn->{$id};
  my($ndid, $dist)= idist($id,$idnode,\@ids,$idn); 
  print "$id";
  for my $jd (@ids) {
    printf "  %.6f", $dist->{$id}{$jd}||0;
  }
  print "  $ndid\n";
}

#...  old dist1 ....................
}

print "#... tree dist2 sum ...\n" if $debug;
# my($dsum,$nbr,$lidp)=
tre_distsum($rootc);
for my $id (@ids) { tre_nodelen($idn->{$id}, $lidn); }

# print "#itree=",join("",@t),"\n\n" if($doprt);
if($doprtdist){
  print "#otreedist=\n";
  trepr_distsum($rootc);
}

print "#... dist2 : common_branch ...\n" if $debug;
my (%cbdist,%cbval); my $maxdif=0;
for my $id (@ids) {
  my $idnode= $idn->{$id};
  my @cp;
  for my $jd (@ids) {
    my $jdnode= $idn->{$jd};
    my($clid,$cndif,$clidp)= common_branch($idnode, $jdnode, $lidn);
    $cbdist{$id}{$jd}{dist}=$cndif; $cbdist{$id}{$jd}{clid}=$clid; $cbdist{$id}{$jd}{clidp}=$clidp;
    $cbval{$clid}=$cndif;
    $maxdif= _max($cndif,$maxdif);
  }
}

my $MAXD=1; if($otype eq 'sim' and $maxdif > 1){ $MAXD=$maxdif; } #what?
my $dopreqgene= ($otype eq 'eqgene')?1:0;
my $doprmat=1 unless($dopreqgene);

if(1) {
  # try to find par-alt cut point by inspection of cbval dists?
  #use this test?  my $ispar=($pident <= $MINALT)?1:0; or cbval > 1 - MINALT/100
  my $dMINALT= 1.0 - $MINALT/100; # default == 99/100
  # my $dMIN_MINALT= 1.0 - $MIN_MINALT/100;
  my @cbalt= sort { $cbval{$b} <=> $cbval{$a} or $a <=> $b } grep { $_ ne "0" } keys %cbval; # order by largest commbr dist
  my ($np,$cbi,$cbcut,$dcut)=(0,0,0,0); 
  for(my $i=0; $i<@cbalt; $i++){ my $cb=$cbalt[$i]; if($cbval{$cb} < $dMINALT) { $cbi=$i; $cbcut=$cb; $dcut=$cbval{$cb};  last; } else { $np++; } }
  my($simcut)= map{ sprintf"%.2f%%", 100*($MAXD - $_) } ($dcut);
  print "#tree_common_branch_altpar_cut: $np:$simcut:$cbcut (n:simcut:combr), for options pminalt=$MINALT, nparalog=$nparalog \n";
  if($nparalog) {
    $nparalog= sprintf"%.0f",$nparalog; # round off .dec
  } elsif($debug or $np>0) { #  and $np>0
    $nparalog=1 + $np; # if $debug ? need 1+np to match below splice(npar-1)
  }
}

=item FIXME altpar_cut find
  .. now have too few paralogs, due to low pident of pubid groups, below genex pident cut, 
  .. need some MIN_MINALT, below MINALT, to force paralog call
  eg. AT4G16880t1 <95%> AT4G16940t2 <98%> AT4G16960t1

#iname=tmps/EVGm000040.mutree
#itree=( AT4G16880t1 :0.0518977 , ( AT4G16940t2 :0.020076 , AT4G16960t1 :0.020076 ):0.0318217 ) ; 
#tree_common_branch_altpar_cut: 2:100.00%:2 (n:simcut:combr), for options pminalt=99, nparalog=1.7 
#tree_common_branch_paralogs: par=1:94.81%:1 alt=1:97.99%:3 (n:simcut:combr), for option nparalog=2 
#tree_common_branch_matrix: eqgene, nleaf=3
PublicID        OID     AltIDs  Locus   Mapqual ParalogIDs
AT4G16880t1     AT4G16880t1     0       0       0       AT4G16940t2/94.8,AT4G16960t1/94.8
AT4G16940t2     AT4G16940t2     AT4G16960t1/98.0        0       0       AT4G16880t1/94.8
AT4G16960t1     AT4G16960t1     AT4G16940t2/98.0        0       0       AT4G16880t1/94.8

  
=item test altpar_cut find

default  #tree_common_branch_altpar_cut: 0:99.67%:1 (n:simcut:combr), for options pminalt=99, nparalog=0 
pmincut  #tree_common_branch_altpar_cut: 1:99.84%:7 (n:simcut:combr), for options pminalt=99.70, nparalog=0 
         #tree_common_branch_paralogs: par=1:99.67%:1 alt=2:99.84%:7,9 (n:simcut:combr), for option nparalog=2 

env prt=1 pminalt=99.70  nparalog=0 otype=sim prtdist=0 cpath=0 debug=1 $evigene/scripts/omcl/newickparse.pl mustreat/NonamEVm000088t.mustree
#iname=mustreat/NonamEVm000088t.mustree
#itree=( ( ( AT3G24880t1 , AT3G24880t2 ):0 , AT3G24880t3 ):0.00332885 , 
#  ( AT3G24870t1 , ( AT3G24870t3 , ( AT3G24870t2 , AT3G24870t4 ):0.000475191 ):0.00116102 ):0.00169264 ) ; 

#nkpar2
#... tree dist2 sum ...
#... dist2 : common_branch ...
#tree_common_branch_altpar_cut: 1:99.84%:7 (n:simcut:combr), for options pminalt=99.70, nparalog=0 
#tree_common_branch_paralogs: par=1:99.67%:1 alt=2:99.84%:7,9 (n:simcut:combr), for option nparalog=2 
#tree_common_branch_matrix: sim, nleaf=7
ID	AT3G24870t1	AT3G24870t2	AT3G24870t3	AT3G24870t4	AT3G24880t1	AT3G24880t2	AT3G24880t3
AT3G24870t1	100.00	99.84	99.84	99.84	99.67,Par	99.67,Par	99.67,Par
AT3G24870t2	99.84	100.00	99.95	100.00	99.67,Par	99.67,Par	99.67,Par
AT3G24870t3	99.84	99.95	100.00	99.95	99.67,Par	99.67,Par	99.67,Par
AT3G24870t4	99.84	100.00	99.95	100.00	99.67,Par	99.67,Par	99.67,Par
AT3G24880t1	99.67,Par	99.67,Par	99.67,Par	99.67,Par	100.00	100.00	100.00
AT3G24880t2	99.67,Par	99.67,Par	99.67,Par	99.67,Par	100.00	100.00	100.00
AT3G24880t3	99.67,Par	99.67,Par	99.67,Par	99.67,Par	100.00	100.00	100.00
#............

=cut


# nparalog == 1 means no paralogs, nparalog == 0 means no info
my(%cbalt,%cbpar);
if($nparalog>=1) { # or xxx, find common branches for nparalog
  my @cbalt= sort { $cbval{$b} <=> $cbval{$a} or $a <=> $b } grep { $_ ne "0" } keys %cbval; # order by largest commbr dist
  
  if(1) { # FIXME: MIN_MINALT lower pident bound for alt cutoff, ie below MIN_MINALT/above dMINMIN is always paralog..
  my $dMIN_MINALT= 1.0 - $MIN_MINALT/100;
  my ($np,$cbi,$cbcut,$dcut)=(0,0,0,0); 
  for(my $i=0; $i<@cbalt; $i++){ my $cb=$cbalt[$i]; if($cbval{$cb} < $dMIN_MINALT) { $cbi=$i; $cbcut=$cb; $dcut=$cbval{$cb};  last; } else { $np++; } }
  if($np+1 > $nparalog) {
    my($simcut)= map{ sprintf"%.2f%%", 100*($MAXD - $_) } ($dcut); my $np1=1+$np;
    print "#tree_altpar_mustcut: new npar=$np1, $np:$simcut:$cbcut (n:simcut:combr), for options pminminalt=$MIN_MINALT (lowest alt ident), nparalog=$nparalog \n";
    $nparalog= $np1;  
    }
  }
  
  my @cbpar= splice(@cbalt,0,$nparalog-1);
  %cbpar= map{ $_ => $cbval{$_} } @cbpar;
  %cbalt= map{ $_ => $cbval{$_} } @cbalt;
  # my $nalt=scalar (grep { $cbval{$_} > 0 } @cbalt); 
  # my $npar=scalar (grep { $cbval{$_} > 0 } @cbpar); 
  my $na=@cbalt; my $np=@cbpar;
  my $cbparlo= ($np<1)?0:$cbval{$cbpar[-1]}; 
  my $cbalthi= ($na<1)?0:$cbval{$cbalt[0]};
  ($cbparlo,$cbalthi)= map{ sprintf"%.2f%%", 100*($MAXD - $_) } ($cbparlo,$cbalthi);
  my @cbaltv= grep { $cbval{$_} > 0 } @cbalt; my $nalt= @cbaltv; my $cbaltv=join",",@cbaltv; 
  my @cbparv= grep { $cbval{$_} > 0 } @cbpar; my $npar= @cbparv; my $cbparv=join",",@cbparv; 
  # maybe flag cbpar nodes with par=1 ? add cbpar to trepr_distsum() ?
  print "#tree_common_branch_paralogs: par=$npar:$cbparlo:$cbparv alt=$nalt:$cbalthi:$cbaltv (n:simcut:combr), for option nparalog=$nparalog \n";
}

if($doprmat) {
print "#tree_common_branch_matrix: $otype, nleaf=$nid\n";
print join("\t","ID",@ids)."\n";
for my $id (@ids) {
  print $id;
  for my $jd (@ids) {
    my($clid,$cndif,$clidp)= map{ $cbdist{$id}{$jd}{$_}||0 } qw( clid dist clidp);
    my $odif= ($otype eq 'sim')? sprintf"%.2f", 100*($MAXD - $cndif) : sprintf"%.4g", $cndif;
    $odif.=",Par" if($cbpar{$clid}); #?
    $odif.=",${clid}b" if($obranch);
    print "\t$odif";
    last if($halfmat and $jd eq $id);
  }
  print "\n";
  }
}

if($dopreqgene) {

# overids == alts, altnotover == pars, need sim cutoff option
#   	my($mid,$oid,$overids,$loc,$mapqual,$altnotover)=@v;
print "#tree_common_branch_matrix: $otype, nleaf=$nid\n";
print "#".join("\t","PublicID","OID","AltIDs","Locus","Mapqual","ParalogIDs")."\n"; # FIXME: check format hdr
for my $id (@ids) {
  my(@alt,@par);
  for my $jd (@ids) {
    next if($jd eq $id);
    my($clid,$cndif,$clidp)= map{ $cbdist{$id}{$jd}{$_}||0 } qw( clid dist clidp);
    my $pident= 100*($MAXD - $cndif);
    my $ispar=($pident <= $MINALT)?1:0;
    if($nparalog){ # nparalog == 1 means no paralogs, nparalog == 0 means no info
      if($cbpar{$clid}) { $ispar++; }
      elsif($cbalt{$clid} and $ispar){ 
        if($pident >= $MIN_MINALT) { $ispar=0; }# ?? check pident vs MIN_MINALT = 95? 90? see above
        } 
    }
    my $pi= sprintf"%.2f", $pident;
    if($ispar) { push @par, "$jd/$pi"; } else { push @alt, "$jd/$pi"; }
  }
  my $oid=$id; #?? or $lid
  my $alts=(@alt<1)?"0":join(",",@alt);
  my $pars=(@par<1)?"0":join(",",@par);
  print join("\t",$id,$oid,$alts,0,0,$pars)."\n";
  }

}

print "#............\n";

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

sub nkpar2c {
  my @t=@_;
  print "#nkpar2\n" if $debug;

  # drop nnd? nds always added to
  my $root={ id=>0, lid=>0, len=>0, lev=>0, grp=>0, it=>0, lnd=>undef, nnd=>undef, nds=>[] };
  my (%idn,@lidn); # @ids;
  my $lnd=$root; @lidn=( $root );
  my ($lev,$grp,$it,$lid,$trestop,$tat)=(0) x 9;
  
  # one newick tree ends at ');' .. stop there.. if more @t, return what?
  foreach (@t) { 
    $tat++; next unless(defined $_);
    s/^\s+//; s/\s+$//;
    my $di= ($_ =~ s/\s*:([\de\.\-]+)$//)?$1:undef;  
    # my $nd={ id=>0, len=>0, lnd=>undef, nnd=>undef, lev=>0, it=>0, nds=>[] };
    # $nd->{lnd}= $lnd;  $nd->{lev}=$lev;  $nd->{grp}=$grp; # $nd->{it}=$it;
    # if(defined $di){  $di="0" if($di eq "-0"); $nd->{len}= $di; }
    
    my $nd= undef;
    if(/^\(/ or /^\w/){ 
      $nd={ id=>0, lid=>0, len=>0, lev=>0, grp=>0, it=>0, lnd=>undef, nnd=>undef, nds=>[] };  #newnode; drop nnd
      $nd->{lid}= ++$lid; $nd->{lnd}= $lnd;  $nd->{lev}=$lev;  $nd->{grp}=$grp; # $nd->{it}=$it;
      $lidn[$lid]=$nd;
      if(defined $di){  $di="0" if($di eq "-0"); $nd->{len}= $di; }
    }
    
    if(/^\(/){ $nd->{lev}= ++$lev; $nd->{grp}= ++$grp; $lnd->{nnd}= $nd; push @{$lnd->{nds}}, $nd;  $lnd=$nd; $it= $lnd->{it}; }
    elsif(/^\)/) { $nd= $lnd || $root; $nd->{grp}= ++$grp; $lnd=$nd->{lnd}; $lev=$lnd->{lev}; $it= $lnd->{it}; 
      if(defined $di){ $nd->{len}+=$di; } 
      if(m/\)\s*;/){ $trestop=$lid; last; }
      }
    elsif(/^,/){ $it= ++$lnd->{it}; } # drop replace w/ @nds count?
    elsif(/^\w/) { 
      my($id,$an)=split" ",$_,2; $nd->{id}=$id; $nd->{it}=$it; 
      $idn{$id}=$nd; #push @ids, $id;
      $lnd->{nnd}=$nd; push @{$lnd->{nds}}, $nd;  
    }
  }
  
  my @tmore = ($trestop > 0 and $tat < @t) ? splice(@t,$tat) : ();
  return ($root, \%idn, \@lidn, \@tmore);
}

use constant { WALKTO_DOWN => 1, WALKTO_UPDOWN => 2, WALKTO_FIRST => 4, } ;
sub idist_walkto {
  my($atnode,$walkdist,$id,$idnode,$dist,$wdid,$noclimb)= @_; # ,$jd,$jnode
  unless(defined($atnode) and not $wdid->{$atnode}){ return 0; }
  $noclimb||=0;
  my $nds= $atnode->{nds};
  my $nnd= $atnode->{nnd};
  my $lnd= $atnode->{lnd};
  my $alen= $atnode->{len} || 0;
  # my $ijlen=$walkdist + $alen; # no??
  my $ijlen=$walkdist ;
  if($noclimb & WALKTO_DOWN){ $ijlen=$walkdist + $alen; } #??
  my $ndid=0; 
  $wdid->{$atnode}++; #??? 
  if(ref $nds) {
    my @notleaf=();
    for my $nd (@$nds) { 
      my $jd= $nd->{id};
      if($jd) {
        my $jlen= $nd->{len} || 0;
        $dist->{$id}{$jd}= $ijlen + $jlen unless($id eq $jd or $wdid->{$jd});
        $wdid->{$jd}++; #??? 
        $ndid++;
      } else {
        # if(my $jlen=$nd->{len}) {  $ijlen+=$jlen; }  #?????  $alen += $jlen;
        push @notleaf,$nd;
      }
    }
    for my $nd (@notleaf) {
      # my $wdd= $walkdist+$alen; #no: $wdd= $walkdist; ??  $wdd=$alen
      my $wdd= $walkdist; # local subnodes here
      # if($noclimb & WALKTO_UPDOWN) { $wdd= $walkdist+$alen; } # this solves some of problem: UPDOWN changes walkdist, and 2nd down*!
      if($noclimb & WALKTO_FIRST) { $noclimb=0; } else { $wdd= $walkdist+$alen; } # this solves some of problem: UPDOWN changes walkdist, and 2nd down*!
      #^^ still bug ( (a,b):2, (c,d):2 ):10 => d(a,c)=14 should be d(a,c)=4
      #no: if($noclimb & WALKTO_FIRST) { $noclimb=0; } elsif($noclimb & WALKTO_UPDOWN) { $wdd= $walkdist+$alen; } # this solves some of problem: UPDOWN changes walkdist, and 2nd down*!
      my($ndidb)= idist_walkto($nd,$wdd,$id,$idnode,$dist,$wdid, $noclimb | WALKTO_DOWN);
      $ndid+= $ndidb;
    }    
  } elsif(ref $nnd){
    my($ndidb)= idist_walkto($nnd,$walkdist+$alen,$id,$idnode,$dist,$wdid, $noclimb | WALKTO_DOWN);
    $ndid+= $ndidb;
  }
  # higher, BUT skip rewalk to atnode
  unless($noclimb & WALKTO_DOWN) {
    my $wdc= $walkdist+$alen; #??: $wdc= $walkdist; $wdc=$alen
    my($ndida)= idist_walkto($lnd,$wdc,$id,$idnode,$dist,$wdid,$noclimb | WALKTO_UPDOWN);
    $ndid+= $ndida;
  }
  return($ndid);
}

sub idist {
  # my ($nd,$idn,$dist)=@_;
  my($id,$idnode,$ids,$idn)= @_;
  return unless(defined $idnode);
  my $nds= $idnode->{nds}; my $nnd= $idnode->{nnd};
  my $lnd= $idnode->{lnd};
  my $ilen= $idnode->{len} || 0;
  my $dist={}; my $wdid={}; 
  # my($ndid)= idist_walkto($idnode, $ilen, $id,$idnode,$dist,$wdid,WALKTO_FIRST); # $atnode,$walkdist,$id,$idnode,$dist,$wdid
  my($ndid)= idist_walkto($lnd, $ilen, $id,$idnode,$dist,$wdid,WALKTO_FIRST); # yes
  # my($ndid)= idist_walkto($lnd, 0, $id,$idnode,$dist,$wdid,WALKTO_FIRST); # no
  return($ndid, $dist);
}

# for $id (@ids) { tre_nodelen($idn->{$id}, $lidn); }
sub tre_nodelen {
  my($thisnd, $lidn)=@_;
  
  my @ndkey= qw( id lid len lev  lnd nds dsum nbr lidp );  
  my($id, $lid, $len, $lev, $lnd, $nds, $dsum, $nbr, $lidp)= 
    map{ my $v=$thisnd->{$_}; $v="0." unless(defined $v); $v; } @ndkey;
  # $nd={ id=>0, lid=>0, len=>0, lev=>0, grp=>0, it=>0, lnd=>undef, nnd=>undef, nds=>[] };  #newnode; drop nnd
  
  my @lidp= reverse split",",$lidp;
  for my $li (@lidp) {
    my $ndl= $lidn->[$li] or next;
    my $ldsum= $ndl->{dsum};
    my $ndif= $dsum - $ldsum;
    if( my $ondif= $ndl->{ndif}) { $ndif=  _max($ondif,$ndif); }
    $ndl->{ndif}= $ndif;
  }
  
}

# sub tre_paralogbr {
#   my($thisnd,$nparalog)=@_;
# 
#   my @ndkey= qw( lid lev  nds dsum nbr lidp ndif);  
#   my( $lid, $lev,  $nds, $dsum, $nbr, $lidp, $ndif)= map{ my $v=$thisnd->{$_}; $v="0." unless(defined $v); $v; } @ndkey;
#   if($ndif > 0) {
#   
#   }
#   if($nds) {
#     for my $nd (@$nds) { my($lid, $lidp, $nbr, $ndif)= tre_paralogbr($nd,$nparalog); }
#   } 
#   # return($lid, $lidp, $nbr, $ndif);
# }

sub common_branch {
  my($nda, $ndb, $lidn)=@_;
  my($clid, $clidp, $cndif, $cnode)= (0) x 3;

  my @ndkey= qw( lid lev ndif lidp );  
  my( $lida, $leva,  $ndifa, $lidpa)= 
    map{ my $v=$nda->{$_}; $v="0." unless(defined $v); $v; } @ndkey;
  my( $lidb, $levb,  $ndifb, $lidpb)= 
    map{ my $v=$ndb->{$_}; $v="0." unless(defined $v); $v; } @ndkey;
  if($lida eq $lidb){ return($lida, $ndifa, $lidpa, $nda); }
  
  my @lidpa=split",",$lidpa; my @lidpb=split",",$lidpb; my $nlid=@lidpa;
  my $i=0; for(; $i<$nlid; $i++) { if($lidpa[$i] ne $lidpb[$i]) { $i-- if($i>0); last; } }
  $clid= $lidpa[$i]; $cnode= $lidn->[$clid]; $cndif=$cnode->{ndif}||0;
  $clidp= join",",@lidpa[0..$i];
  return($clid, $cndif, $clidp, $cnode);
}

sub trepr_distsum {
  my ($nd)=@_;
  my @ndkey= qw( lid lev dsum nbr ndif lidp id );  
  my($np)= trepr_walk(\@ndkey,$nd,1, 0);
  return($np);
}

sub tre_distsum {
  my ($thisnd,$dsum,$nbr,$lidp)=@_;
  my @ndkey= qw( id lid len lev  lnd nds );  
  my($id, $lid, $len, $lev, $lnd, $nds)= map{ my $v=$thisnd->{$_}; $v="0." unless(defined $v); $v; } @ndkey;
  
  $dsum += $len;
  $lidp .= "$lid,";
  $thisnd->{dsum}= $dsum;
  $thisnd->{nbr}= ++$nbr;
  $thisnd->{lidp} = $lidp;

  if(0) #if(1 and $id)
  { 
    print join("\t",$lid, $lev, sprintf("%.6f",$dsum), $nbr, $lidp, $id,)."\n";
    #print join("\t",$lid, $lev, $id, $len, sprintf("%.6f",$dsum), $nbr, $lidp)."\n";
  }
    
  if(1) {#$recurs
    if($nds) {
      for my $nd (@$nds) { my($tsum,$tbr,$tlidp)= tre_distsum($nd,$dsum,$nbr,$lidp); }
    # } elsif($nnd) {
    #   tre_distsum($nnd,$dsum,$nbr,$lidp);
    }
  }
  return ($dsum,$nbr,$lidp);
}

sub trepr {
  my ($nd,$recurs,$ip)=@_;
  my @ndkey= qw( lid grp lev it id len ); 
  my($np)= trepr_walk(\@ndkey,$nd,1,$ip);
  return($np);
}

sub trepr_walk {
  my ($ndkey,$nd,$recurs,$ip)=@_;
  # my @ndkey= qw( lid grp lev it id len ); use constant Iit=>3;
  ##    $nd={ id=>0, lid=>0, len=>0, lev=>0, grp=>0, it=>0, lnd=>undef, nnd=>undef, nds=>[] };  #newnode; drop nnd
  my @nv= map{ my $v=$nd->{$_}; $v="0." unless(defined $v); $v=sprintf("%.5g",$v) if(/^(dsum|ndif)/); $v; } @$ndkey;
  # format: dsum ndif  sprintf("%.6f",$dsum)
  my $nds= $nd->{nds}; my $nnd= $nd->{nnd};
  # my $itn= (ref $nds)? scalar(@$nds) : (ref $nnd)? 1 :0;
  # $nv[Iit].=",$itn"; 
  $ip||=0; unless($ip){ print join("\t","iPr",@$ndkey)."\n"; }
  print join("\t",$ip,@nv)."\n";
  if($recurs) {
    if($nds) {
      for my $nd (@$nds) { trepr_walk($ndkey,$nd,1,++$ip); }
    } elsif($nnd) {
      trepr_walk($ndkey,$nnd,1,++$ip);
    }
  }
  return ($ip);
}  

=item drop nktp1b

sub nktp1b { # no good
  my @t=@_;
  print "#nkpar1b\n";
  
  ($l,$d)=(0,0); $ti=0; 
  foreach (@t){ 
    s/^\s+//; s/\s+$//; 
    $td=$_; $ti++; $NOtd=(m/^\)/)?$t[$ti]:$_;  
    my $di= ($td=~m/:([\de\.\-]+)\s*$/)?$1:undef;  
    if(/^\(/){ $go=$g[$l]; ++$l; $g= ++$g[$l]; if($go>$g){ $g=$g[$l]=$go; } $lg="$g.$l"; } 
    elsif(/^\)/){ if(defined $di){ $i=$i{$lg}||0;  $d{$lg}{$i}=$di; $di=undef; } $l--; $g=$g[$l];  $lg="$g.$l";  } 
    elsif(/^,/){ $i= ++$i{$lg}; } 
    elsif(/^\w/) { ($v,$an)=split" ",$_,2; $i=$i{$lg}||0; $an{$lg}{$i}=$an; $v{$lg}{$i}=$v; } 
    $i=$i{$lg}||0; if(defined $di){ $d{$lg}{$i}=$di; } $lev{$lg}{$i}++; 
  }  
  
  for $l (sort keys %lev){ @i=sort keys %{$lev{$l}}; 
   for $i (@i) { $v=$v{$l}{$i}||"nov"; $d=$d{$l}{$i}; $d="nod" unless(defined $d); 
     print "$l\t$i\t$v\t$d\n"; 
     } 
  } 
  print "#............\n";

}
=cut

=item nktp1b tries

cases/NonamEVm000088t.mustree
( ( ( AT3G24880t1 , AT3G24880t2 ):0 , AT3G24880t3 ):0.00332885 , ( AT3G24870t1 , ( AT3G24870t3 , ( AT3G24870t2 , AT3G24870t4 ):0.000475191 ):0.00116102 ):0.00169264 ) ;

cases/NonamEVm000088t.mustree
	0	nov	nod
.0	0	nov	nod
1.1	0	nov	0.00332885
1.1	1	nov	0.00169264
1.2	0	nov	0
1.2	1	AT3G24880t3	nod
1.3	0	AT3G24880t1	nod
1.3	1	AT3G24880t2	nod
2.2	0	AT3G24870t1	nod
2.2	1	nov	0.00116102
2.3	0	AT3G24870t3	nod
2.3	1	nov	0.000475191
2.4	0	AT3G24870t2	nod
2.4	1	AT3G24870t4	nod


cases/NonamEVm000673t.mustree
( ( AT1G58602t1 , AT1G58602t2 ):0.0556757 , ( ( ( AT1G58807t1 , AT1G59124t2 ):0 , AT1G59124t1 ):0 , AT1G58807t2 ):0.0556757 ) ;

cases/NonamEVm000673t.mustree
	0	nov	nod
.0	0	nov	nod
1.1	0	nov	0.0556757
1.1	1	nov	0.0556757
1.2	0	AT1G58602t1	nod
1.2	1	AT1G58602t2	nod
2.2	0	nov	0
2.2	1	AT1G58807t2	nod
2.3	0	nov	0
2.3	1	AT1G59124t1	nod
2.4	0	AT1G58807t1	nod
2.4	1	AT1G59124t2	nod


 cases/NonamEVm000525t.mustree    
( ( ( AT3G55200t1 , AT3G55200t2 ):0 , AT3G55200t3 ):0.000961524 , AT3G55220t1 :0.000961524 ) ;

cases/NonamEVm000525t.mustree    
	0	nov	nod
.0	0	nov	nod
1.1	0	nov	0.000961524
1.1	1	AT3G55220t1	0.000961524
1.2	0	nov	0
1.2	1	AT3G55200t3	nod
1.3	0	AT3G55200t1	nod
1.3	1	AT3G55200t2	nod

cases/NonamEVm000525t.mustreefull
	0	nov	nod
.0	0	nov	nod
1.1	0	nov	0.000961524
1.1	1	AT3G55220t1	0.000961524
1.2	0	nov	0
1.2	1	AT3G55200t3	-0
1.3	0	AT3G55200t1	-0
1.3	1	AT3G55200t2	-0

 cases/NonamEVm000344t.mustree
( ( ( ( ( AT5G46270t1 , AT5G46270t3 ):0 , AT5G46270t2 ):0 , AT5G46270t4 ):0 , AT5G46270t5 ):0.10105 , ( ( AT5G46520t1 , AT5G46520t2 ):0.0226896 , ( AT5G46510t1 , AT5G46510t2 ):0.0215436 ):0.0783599 ) ;

cases/NonamEVm000344t.mustree
	0	nov	nod
.0	0	nov	nod
1.1	0	nov	0.10105    << 1.*
1.1	1	nov	0.0783599  << 2.3 + 3.3
1.2	0	nov	0
1.2	1	AT5G46270t5	nod
1.3	0	nov	0
1.3	1	AT5G46270t4	nod
1.4	0	nov	0
1.4	1	AT5G46270t2	nod
1.5	0	AT5G46270t1	nod
1.5	1	AT5G46270t3	nod
2.2	0	nov	0.0226896  << 2.3
2.2	1	nov	0.0215436  << 3.3
2.3	0	AT5G46520t1	nod
2.3	1	AT5G46520t2	nod
3.3	0	AT5G46510t1	nod
3.3	1	AT5G46510t2	nod

=cut