[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.20, Sat Aug 14 23:58:51 2010 UTC revision 1.21, Sat Aug 21 17:12:51 2010 UTC
# Line 440  Line 440 
440  #  Internally used definitions  #  Internally used definitions
441  #-------------------------------------------------------------------------------  #-------------------------------------------------------------------------------
442    
443  sub array_ref { ref( $_[0] ) eq "ARRAY" }  sub array_ref { $_[0] && ref( $_[0] ) eq 'ARRAY' }
444  sub hash_ref  { ref( $_[0] ) eq "HASH"  }  sub hash_ref  { $_[0] && ref( $_[0] ) eq 'HASH'  }
445    
446    
447  #===============================================================================  #===============================================================================
# Line 503  Line 503 
503    
504  sub newick_desc_list {  sub newick_desc_list {
505      my $node = $_[0];      my $node = $_[0];
506      ! array_ref( $node      ) ? undef           :      array_ref( $node ) && array_ref( $node->[0] ) ? @{ $node->[0] } : ();
       array_ref( $node->[0] ) ? @{ $node->[0] } :  
                                 ()              ;  
507  }  }
508    
509  sub newick_n_desc {  sub newick_n_desc {
510      my $node = $_[0];      my $node = $_[0];
511      ! array_ref( $node      ) ? undef                  :      array_ref( $node ) && array_ref( $node->[0] ) ? scalar @{ $node->[0] } : 0;
       array_ref( $node->[0] ) ? scalar @{ $node->[0] } :  
                                 0                      ;  
512  }  }
513    
514  sub newick_desc_i {  sub newick_desc_i {
515      my ( $node, $i ) = @_;      my ( $node, $i ) = @_;
516      ! array_ref( $node      ) ? undef              :      array_ref( $node ) && $i && array_ref( $node->[0] ) ? $node->[0]->[$i-1] : undef;
       array_ref( $node->[0] ) ? $node->[0]->[$i-1] :  
                                 undef              ;  
517  }  }
518    
519  sub node_is_tip {  sub node_is_tip {
# Line 2221  Line 2215 
2215  #-------------------------------------------------------------------------------  #-------------------------------------------------------------------------------
2216  sub reroot_newick_to_approx_midpoint_w {  sub reroot_newick_to_approx_midpoint_w {
2217      my ( $tree ) = @_;      my ( $tree ) = @_;
2218        array_ref( $tree ) or return undef;
2219    
2220      #  Compile average tip to node distances assending from tips      #  Compile average tip to node distances assending from tips
2221    
# Line 2245  Line 2240 
2240  #-------------------------------------------------------------------------------  #-------------------------------------------------------------------------------
2241  sub reroot_newick_to_midpoint_w {  sub reroot_newick_to_midpoint_w {
2242      my ( $tree ) = @_;      my ( $tree ) = @_;
2243        array_ref( $tree ) or return ();
2244    
2245      #  Compile average tip to node distances assending      #  Compile average tip to node distances assending
2246    
# Line 2260  Line 2256 
2256  }  }
2257    
2258    
2259    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2260  sub average_to_tips_1_w {  sub average_to_tips_1_w {
2261      my ( $node ) = @_;      my ( $node ) = @_;
2262    
# Line 2285  Line 2282 
2282  }  }
2283    
2284    
2285    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2286  sub average_to_tips_2_w {  sub average_to_tips_2_w {
2287      my ( $dists1, $x_above, $n_above, $anc_node ) = @_;      my ( $dists1, $x_above, $n_above, $anc_node ) = @_;
2288      my ( undef, $n_below, $x, $x_below, $desc_list, $node ) = @$dists1;      my ( undef, $n_below, $x, $x_below, $desc_list, $node ) = @$dists1;
# Line 3877  Line 3875 
3875  {  {
3876      my $file = shift;      my $file = shift;
3877      my $fh;      my $fh;
3878      if    ( ! defined( $file ) )     { return ( \*STDIN ) }      if    ( ! defined $file || $file eq '' ) { return ( \*STDIN ) }
3879      elsif ( ref( $file ) eq 'GLOB' ) { return ( $file   ) }      elsif ( ref( $file ) eq 'GLOB' ) { return ( $file   ) }
3880      elsif ( open( $fh, "<$file" ) )  { return ( $fh, 1  ) } # Need to close      elsif ( open( $fh, "<$file" ) )  { return ( $fh, 1  ) } # Need to close
3881    
# Line 3898  Line 3896 
3896  {  {
3897      my $file = shift;      my $file = shift;
3898      my $fh;      my $fh;
3899      if    ( ! defined( $file ) )     { return ( \*STDOUT ) }      if    ( ! defined $file || $file eq '' ) { return ( \*STDOUT ) }
3900      elsif ( ref( $file ) eq 'GLOB' ) { return ( $file    ) }      elsif ( ref( $file ) eq 'GLOB' ) { return ( $file    ) }
3901      elsif ( ( open $fh, ">$file" ) ) { return ( $fh, 1   ) } # Need to close      elsif ( ( open $fh, ">$file" ) ) { return ( $fh, 1   ) } # Need to close
3902    

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3