3 # BioPerl module for Bio::Tree::NodeNHX
5 # Cared for by Aaron Mackey <amackey@virginia.edu>
7 # Copyright Aaron Mackey
9 # You may distribute this module under the same terms as perl itself
11 # POD documentation - main docs before the code
15 Bio::Tree::NodeNHX - A Simple Tree Node with support for NHX tags
19 use Bio::Tree::NodeNHX;
20 my $nodeA = new Bio::Tree::NodeNHX();
21 my $nodeL = new Bio::Tree::NodeNHX();
22 my $nodeR = new Bio::Tree::NodeNHX();
24 my $node = new Bio::Tree::NodeNHX();
25 $node->add_Descendents($nodeL);
26 $node->add_Descendents($nodeR);
28 print "node is not a leaf \n" if( $node->is_leaf);
32 Makes a Tree Node with NHX tags, suitable for building a Tree. See
33 L<Bio::Tree::Node> for a full list of functionality.
39 User feedback is an integral part of the evolution of this and other
40 Bioperl modules. Send your comments and suggestions preferably to
41 the Bioperl mailing list. Your participation is much appreciated.
43 bioperl-l@bioperl.org - General discussion
44 http://bioperl.org/MailList.shtml - About the mailing lists
48 Report bugs to the Bioperl bug tracking system to help us keep track
49 of the bugs and their resolution. Bug reports can be submitted via
52 http://bugzilla.bioperl.org/
54 =head1 AUTHOR - Aaron Mackey
56 Email amackey@virginia.edu
60 The NHX (New Hampshire eXtended) format was created by Chris Zmasek,
63 http://www.genetics.wustl.edu/eddy/forester/NHX.html
67 The rest of the documentation details each of the object methods.
68 Internal methods are usually preceded with a _
73 # Let the code begin...
75 package Bio
::Tree
::NodeNHX
;
81 @ISA = qw(Bio::Tree::Node);
86 Usage : my $obj = new Bio::Tree::NodeNHX();
87 Function: Builds a new Bio::Tree::NodeNHX object
88 Returns : Bio::Tree::NodeNHX
89 Args : -left => pointer to Left descendent (optional)
90 -right => pointer to Right descenent (optional)
91 -branch_length => branch length [integer] (optional)
92 -bootstrap => bootstrap value (string)
93 -description => description of node
94 -id => unique id for node
95 -nhx => hashref of NHX tags and values
100 my($class,@args) = @_;
102 my $self = $class->SUPER::new
(@args);
103 my ($nhx) = $self->_rearrange([qw(NHX)], @args);
104 $self->nhx_tag($nhx);
110 # try to insure that everything is cleaned up
111 $self->SUPER::DESTROY
();
112 if( defined $self->{'_desc'} &&
113 ref($self->{'_desc'}) =~ /ARRAY/i ) {
114 while( my ($nodeid,$node) = each %{ $self->{'_desc'} } ) {
115 $node->{'_ancestor'} = undef; # insure no circular references
119 $self->{'_desc'} = {};
125 my @tags = $self->get_all_tags;
128 $tagstr = '[' . join(":", "&&NHX",
129 map { "$_=" .join(',',
130 $self->get_tag_values($_))}
133 return sprintf("%s%s%s",
134 defined $self->id ?
$self->id : '',
135 defined $self->branch_length ?
':' .
136 $self->branch_length : ' ',
143 Usage : my $tag = $nodenhx->nhx_tag(%tags);
144 Function: Set tag-value pairs for NHX nodes
146 Args : hashref to update the tags/value pairs
148 with a scalar value update the bootstrap value by default
154 my ($self, $tags) = @_;
155 if (defined $tags && (ref($tags) =~ /HASH/i)) {
156 while( my ($tag,$val) = each %$tags ) {
157 if( ref($val) =~ /ARRAY/i ) {
158 for my $v ( @
$val ) {
159 $self->add_tag_value($tag,$v);
162 $self->add_tag_value($tag,$val);
165 if (exists $tags->{'B'}) {
166 $self->bootstrap($tags->{'B'});
168 } elsif (defined $tags and ! ref ($tags)) {
169 print STDERR
"here with $tags\n";
170 # bootstrap by default
171 $self->bootstrap($tags);