[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.3, Tue Jan 3 19:50:32 2006 UTC revision 1.4, Fri Dec 15 00:09:52 2006 UTC
# Line 137  Line 137 
137  #  Tree manipulations:  #  Tree manipulations:
138  #===============================================================================  #===============================================================================
139  #  #
140  #  $treecopy = copy__newick_tree( $tree )  #  $treecopy = copy_newick_tree( $tree )
141  #  #
142  #-------------------------------------------------------------------------------  #-------------------------------------------------------------------------------
143  #  The following modify the existing tree, and passibly any components of that  #  The following modify the existing tree, and passibly any components of that
# Line 226  Line 226 
226          tip_to_tip_distance          tip_to_tip_distance
227          node_to_node_distance          node_to_node_distance
228    
229          copy__newick_tree          copy_newick_tree
230    
231          newick_relabel_nodes          newick_relabel_nodes
232          newick_relabel_nodes_i          newick_relabel_nodes_i
# Line 942  Line 942 
942  #  Lists are copied, except that references to empty lists go to undef.  #  Lists are copied, except that references to empty lists go to undef.
943  #  Only defined fields are added, so tree list may be shorter than 8 fields.  #  Only defined fields are added, so tree list may be shorter than 8 fields.
944  #  #
945  #  $treecopy = copy__newick_tree( $tree )  #  $treecopy = copy_newick_tree( $tree )
946  #-------------------------------------------------------------------------------  #-------------------------------------------------------------------------------
947  sub copy__newick_tree {  sub copy_newick_tree {
948      my ( $node ) = @_;      my ( $node ) = @_;
949      array_ref( $node ) || return undef;      array_ref( $node ) || return undef;
950    
951      my $nn = [];  #  Reference to a new node structure      my $nn = [];  #  Reference to a new node structure
952      #  Build a new descendant list, if not empty      #  Build a new descendant list, if not empty
953      my @dl = newick_desc_list( $node );      my @dl = newick_desc_list( $node );
954      set_newick_desc_ref( $nn, @dl ? [ map { copy__newick_tree( $_ ) } @dl ]      set_newick_desc_ref( $nn, @dl ? [ map { copy_newick_tree( $_ ) } @dl ]
955                                    : undef                                    : undef
956                         );                         );
957    
# Line 1846  Line 1846 
1846  #-------------------------------------------------------------------------------  #-------------------------------------------------------------------------------
1847  sub writeNewickTree {  sub writeNewickTree {
1848      my ( $tree, $file ) = @_;      my ( $tree, $file ) = @_;
1849      $file || ( $file = *STDOUT );      $file || ( $file = \*STDOUT );
1850      print  $file  ( strNewickTree( $tree ), "\n" );      print  $file  ( strNewickTree( $tree ), "\n" );
1851  }  }
1852    
# Line 2191  Line 2191 
2191  #  Make a printer plot of a tree:  #  Make a printer plot of a tree:
2192  #  #
2193  #     $node   newick tree root node  #     $node   newick tree root node
2194  #     $file   undef (= *STDOUT), *STDOUT, *STDERR, or a file name.  #     $file   undef (= \*STDOUT), \*STDOUT, \*STDERR, or a file name.
2195  #     $width  the approximate characters for the tree without labels  #     $width  the approximate characters for the tree without labels
2196  #     $min_dx the minimum horizontal branch length  #     $min_dx the minimum horizontal branch length
2197  #     $dy     the vertical space per taxon  #     $dy     the vertical space per taxon
2198  #  #
2199  #  printer_plot_newick( $node, $file (D=*STDOUT), $width (D=68), $min_dx (D=2), $dy (D=1) )  #  printer_plot_newick( $node, $file (D=\*STDOUT), $width (D=68), $min_dx (D=2), $dy (D=1) )
2200  #===============================================================================  #===============================================================================
2201  sub printer_plot_newick {  sub printer_plot_newick {
2202      my ( $node, $file, $width, $min_dx, $dy ) = @_;      my ( $node, $file, $width, $min_dx, $dy ) = @_;
2203    
2204      my ( $fh, $close );      my ( $fh, $close );
2205      if ( ! defined( $file ) ) {      if ( ! defined( $file ) ) {
2206          $fh = *STDOUT;          $fh = \*STDOUT;
2207      }      }
2208      elsif ( $file =~ /^\*/ ) {      elsif ( ref($file) eq "GLOB") {
2209          $fh = $file;          $fh = $file;
2210      }      }
2211      else {      else {

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3