File Coverage

Bio/Tree/AlleleNode.pm
Criterion Covered Total %
statement 35 41 85.3
branch 3 4 75.0
condition 2 3 66.6
subroutine 13 16 81.2
pod 10 10 100.0
total 63 74 85.1


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Tree::AlleleNode
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::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 Ls with the added ability to
25             add Genotypes alleles as defined by the L
26             interface. Genotypes are defined by the L
27             interface, you will probably want to use the L
28             implementation.
29              
30             This is implemented via containment to avoid multiple inheritance
31             problems. Their is a L object which handles
32             the L interface, and is accessible via the
33             L 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
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 and L primarily for use in
78             L simulations.
79              
80             =cut
81              
82             # Let the code begin...
83              
84              
85             package Bio::Tree::AlleleNode;
86 2     2   667 use vars qw($UIDCOUNTER);
  2         2  
  2         82  
87 2     2   9 use strict;
  2         2  
  2         48  
88 2     2   29 BEGIN { $UIDCOUNTER = 1 }
89              
90 2     2   631 use Bio::PopGen::Individual;
  2         4  
  2         54  
91 2     2   579 use Bio::PopGen::Genotype;
  2         4  
  2         58  
92              
93 2     2   9 use base qw(Bio::Tree::Node Bio::PopGen::IndividualI);
  2         2  
  2         677  
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 10     10 1 20 my($class,@args) = @_;
115              
116 10         32 my $self = $class->SUPER::new(@args);
117 10         34 $self->individual( Bio::PopGen::Individual->new(@args));
118 10         30 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 object
127             Args : on set, new value (L)
128              
129              
130             =cut
131              
132             sub individual {
133 3875     3875 1 2749 my ($self,$newval) = @_;
134 3875 100 66     11053 if( defined $newval || ! defined $self->{'individual'} ) {
135 10 50       16 $newval = Bio::PopGen::Individual->new() unless defined $newval;
136 10         23 $self->{'individual'} = $newval;
137             }
138 3875         6591 return $self->{'individual'};
139             }
140              
141             =head2 Bio::PopGen::Individual methods
142              
143             Methods required by L.
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 0     0 1 0 my $self = shift;
159 0         0 $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 0     0 1 0 my $self = shift;
174 0         0 $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 903     903 1 715 my $self = shift;
191 903         975 $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 9     9 1 11 my $self = shift;
207 9         14 $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 0     0 1 0 my $self = shift;
223 0         0 $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 2048     2048 1 2043 my $self = shift;
240 2048         2060 $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 900     900 1 665 my $self = shift;
257 900         918 $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 5     5 1 10 my $self = shift;
273 5         13 $self->individual->get_marker_names(@_);
274             }
275              
276             =head2 Bio::Tree::Node methods
277              
278             Methods inherited from L.
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
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 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;