File Coverage

blib/lib/Bio/Phylo/Taxa/Taxon.pm
Criterion Covered Total %
statement 38 47 80.8
branch 8 12 66.6
condition 2 4 50.0
subroutine 13 15 86.6
pod 6 6 100.0
total 67 84 79.7


line stmt bran cond sub pod time code
1             package Bio::Phylo::Taxa::Taxon;
2 18     18   60784 use strict;
  18         34  
  18         493  
3 18     18   79 use base 'Bio::Phylo::NeXML::Writable';
  18         35  
  18         2507  
4 18     18   110 use Bio::Phylo::Util::CONSTANT qw':objecttypes looks_like_object';
  18         29  
  18         3507  
5 18     18   109 use Bio::Phylo::Mediators::TaxaMediator;
  18         30  
  18         2823  
6             {
7             my $TYPE_CONSTANT = _TAXON_;
8             my $CONTAINER_CONSTANT = _TAXA_;
9             my $DATUM_CONSTANT = _DATUM_;
10             my $NODE_CONSTANT = _NODE_;
11             my $logger = __PACKAGE__->get_logger;
12             my $mediator = 'Bio::Phylo::Mediators::TaxaMediator';
13              
14             =head1 NAME
15              
16             Bio::Phylo::Taxa::Taxon - Operational taxonomic unit
17              
18             =head1 SYNOPSIS
19              
20             use Bio::Phylo::IO qw(parse);
21             use Bio::Phylo::Factory;
22             my $fac = Bio::Phylo::Factory->new;
23              
24             # array of names
25             my @apes = qw(
26             Homo_sapiens
27             Pan_paniscus
28             Pan_troglodytes
29             Gorilla_gorilla
30             );
31              
32             # newick string
33             my $str = '(((Pan_paniscus,Pan_troglodytes),';
34             $str .= 'Homo_sapiens),Gorilla_gorilla);';
35              
36             # create tree object
37             my $tree = parse(
38             -format => 'newick',
39             -string => $str
40             )->first;
41              
42             # instantiate taxa object
43             my $taxa = $fac->create_taxa;
44              
45             # instantiate taxon objects, insert in taxa object
46             foreach( @apes ) {
47             my $taxon = $fac->create_taxon(
48             -name => $_,
49             );
50             $taxa->insert($taxon);
51             }
52              
53             # crossreference tree and taxa
54             $tree->cross_reference($taxa);
55              
56             # iterate over nodes
57             while ( my $node = $tree->next ) {
58              
59             # check references
60             if ( $node->get_taxon ) {
61              
62             # prints crossreferenced tips
63             print "match: ", $node->get_name, "\n";
64             }
65             }
66              
67             =head1 DESCRIPTION
68              
69             The taxon object models a single operational taxonomic unit. It is useful for
70             cross-referencing datum objects and tree nodes.
71              
72             =head1 METHODS
73              
74             =head2 MUTATORS
75              
76             =over
77              
78             =item set_data()
79              
80             Associates argument data with invocant.
81              
82             Type : Mutator
83             Title : set_data
84             Usage : $taxon->set_data( $datum );
85             Function: Associates data with
86             the current taxon.
87             Returns : Modified object.
88             Args : Must be an object of type
89             Bio::Phylo::Matrices::Datum
90              
91             =cut
92              
93             sub set_data : Clonable {
94 10     10 1 30 my ( $self, $datum ) = @_;
95 10 50       61 if ( not defined $datum ) {
    100          
    50          
96 0         0 return $self;
97             }
98             elsif ( ref $datum eq 'ARRAY' ) {
99 3         6 for my $d ( @{ $datum } ) {
  3         10  
100 4         17 $self->set_data($d);
101             }
102             }
103             elsif ( looks_like_object $datum, $DATUM_CONSTANT ) {
104 5         25 $mediator->set_link(
105             '-one' => $self,
106             '-many' => $datum,
107             );
108             }
109 8         26 return $self;
110 18     18   113 }
  18         36  
  18         99  
111              
112             =item set_nodes()
113              
114             Associates argument node with invocant.
115              
116             Type : Mutator
117             Title : set_nodes
118             Usage : $taxon->set_nodes($node);
119             Function: Associates tree nodes
120             with the current taxon.
121             Returns : Modified object.
122             Args : A Bio::Phylo::Forest::Node object
123              
124             =cut
125              
126             sub set_nodes : Clonable {
127 6     6 1 21 my ( $self, $node ) = @_;
128 6 50       31 if ( not defined $node ) {
    100          
    50          
129 0         0 return $self;
130             }
131             elsif ( ref $node eq 'ARRAY' ) {
132 3         6 for my $n ( @{ $node } ) {
  3         12  
133 0         0 $self->set_nodes($n);
134             }
135             }
136             elsif ( looks_like_object $node, $NODE_CONSTANT ) {
137 1         4 $mediator->set_link(
138             '-one' => $self,
139             '-many' => $node,
140             );
141             }
142 4         15 return $self;
143 18     18   4716 }
  18         38  
  18         70  
144              
145             =item unset_datum()
146              
147             Removes association between argument data and invocant.
148              
149             Type : Mutator
150             Title : unset_datum
151             Usage : $taxon->unset_datum($node);
152             Function: Disassociates datum from
153             the invocant taxon (i.e.
154             removes reference).
155             Returns : Modified object.
156             Args : A Bio::Phylo::Matrix::Datum object
157              
158             =cut
159              
160             sub unset_datum {
161 0     0 1 0 my ( $self, $datum ) = @_;
162 0         0 $mediator->remove_link(
163             '-one' => $self,
164             '-many' => $datum,
165             );
166 0         0 return $self;
167             }
168              
169             =item unset_node()
170              
171             Removes association between argument node and invocant.
172              
173             Type : Mutator
174             Title : unset_node
175             Usage : $taxon->unset_node($node);
176             Function: Disassociates tree node from
177             the invocant taxon (i.e.
178             removes reference).
179             Returns : Modified object.
180             Args : A Bio::Phylo::Forest::Node object
181              
182             =cut
183              
184             sub unset_node {
185 0     0 1 0 my ( $self, $node ) = @_;
186 0         0 $mediator->remove_link(
187             '-one' => $self,
188             '-many' => $node,
189             );
190 0         0 return $self;
191             }
192              
193             =back
194              
195             =head2 ACCESSORS
196              
197             =over
198              
199             =item get_data()
200              
201             Retrieves associated datum objects.
202              
203             Type : Accessor
204             Title : get_data
205             Usage : @data = @{ $taxon->get_data };
206             Function: Retrieves data associated
207             with the current taxon.
208             Returns : An ARRAY reference of
209             Bio::Phylo::Matrices::Datum
210             objects.
211             Args : None.
212              
213             =cut
214              
215             sub get_data {
216 24     24 1 39 my $self = shift;
217 24   50     77 return $mediator->get_link(
218             '-source' => $self,
219             '-type' => $DATUM_CONSTANT,
220             ) || [];
221             }
222              
223             =item get_nodes()
224              
225             Retrieves associated node objects.
226              
227             Type : Accessor
228             Title : get_nodes
229             Usage : @nodes = @{ $taxon->get_nodes };
230             Function: Retrieves tree nodes associated
231             with the current taxon.
232             Returns : An ARRAY reference of
233             Bio::Phylo::Trees::Node objects
234             Args : None.
235              
236             =cut
237              
238             sub get_nodes {
239 24     24 1 37 my $self = shift;
240 24   50     63 return $mediator->get_link(
241             '-source' => $self,
242             '-type' => $NODE_CONSTANT,
243             ) || [];
244             }
245              
246             =begin comment
247              
248             Type : Internal method
249             Title : _container
250             Usage : $taxon->_container;
251             Function:
252             Returns : CONSTANT
253             Args :
254              
255             =end comment
256              
257             =cut
258              
259 365     365   549 sub _container { $CONTAINER_CONSTANT }
260              
261             =begin comment
262              
263             Type : Internal method
264             Title : _type
265             Usage : $taxon->_type;
266             Function:
267             Returns : CONSTANT
268             Args :
269              
270             =end comment
271              
272             =cut
273              
274 424     424   790 sub _type { $TYPE_CONSTANT }
275 2     2   10 sub _tag { 'otu' }
276              
277             =back
278              
279             =cut
280              
281             # podinherit_insert_token
282              
283             =head1 SEE ALSO
284              
285             There is a mailing list at L<https://groups.google.com/forum/#!forum/bio-phylo>
286             for any user or developer questions and discussions.
287              
288             =over
289              
290             =item L<Bio::Phylo::NeXML::Writable>
291              
292             The taxon objects inherits from the L<Bio::Phylo::NeXML::Writable> object. The methods defined
293             there are also applicable to the taxon object.
294              
295             =item L<Bio::Phylo::Manual>
296              
297             Also see the manual: L<Bio::Phylo::Manual> and L<http://rutgervos.blogspot.com>.
298              
299             =back
300              
301             =head1 CITATION
302              
303             If you use Bio::Phylo in published research, please cite it:
304              
305             B<Rutger A Vos>, B<Jason Caravas>, B<Klaas Hartmann>, B<Mark A Jensen>
306             and B<Chase Miller>, 2011. Bio::Phylo - phyloinformatic analysis using Perl.
307             I<BMC Bioinformatics> B<12>:63.
308             L<http://dx.doi.org/10.1186/1471-2105-12-63>
309              
310             =cut
311              
312             }
313             1;