Bio/Tree/AlleleNode.pm

   1 #
   2 # BioPerl module for Bio::Tree::AlleleNode
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason@bioperl.org>
   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::AlleleNode - A Node with Alleles attached
  17
  18 =head1 SYNOPSIS
  19
  20   use Bio::Tree::AlleleNode;
  21
  22 =head1 DESCRIPTION
  23
  24 AlleleNodes are basic L<Bio::Tree::Node>s with the added ability to
  25 add Genotypes alleles as defined by the L<Bio::PopGen::IndividualI>
  26 interface.  Genotypes are defined by the L<Bio::PopGen::GenotypeI>
  27 interface, you will probably want to use the L<Bio::PopGen::Genotype>
  28 implementation.
  29
  30 This is implemented via containment to avoid multiple inheritance
  31 problems.  Their is a L<Bio::PopGen::Individual> object which handles
  32 the L<Bio::PopGen::IndividualI> interface, and is accessible via the
  33 L<Bio::Tree::AlleleNode::individual> method.
  34
  35 =head1 FEEDBACK
  36
  37 =head2 Mailing Lists
  38
  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.
  42
  43   bioperl-l@bioperl.org                  - General discussion
  44   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  45
  46 =head2 Support
  47
  48 Please direct usage questions or support issues to the mailing list:
  49
  50 I<bioperl-l@bioperl.org>
  51
  52 rather than to the module maintainer directly. Many experienced and
  53 reponsive experts will be able look at the problem and quickly
  54 address it. Please include a thorough description of the problem
  55 with code and data examples if at all possible.
  56
  57 =head2 Reporting Bugs
  58
  59 Report bugs to the Bioperl bug tracking system to help us keep track
  60 of the bugs and their resolution. Bug reports can be submitted via the
  61 web:
  62
  63   https://github.com/bioperl/bioperl-live/issues
  64
  65 =head1 AUTHOR - Jason Stajich
  66
  67 Email jason-at-bioperl-dot-org
  68
  69 =head1 APPENDIX
  70
  71 The rest of the documentation details each of the object methods.
  72 Internal methods are usually preceded with a _
  73
  74 =head1 HISTORY
  75
  76 This module was re-written to be a combination of
  77 L<Bio::PopGen::Individual> and L<Bio::Tree::Node> primarily for use in
  78 L<Bio::PopGen::Simulation::Coalescent> simulations.
  79
  80 =cut
  81
  82 # Let the code begin...
  83
  84
  85 package Bio::Tree::AlleleNode;
  86 use vars qw($UIDCOUNTER);
  87 use strict;
  88 BEGIN { $UIDCOUNTER = 1 }
  89
  90 use Bio::PopGen::Individual;
  91 use Bio::PopGen::Genotype;
  92
  93 use base qw(Bio::Tree::Node Bio::PopGen::IndividualI);
  94
  95 =head2 new
  96
  97  Title   : new
  98  Usage   : my $obj = Bio::Tree::AlleleNode->new();
  99  Function: Builds a new Bio::Tree::AlleleNode() object
 100  Returns : an instance of Bio::Tree::AlleleNode
 101  Args    : -unique_id     => $id,
 102            -genotypes     => \@genotypes
 103            -left          => pointer to Left descendent (optional)
 104            -right         => pointer to Right descenent (optional)
 105            -branch_length => branch length [integer] (optional)
 106            -bootstrap     => value   bootstrap value (string)
 107            -description   => description of node
 108            -id            => human readable (unique) id for node
 109                              Should NOT contain the characters
 110                              '();:'
 111 =cut
 112
 113 sub new {
 114     my($class,@args) = @_;
 115
 116     my $self = $class->SUPER::new(@args);
 117     $self->individual( Bio::PopGen::Individual->new(@args));
 118     return $self;
 119 }
 120
 121 =head2 individual
 122
 123  Title   : individual
 124  Usage   : $obj->individual($newval)
 125  Function: Get/Set Access to the underlying individual object
 126  Returns : L<Bio::PopGen::Individual> object
 127  Args    : on set, new value (L<Bio::PopGen::Individual>)
 128
 129
 130 =cut
 131
 132 sub individual {
 133     my ($self,$newval) = @_;
 134     if( defined $newval || ! defined $self->{'individual'} ) {
 135         $newval = Bio::PopGen::Individual->new() unless defined $newval;
 136         $self->{'individual'} = $newval;
 137     }
 138     return $self->{'individual'};
 139 }
 140
 141 =head2 Bio::PopGen::Individual methods
 142
 143 Methods required by L<Bio::PopGen::IndividualI>.
 144
 145
 146 =head2 unique_id
 147
 148  Title   : unique_id
 149  Usage   : my $id = $individual->unique_id
 150  Function: Unique Identifier
 151  Returns : string representing unique identifier
 152  Args    : string
 153
 154
 155 =cut
 156
 157 sub unique_id{
 158     my $self = shift;
 159     $self->individual->unique_id(@_);
 160 }
 161
 162 =head2 num_of_results
 163
 164  Title   : num_of_results
 165  Usage   : my $count = $person->num_results;
 166  Function: returns the count of the number of Results for a person
 167  Returns : integer
 168  Args    : none
 169
 170 =cut
 171
 172 sub num_of_results {
 173     my $self = shift;
 174     $self->individual->num_of_results(@_);
 175 }
 176
 177 =head2 add_Genotype
 178
 179  Title   : add_Genotype
 180  Usage   : $individual->add_Genotype
 181  Function: add a genotype value, only a single genotype
 182            may be associated
 183  Returns : count of the number of genotypes associated with this individual
 184  Args    : @genotypes - Bio::PopGen::GenotypeI object(s) containing
 185                         alleles plus a marker name
 186
 187 =cut
 188
 189 sub add_Genotype {
 190     my $self = shift;
 191     $self->individual->add_Genotype(@_);
 192 }
 193
 194 =head2 reset_Genotypes
 195
 196  Title   : reset_Genotypes
 197  Usage   : $individual->reset_Genotypes;
 198  Function: Reset the genotypes stored for this individual
 199  Returns : none
 200  Args    : none
 201
 202
 203 =cut
 204
 205 sub reset_Genotypes{
 206     my $self = shift;
 207     $self->individual->reset_Genotypes(@_);
 208 }
 209
 210 =head2 remove_Genotype
 211
 212  Title   : remove_Genotype
 213  Usage   : $individual->remove_Genotype(@names)
 214  Function: Removes the genotypes for the requested markers
 215  Returns : none
 216  Args    : Names of markers
 217
 218
 219 =cut
 220
 221 sub remove_Genotype{
 222     my $self = shift;
 223     $self->individual->remove_Genotype(@_);
 224 }
 225
 226 =head2 get_Genotypes
 227
 228  Title   : get_Genotypes
 229  Usage   : my @genotypes = $ind->get_Genotypes(-marker => $markername);
 230  Function: Get the genotypes for an individual, based on a criteria
 231  Returns : Array of genotypes
 232  Args    : either none (return all genotypes) or
 233            -marker => name of marker to return (exact match, case matters)
 234
 235
 236 =cut
 237
 238 sub get_Genotypes{
 239     my $self = shift;
 240     $self->individual->get_Genotypes(@_);
 241 }
 242
 243 =head2 has_Marker
 244
 245  Title   : has_Marker
 246  Usage   : if( $ind->has_Marker($name) ) {}
 247  Function: Boolean test to see if an Individual has a genotype
 248            for a specific marker
 249  Returns : Boolean (true or false)
 250  Args    : String representing a marker name
 251
 252
 253 =cut
 254
 255 sub has_Marker{
 256     my $self = shift;
 257     $self->individual->has_Marker(@_);
 258 }
 259
 260 =head2 get_marker_names
 261
 262  Title   : get_marker_names
 263  Usage   : my @names = $individual->get_marker_names;
 264  Function: Returns the list of known marker names
 265  Returns : List of strings
 266  Args    : none
 267
 268
 269 =cut
 270
 271 sub get_marker_names{
 272    my $self = shift;
 273    $self->individual->get_marker_names(@_);
 274 }
 275
 276 =head2 Bio::Tree::Node methods
 277
 278 Methods inherited from L<Bio::Tree::Node>.
 279
 280
 281 =head2 add_Descendent
 282
 283  Title   : add_Descendent
 284  Usage   : $node->add_Descendent($node);
 285  Function: Adds a descendent to a node
 286  Returns : number of current descendents for this node
 287  Args    : Bio::Node::NodeI
 288            boolean flag, true if you want to ignore the fact that you are
 289            adding a second node with the same unique id (typically memory
 290            location reference in this implementation).  default is false and
 291            will throw an error if you try and overwrite an existing node.
 292
 293
 294 =head2 each_Descendent
 295
 296  Title   : each_Descendent($sortby)
 297  Usage   : my @nodes = $node->each_Descendent;
 298  Function: all the descendents for this Node (but not their descendents
 299                                               i.e. not a recursive fetchall)
 300  Returns : Array of Bio::Tree::NodeI objects
 301  Args    : $sortby [optional] "height", "creation" or coderef to be used
 302            to sort the order of children nodes.
 303
 304
 305 =head2 remove_Descendent
 306
 307  Title   : remove_Descendent
 308  Usage   : $node->remove_Descedent($node_foo);
 309  Function: Removes a specific node from being a Descendent of this node
 310  Returns : nothing
 311  Args    : An array of Bio::Node::NodeI objects which have be previously
 312            passed to the add_Descendent call of this object.
 313
 314
 315 =head2 remove_all_Descendents
 316
 317  Title   : remove_all_Descendents
 318  Usage   : $node->remove_All_Descendents()
 319  Function: Cleanup the node's reference to descendents and reset
 320            their ancestor pointers to undef, if you don't have a reference
 321            to these objects after this call they will be cleaned up - so
 322            a get_nodes from the Tree object would be a safe thing to do first
 323  Returns : nothing
 324  Args    : none
 325
 326
 327
 328 =head2 get_all_Descendents
 329
 330  Title   : get_all_Descendents
 331  Usage   : my @nodes = $node->get_all_Descendents;
 332  Function: Recursively fetch all the nodes and their descendents
 333            *NOTE* This is different from each_Descendent
 334  Returns : Array or Bio::Tree::NodeI objects
 335  Args    : none
 336
 337 =cut
 338
 339 # implemented in the interface
 340
 341 =head2 ancestor
 342
 343  Title   : ancestor
 344  Usage   : $obj->ancestor($newval)
 345  Function: Set the Ancestor
 346  Returns : value of ancestor
 347  Args    : newvalue (optional)
 348
 349
 350 =head2 branch_length
 351
 352  Title   : branch_length
 353  Usage   : $obj->branch_length()
 354  Function: Get/Set the branch length
 355  Returns : value of branch_length
 356  Args    : newvalue (optional)
 357
 358
 359 =head2 bootstrap
 360
 361  Title   : bootstrap
 362  Usage   : $obj->bootstrap($newval)
 363  Function: Get/Set the bootstrap value
 364  Returns : value of bootstrap
 365  Args    : newvalue (optional)
 366
 367
 368 =head2 description
 369
 370  Title   : description
 371  Usage   : $obj->description($newval)
 372  Function: Get/Set the description string
 373  Returns : value of description
 374  Args    : newvalue (optional)
 375
 376
 377 =head2 id
 378
 379  Title   : id
 380  Usage   : $obj->id($newval)
 381  Function: The human readable identifier for the node
 382  Returns : value of human readable id
 383  Args    : newvalue (optional)
 384  Note    : id cannot contain the chracters '();:'
 385
 386 "A name can be any string of printable characters except blanks,
 387 colons, semicolons, parentheses, and square brackets. Because you may
 388 want to include a blank in a name, it is assumed that an underscore
 389 character ("_") stands for a blank; any of these in a name will be
 390 converted to a blank when it is read in."
 391
 392 from L<http://evolution.genetics.washington.edu/phylip/newicktree.html>
 393
 394 =cut
 395
 396 =head2 internal_id
 397
 398  Title   : internal_id
 399  Usage   : my $internalid = $node->internal_id
 400  Function: Returns the internal unique id for this Node
 401            (a monotonically increasing number for this in-memory implementation
 402             but could be a database determined unique id in other
 403             implementations)
 404  Returns : unique id
 405  Args    : none
 406
 407
 408 =head2 Bio::Node::NodeI decorated interface implemented
 409
 410 The following methods are implemented by L<Bio::Node::NodeI> decorated
 411 interface.
 412
 413 =head2 is_Leaf
 414
 415  Title   : is_Leaf
 416  Usage   : if( $node->is_Leaf )
 417  Function: Get Leaf status
 418  Returns : boolean
 419  Args    : none
 420
 421 =cut
 422
 423 =head2 to_string
 424
 425  Title   : to_string
 426  Usage   : my $str = $node->to_string()
 427  Function: For debugging, provide a node as a string
 428  Returns : string
 429  Args    : none
 430
 431 =head2 height
 432
 433  Title   : height
 434  Usage   : my $len = $node->height
 435  Function: Returns the height of the tree starting at this
 436            node.  Height is the maximum branchlength.
 437  Returns : The longest length (weighting branches with branch_length) to a leaf
 438  Args    : none
 439
 440 =head2 invalidate_height
 441
 442  Title   : invalidate_height
 443  Usage   : private helper method
 444  Function: Invalidate our cached value of the node's height in the tree
 445  Returns : nothing
 446  Args    : none
 447
 448 =cut
 449
 450 #'
 451
 452 =head2 add_tag_value
 453
 454  Title   : add_tag_value
 455  Usage   : $node->add_tag_value($tag,$value)
 456  Function: Adds a tag value to a node
 457  Returns : number of values stored for this tag
 458  Args    : $tag   - tag name
 459            $value - value to store for the tag
 460
 461
 462 =head2 remove_tag
 463
 464  Title   : remove_tag
 465  Usage   : $node->remove_tag($tag)
 466  Function: Remove the tag and all values for this tag
 467  Returns : boolean representing success (0 if tag does not exist)
 468  Args    : $tag - tagname to remove
 469
 470
 471
 472 =head2 remove_all_tags
 473
 474  Title   : remove_all_tags
 475  Usage   : $node->remove_all_tags()
 476  Function: Removes all tags
 477  Returns : None
 478  Args    : None
 479
 480
 481
 482 =head2 get_all_tags
 483
 484  Title   : get_all_tags
 485  Usage   : my @tags = $node->get_all_tags()
 486  Function: Gets all the tag names for this Node
 487  Returns : Array of tagnames
 488  Args    : None
 489
 490
 491 =head2 get_tag_values
 492
 493  Title   : get_tag_values
 494  Usage   : my @values = $node->get_tag_value($tag)
 495  Function: Gets the values for given tag ($tag)
 496  Returns : Array of values or empty list if tag does not exist
 497  Args    : $tag - tag name
 498
 499
 500 =head2 has_tag
 501
 502  Title   : has_tag
 503  Usage   : $node->has_tag($tag)
 504  Function: Boolean test if tag exists in the Node
 505  Returns : Boolean
 506  Args    : $tag - tagname
 507
 508
 509 =cut
 510
 511
 512 1;