[Bio] / FigKernelPackages / gjonewicklib.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/gjonewicklib.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.15, Sun Sep 6 22:38:32 2009 UTC revision 1.16, Tue Sep 8 01:59:24 2009 UTC
# Line 1710  Line 1710 
1710      my $nd = newick_n_desc( $node );      my $nd = newick_n_desc( $node );
1711      if ( $nd <  1 ) { return $node }       #  Do nothing to a tip      if ( $nd <  1 ) { return $node }       #  Do nothing to a tip
1712    
     #  Reorder this subtree:  
   
1713      my $dl_ref = newick_desc_ref( $node );      my $dl_ref = newick_desc_ref( $node );
1714      if    ( $dir < 0 ) {                   #  Big group first  
1715          @$dl_ref = sort { $cntref->{$b} <=> $cntref->{$a} } @$dl_ref;      #  Reorder this subtree (biggest subtrees to outside)
1716    
1717        if ( $dir )
1718        {
1719            #  Big group first
1720            my @dl = sort { $cntref->{$b} <=> $cntref->{$a} } @$dl_ref;
1721    
1722            my ( @dl1, @dl2 );
1723            for ( my $i = 0; $i < $nd; $i++ ) {
1724                if ( $i & 1 ) { push @dl2, $dl[$i] } else { push @dl1, $dl[$i] }
1725      }      }
1726      elsif ( $dir > 0 ) {                   #  Small group first  
1727          @$dl_ref = sort { $cntref->{$a} <=> $cntref->{$b} } @$dl_ref;          @$dl_ref = ( $dir < 0 ) ? ( @dl1, reverse @dl2 )
1728                                    : ( @dl2, reverse @dl1 );
1729      }      }
1730    
1731      #  Reorder within descendant subtrees:      #  Reorder within descendant subtrees:
# Line 3578  Line 3586 
3586      my @lines;      my @lines;
3587      foreach ( ( $y1 .. $y2 ) )      foreach ( ( $y1 .. $y2 ) )
3588      {      {
3589          my $line = text_tree_row( $node, $hash, $_, [], 'tee_l' );          my $line = text_tree_row( $node, $hash, $_, [], 'tee_l', $dy >= 2 );
3590          my $lbl  = '';          my $lbl  = '';
3591          if ( @$line )          if ( @$line )
3592          {          {
# Line 3675  Line 3683 
3683          $yn1 = $ylist[ 0];          $yn1 = $ylist[ 0];
3684          $yn2 = $ylist[-1];          $yn2 = $ylist[-1];
3685          $y = int( 0.5 * ( $yn1 + $yn2 ) + ( $yrnd || 0.4999 ) );          $y = int( 0.5 * ( $yn1 + $yn2 ) + ( $yrnd || 0.4999 ) );
3686    
3687            #  Handle special case of internal node label. Put it between subtrees.
3688    
3689            if ( ( $dy >= 2 ) && newick_lbl( $node ) && ( @dl > 1 ) ) {
3690                #  Find the descendents $i1 and $i2 to put the branch between
3691                my $i2 = 1;
3692                while ( ( $i2+1 < @ylist ) && ( $ylist[$i2] < $y ) ) { $i2++ }
3693                my $i1 = $i2 - 1;
3694                #  Get bottom of subtree1 and top of subtree2:
3695                my $ymax1 = $hash->{ $dl[ $i1 ] }->[ 1 ];
3696                my $ymin2 = $hash->{ $dl[ $i2 ] }->[ 0 ];
3697                #  Midway between bottom of subtree1 and top of subtree2, with
3698                #  preferred rounding direction
3699                $y = int( 0.5 * ( $ymax1 + $ymin2 ) + ( $yrnd || 0.4999 ) );
3700            }
3701      }      }
3702    
3703      $y2 = int( $ymax - 0.5 * $dy + 0.4999 );      $y2 = int( $ymax - 0.5 * $dy + 0.4999 );
# Line 3707  Line 3730 
3730  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3731  #  Produce a description of one line of a printer plot tree.  #  Produce a description of one line of a printer plot tree.
3732  #  #
3733  #  \@line = text_tree_row( $node, $hash, $row, \@line, $symb )  #  \@line = text_tree_row( $node, $hash, $row, \@line, $symb, $ilbl )
3734  #  #
3735  #     \@line is the character descriptions accumulated so far, one per array  #     \@line is the character descriptions accumulated so far, one per array
3736  #          element, except for a label, which can be any number of characters.  #          element, except for a label, which can be any number of characters.
# Line 3719  Line 3742 
3742  #     \%hash contains tree layout information  #     \%hash contains tree layout information
3743  #      $row  is the row number (y value) that we are building  #      $row  is the row number (y value) that we are building
3744  #      $symb is the plot symbol proposed for the current x and y position  #      $symb is the plot symbol proposed for the current x and y position
3745    #      $ilbl is true if internal node labels are allowed
3746  #  #
3747  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3748  sub text_tree_row  sub text_tree_row
3749  {  {
3750      my ( $node, $hash, $row, $line, $symb ) = @_;      my ( $node, $hash, $row, $line, $symb, $ilbl ) = @_;
3751    
3752      my ( $y1, $y2, $x0, $x, $y, $yn1, $yn2 ) = @{ $hash->{ $node } };      my ( $y1, $y2, $x0, $x, $y, $yn1, $yn2 ) = @{ $hash->{ $node } };
3753      if ( $row < $y1 || $row > $y2 ) { return $line }      if ( $row < $y1 || $row > $y2 ) { return $line }
# Line 3757  Line 3781 
3781          foreach ( @list ) {          foreach ( @list ) {
3782              my ( $n, $s ) = @$_;              my ( $n, $s ) = @$_;
3783              if ( $row >= $hash->{ $n }->[0] && $row <= $hash->{ $n }->[1] ) {              if ( $row >= $hash->{ $n }->[0] && $row <= $hash->{ $n }->[1] ) {
3784                  $line = text_tree_row( $n, $hash, $row, $line, $s );                  $line = text_tree_row( $n, $hash, $row, $line, $s, $ilbl );
3785              }              }
3786           }           }
3787    
3788          if ( $row == $y ) {          if ( $row == $y ) {
3789              $line->[$x] = ( $line->[$x] eq 'horiz' ) ? 'tee_l'              $line->[$x] = ( $line->[$x] eq 'horiz' ) ? 'tee_l'
3790                                                       : $with_left_line{ $line->[$x] };                                                       : $with_left_line{ $line->[$x] };
3791                push( @$line, newick_lbl( $node ), '' ) if $ilbl && newick_lbl( $node );
3792          }          }
3793      }      }
3794    
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16
MCS Webmaster
 ViewVC Help
Powered by ViewVC 1.0.3