| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # | 
| 2 |  |  |  |  |  |  | # BioPerl module for Bio::Tree::TreeI | 
| 3 |  |  |  |  |  |  | # | 
| 4 |  |  |  |  |  |  | # Please direct questions and support issues to | 
| 5 |  |  |  |  |  |  | # | 
| 6 |  |  |  |  |  |  | # Cared for by Jason Stajich | 
| 7 |  |  |  |  |  |  | # | 
| 8 |  |  |  |  |  |  | # Copyright Jason Stajich | 
| 9 |  |  |  |  |  |  | # | 
| 10 |  |  |  |  |  |  | # You may distribute this module under the same terms as perl itself | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | # POD documentation - main docs before the code | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | =head1 NAME | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | Bio::Tree::TreeI - A Tree object suitable for lots of things, designed | 
| 17 |  |  |  |  |  |  | originally for Phylogenetic Trees. | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | # get a Bio::Tree::TreeI somehow | 
| 22 |  |  |  |  |  |  | # like from a TreeIO | 
| 23 |  |  |  |  |  |  | my $treeio = Bio::TreeIO->new(-format => 'newick', -file => 'treefile.dnd'); | 
| 24 |  |  |  |  |  |  | my $tree   = $treeio->next_tree; | 
| 25 |  |  |  |  |  |  | my @nodes  = $tree->get_nodes; | 
| 26 |  |  |  |  |  |  | my @leaves = $tree->get_leaf_nodes; | 
| 27 |  |  |  |  |  |  | my $root   = $tree->get_root_node; | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | This object holds a pointer to the Root of a Tree which is a | 
| 32 |  |  |  |  |  |  | Bio::Tree::NodeI. | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | =head1 FEEDBACK | 
| 35 |  |  |  |  |  |  |  | 
| 36 |  |  |  |  |  |  | =head2 Mailing Lists | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | User feedback is an integral part of the evolution of this and other | 
| 39 |  |  |  |  |  |  | Bioperl modules. Send your comments and suggestions preferably to | 
| 40 |  |  |  |  |  |  | the Bioperl mailing list.  Your participation is much appreciated. | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | bioperl-l@bioperl.org                  - General discussion | 
| 43 |  |  |  |  |  |  | http://bioperl.org/wiki/Mailing_lists  - About the mailing lists | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | =head2 Support | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | Please direct usage questions or support issues to the mailing list: | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | I | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | rather than to the module maintainer directly. Many experienced and | 
| 52 |  |  |  |  |  |  | reponsive experts will be able look at the problem and quickly | 
| 53 |  |  |  |  |  |  | address it. Please include a thorough description of the problem | 
| 54 |  |  |  |  |  |  | with code and data examples if at all possible. | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | =head2 Reporting Bugs | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | Report bugs to the Bioperl bug tracking system to help us keep track | 
| 59 |  |  |  |  |  |  | of the bugs and their resolution. Bug reports can be submitted via | 
| 60 |  |  |  |  |  |  | the web: | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | https://github.com/bioperl/bioperl-live/issues | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | =head1 AUTHOR - Jason Stajich | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | Email jason@bioperl.org | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | =head1 CONTRIBUTORS | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | Aaron Mackey, amackey@virginia.edu | 
| 71 |  |  |  |  |  |  | Elia Stupka,  elia@fugu-sg.org | 
| 72 |  |  |  |  |  |  | Sendu Bala,   bix@sendu.me.uk | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | =head1 APPENDIX | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | The rest of the documentation details each of the object methods. | 
| 77 |  |  |  |  |  |  | Internal methods are usually preceded with a _ | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | =cut | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | # Let the code begin... | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | package Bio::Tree::TreeI; | 
| 86 | 69 |  |  | 69 |  | 4158 | use strict; | 
|  | 69 |  |  |  |  | 91 |  | 
|  | 69 |  |  |  |  | 1794 |  | 
| 87 |  |  |  |  |  |  |  | 
| 88 | 69 |  |  | 69 |  | 253 | use base qw(Bio::Root::RootI); | 
|  | 69 |  |  |  |  | 85 |  | 
|  | 69 |  |  |  |  | 24259 |  | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | =head2 get_nodes | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | Title   : get_nodes | 
| 93 |  |  |  |  |  |  | Usage   : my @nodes = $tree->get_nodes() | 
| 94 |  |  |  |  |  |  | Function: Return list of Tree::NodeI objects | 
| 95 |  |  |  |  |  |  | Returns : array of Tree::NodeI objects | 
| 96 |  |  |  |  |  |  | Args    : (named values) hash with one value | 
| 97 |  |  |  |  |  |  | order => 'b|breadth' first order or 'd|depth' first order | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  | =cut | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  | sub get_nodes{ | 
| 102 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 103 | 0 |  |  |  |  | 0 | $self->throw_not_implemented(); | 
| 104 |  |  |  |  |  |  | } | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | =head2 get_root_node | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | Title   : get_root_node | 
| 109 |  |  |  |  |  |  | Usage   : my $node = $tree->get_root_node(); | 
| 110 |  |  |  |  |  |  | Function: Get the Top Node in the tree, in this implementation | 
| 111 |  |  |  |  |  |  | Trees only have one top node. | 
| 112 |  |  |  |  |  |  | Returns : Bio::Tree::NodeI object | 
| 113 |  |  |  |  |  |  | Args    : none | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | =cut | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | sub get_root_node{ | 
| 118 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 119 | 0 |  |  |  |  | 0 | $self->throw_not_implemented(); | 
| 120 |  |  |  |  |  |  | } | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | =head2 number_nodes | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | Title   : number_nodes | 
| 125 |  |  |  |  |  |  | Usage   : my $size = $tree->number_nodes | 
| 126 |  |  |  |  |  |  | Function: Find the number of nodes in the tree. | 
| 127 |  |  |  |  |  |  | Returns : int | 
| 128 |  |  |  |  |  |  | Args    : none | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | =cut | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | sub number_nodes{ | 
| 133 | 126 |  |  | 126 | 1 | 115 | my ($self) = @_; | 
| 134 | 126 |  |  |  |  | 178 | my $root = $self->get_root_node; | 
| 135 | 126 | 100 | 66 |  |  | 470 | if( defined $root && $root->isa('Bio::Tree::NodeI'))  { | 
| 136 | 124 |  |  |  |  | 203 | return ($root->descendent_count + 1); | 
| 137 |  |  |  |  |  |  | } | 
| 138 | 2 |  |  |  |  | 7 | return 0; | 
| 139 |  |  |  |  |  |  | } | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | =head2 total_branch_length | 
| 142 |  |  |  |  |  |  |  | 
| 143 |  |  |  |  |  |  | Title   : total_branch_length | 
| 144 |  |  |  |  |  |  | Usage   : my $size = $tree->total_branch_length | 
| 145 |  |  |  |  |  |  | Function: Returns the sum of the length of all branches | 
| 146 |  |  |  |  |  |  | Returns : integer | 
| 147 |  |  |  |  |  |  | Args    : none | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | =cut | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | sub total_branch_length { | 
| 152 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 153 | 0 |  |  |  |  | 0 | $self->throw_not_implemented(); | 
| 154 |  |  |  |  |  |  | } | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | =head2 height | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | Title   : height | 
| 159 |  |  |  |  |  |  | Usage   : my $height = $tree->height | 
| 160 |  |  |  |  |  |  | Function: Gets the height of tree - this LOG_2($number_nodes) | 
| 161 |  |  |  |  |  |  | WARNING: this is only true for strict binary trees.  The TreeIO | 
| 162 |  |  |  |  |  |  | system is capable of building non-binary trees, for which this | 
| 163 |  |  |  |  |  |  | method will currently return an incorrect value!! | 
| 164 |  |  |  |  |  |  | Returns : integer | 
| 165 |  |  |  |  |  |  | Args    : none | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | =cut | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | sub height{ | 
| 170 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 171 | 0 |  |  |  |  | 0 | my $nodect =  $self->number_nodes; | 
| 172 | 0 | 0 |  |  |  | 0 | return 0 if( ! $nodect ); | 
| 173 | 0 |  |  |  |  | 0 | return log($nodect) / log(2); | 
| 174 |  |  |  |  |  |  | } | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | =head2 id | 
| 177 |  |  |  |  |  |  |  | 
| 178 |  |  |  |  |  |  | Title   : id | 
| 179 |  |  |  |  |  |  | Usage   : my $id = $tree->id(); | 
| 180 |  |  |  |  |  |  | Function: An id value for the tree | 
| 181 |  |  |  |  |  |  | Returns : scalar | 
| 182 |  |  |  |  |  |  | Args    : | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  |  | 
| 185 |  |  |  |  |  |  | =cut | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | sub id{ | 
| 188 | 0 |  |  | 0 | 1 | 0 | my ($self,@args) = @_; | 
| 189 | 0 |  |  |  |  | 0 | $self->throw_not_implemented(); | 
| 190 |  |  |  |  |  |  | } | 
| 191 |  |  |  |  |  |  |  | 
| 192 |  |  |  |  |  |  | =head2 score | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | Title   : score | 
| 195 |  |  |  |  |  |  | Usage   : $obj->score($newval) | 
| 196 |  |  |  |  |  |  | Function: Sets the associated score with this tree | 
| 197 |  |  |  |  |  |  | This is a generic slot which is probably best used | 
| 198 |  |  |  |  |  |  | for log likelihood or other overall tree score | 
| 199 |  |  |  |  |  |  | Returns : value of score | 
| 200 |  |  |  |  |  |  | Args    : newvalue (optional) | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  |  | 
| 203 |  |  |  |  |  |  | =cut | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  | sub score{ | 
| 206 | 0 |  |  | 0 | 1 | 0 | my ($self,$value) = @_; | 
| 207 | 0 |  |  |  |  | 0 | $self->throw_not_implemented(); | 
| 208 |  |  |  |  |  |  | } | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | =head2 get_leaf_nodes | 
| 211 |  |  |  |  |  |  |  | 
| 212 |  |  |  |  |  |  | Title   : get_leaf_nodes | 
| 213 |  |  |  |  |  |  | Usage   : my @leaves = $tree->get_leaf_nodes() | 
| 214 |  |  |  |  |  |  | Function: Returns the leaves (tips) of the tree | 
| 215 |  |  |  |  |  |  | Returns : Array of Bio::Tree::NodeI objects | 
| 216 |  |  |  |  |  |  | Args    : none | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  |  | 
| 219 |  |  |  |  |  |  | =cut | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  | sub get_leaf_nodes{ | 
| 222 | 23 |  |  | 23 | 1 | 1653 | my ($self) = @_; | 
| 223 | 23 |  |  |  |  | 80 | return grep { $_->is_Leaf() } $self->get_nodes(-sortby  => 'none'); | 
|  | 561 |  |  |  |  | 570 |  | 
| 224 |  |  |  |  |  |  | } | 
| 225 |  |  |  |  |  |  |  | 
| 226 |  |  |  |  |  |  |  | 
| 227 |  |  |  |  |  |  | =head2 Methods for associating Tag/Values with a Tree | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | These methods associate tag/value pairs with a Tree | 
| 230 |  |  |  |  |  |  |  | 
| 231 |  |  |  |  |  |  | =head2 set_tag_value | 
| 232 |  |  |  |  |  |  |  | 
| 233 |  |  |  |  |  |  | Title   : set_tag_value | 
| 234 |  |  |  |  |  |  | Usage   : $tree->set_tag_value($tag,$value) | 
| 235 |  |  |  |  |  |  | $tree->set_tag_value($tag,@values) | 
| 236 |  |  |  |  |  |  | Function: Sets a tag value(s) to a tree. Replaces old values. | 
| 237 |  |  |  |  |  |  | Returns : number of values stored for this tag | 
| 238 |  |  |  |  |  |  | Args    : $tag   - tag name | 
| 239 |  |  |  |  |  |  | $value - value to store for the tag | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | =cut | 
| 242 |  |  |  |  |  |  |  | 
| 243 |  |  |  |  |  |  | sub set_tag_value{ | 
| 244 | 0 |  |  | 0 | 1 |  | shift->throw_not_implemented(); | 
| 245 |  |  |  |  |  |  | } | 
| 246 |  |  |  |  |  |  |  | 
| 247 |  |  |  |  |  |  | =head2 add_tag_value | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | Title   : add_tag_value | 
| 250 |  |  |  |  |  |  | Usage   : $tree->add_tag_value($tag,$value) | 
| 251 |  |  |  |  |  |  | Function: Adds a tag value to a tree | 
| 252 |  |  |  |  |  |  | Returns : number of values stored for this tag | 
| 253 |  |  |  |  |  |  | Args    : $tag   - tag name | 
| 254 |  |  |  |  |  |  | $value - value to store for the tag | 
| 255 |  |  |  |  |  |  |  | 
| 256 |  |  |  |  |  |  |  | 
| 257 |  |  |  |  |  |  | =cut | 
| 258 |  |  |  |  |  |  |  | 
| 259 |  |  |  |  |  |  | sub add_tag_value{ | 
| 260 | 0 |  |  | 0 | 1 |  | shift->throw_not_implemented(); | 
| 261 |  |  |  |  |  |  | } | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | =head2 remove_tag | 
| 264 |  |  |  |  |  |  |  | 
| 265 |  |  |  |  |  |  | Title   : remove_tag | 
| 266 |  |  |  |  |  |  | Usage   : $tree->remove_tag($tag) | 
| 267 |  |  |  |  |  |  | Function: Remove the tag and all values for this tag | 
| 268 |  |  |  |  |  |  | Returns : boolean representing success (0 if tag does not exist) | 
| 269 |  |  |  |  |  |  | Args    : $tag - tagname to remove | 
| 270 |  |  |  |  |  |  |  | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | =cut | 
| 273 |  |  |  |  |  |  |  | 
| 274 |  |  |  |  |  |  | sub remove_tag { | 
| 275 | 0 |  |  | 0 | 1 |  | shift->throw_not_implemented(); | 
| 276 |  |  |  |  |  |  | } | 
| 277 |  |  |  |  |  |  |  | 
| 278 |  |  |  |  |  |  | =head2 remove_all_tags | 
| 279 |  |  |  |  |  |  |  | 
| 280 |  |  |  |  |  |  | Title   : remove_all_tags | 
| 281 |  |  |  |  |  |  | Usage   : $tree->remove_all_tags() | 
| 282 |  |  |  |  |  |  | Function: Removes all tags | 
| 283 |  |  |  |  |  |  | Returns : None | 
| 284 |  |  |  |  |  |  | Args    : None | 
| 285 |  |  |  |  |  |  |  | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | =cut | 
| 288 |  |  |  |  |  |  |  | 
| 289 |  |  |  |  |  |  | sub remove_all_tags{ | 
| 290 | 0 |  |  | 0 | 1 |  | shift->throw_not_implemented(); | 
| 291 |  |  |  |  |  |  | } | 
| 292 |  |  |  |  |  |  |  | 
| 293 |  |  |  |  |  |  | =head2 get_all_tags | 
| 294 |  |  |  |  |  |  |  | 
| 295 |  |  |  |  |  |  | Title   : get_all_tags | 
| 296 |  |  |  |  |  |  | Usage   : my @tags = $tree->get_all_tags() | 
| 297 |  |  |  |  |  |  | Function: Gets all the tag names for this Tree | 
| 298 |  |  |  |  |  |  | Returns : Array of tagnames | 
| 299 |  |  |  |  |  |  | Args    : None | 
| 300 |  |  |  |  |  |  |  | 
| 301 |  |  |  |  |  |  |  | 
| 302 |  |  |  |  |  |  | =cut | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  | sub get_all_tags { | 
| 305 | 0 |  |  | 0 | 1 |  | shift->throw_not_implemented(); | 
| 306 |  |  |  |  |  |  | } | 
| 307 |  |  |  |  |  |  |  | 
| 308 |  |  |  |  |  |  | =head2 get_tag_values | 
| 309 |  |  |  |  |  |  |  | 
| 310 |  |  |  |  |  |  | Title   : get_tag_values | 
| 311 |  |  |  |  |  |  | Usage   : my @values = $tree->get_tag_values($tag) | 
| 312 |  |  |  |  |  |  | Function: Gets the values for given tag ($tag) | 
| 313 |  |  |  |  |  |  | Returns : Array of values or empty list if tag does not exist | 
| 314 |  |  |  |  |  |  | Args    : $tag - tag name | 
| 315 |  |  |  |  |  |  |  | 
| 316 |  |  |  |  |  |  |  | 
| 317 |  |  |  |  |  |  | =cut | 
| 318 |  |  |  |  |  |  |  | 
| 319 |  |  |  |  |  |  | sub get_tag_values{ | 
| 320 | 0 |  |  | 0 | 1 |  | shift->throw_not_implemented(); | 
| 321 |  |  |  |  |  |  | } | 
| 322 |  |  |  |  |  |  |  | 
| 323 |  |  |  |  |  |  | =head2 has_tag | 
| 324 |  |  |  |  |  |  |  | 
| 325 |  |  |  |  |  |  | Title   : has_tag | 
| 326 |  |  |  |  |  |  | Usage   : $tree->has_tag($tag) | 
| 327 |  |  |  |  |  |  | Function: Boolean test if tag exists in the Tree | 
| 328 |  |  |  |  |  |  | Returns : Boolean | 
| 329 |  |  |  |  |  |  | Args    : $tag - tagname | 
| 330 |  |  |  |  |  |  |  | 
| 331 |  |  |  |  |  |  |  | 
| 332 |  |  |  |  |  |  | =cut | 
| 333 |  |  |  |  |  |  |  | 
| 334 |  |  |  |  |  |  | sub has_tag{ | 
| 335 | 0 |  |  | 0 | 1 |  | shift->throw_not_implemented(); | 
| 336 |  |  |  |  |  |  | } | 
| 337 |  |  |  |  |  |  |  | 
| 338 |  |  |  |  |  |  | 1; |