File Coverage

Bio/Cluster/SequenceFamily.pm
Criterion Covered Total %
statement 73 88 82.9
branch 21 36 58.3
condition 3 9 33.3
subroutine 15 18 83.3
pod 15 15 100.0
total 127 166 76.5


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Cluster::SequenceFamily
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Shawn Hoon
7             #
8             # Copyright Shawn Hoon
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::Cluster::SequenceFamily - Sequence Family object
17              
18             =head1 SYNOPSIS
19              
20             use Bio::SeqIO;
21             use Bio::Cluster::SequenceFamily;
22             use File::Spec;
23              
24             my $file = File::Spec->catfile('t','data','swiss.dat');
25             my $seqio= Bio::SeqIO->new(-format => 'swiss',
26             -file => $file);
27             my @mem;
28             while(my $seq = $seqio->next_seq){
29             push @mem, $seq;
30             }
31              
32             #create the family
33             my $family = Bio::Cluster::SequenceFamily->new(
34             -family_id=>"Family_1",
35             -description=>"Family Description Here",
36             -annotation_score=>"100",
37             -members=>\@mem);
38              
39             #access the family
40              
41             foreach my $mem ($family->get_members){
42             print $mem->display_id."\t".$mem->desc."\n";
43             }
44              
45             #select members if members have a Bio::Species Object
46              
47             my @mem = $family->get_members(-binomial=>"Homo sapiens");
48             @mem = $family->get_members(-ncbi_taxid => 9606);
49             @mem = $family->get_members(-common_name=>"Human");
50             @mem = $family->get_members(-species=>"sapiens");
51             @mem = $family->get_members(-genus=>"Homo");
52              
53             =head1 DESCRIPTION
54              
55             This is a simple Family object that may hold any group of object. For more
56             specific families, one should derive from FamilyI.
57              
58             =head1 FEEDBACK
59              
60             Email bioperl-l@bioperl.org for support and feedback.
61              
62             =head2 Mailing Lists
63              
64             User feedback is an integral part of the evolution of this and other
65             Bioperl modules. Send your comments and suggestions preferably to one
66             of the Bioperl mailing lists. Your participation is much appreciated.
67              
68             bioperl-l@bioperl.org - General discussion
69             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
70              
71             =head2 Support
72              
73             Please direct usage questions or support issues to the mailing list:
74              
75             I
76              
77             rather than to the module maintainer directly. Many experienced and
78             reponsive experts will be able look at the problem and quickly
79             address it. Please include a thorough description of the problem
80             with code and data examples if at all possible.
81              
82             =head2 Reporting Bugs
83              
84             Report bugs to the Bioperl bug tracking system to help us keep track
85             the bugs and their resolution. Bug reports can be submitted via the
86             web:
87              
88             https://github.com/bioperl/bioperl-live/issues
89              
90             =head1 AUTHOR - Shawn Hoon
91              
92             Email shawnh@fugu-sg.org
93              
94             =head1 APPENDIX
95              
96             The rest of the documentation details each of the object
97             methods. Internal methods are usually preceded with a "_".
98              
99             =cut
100              
101             # Let the code begin...
102              
103              
104             package Bio::Cluster::SequenceFamily;
105              
106 1     1   1076 use strict;
  1         2  
  1         22  
107 1     1   3 use warnings;
  1         1  
  1         21  
108 1     1   3 use base qw(Bio::Root::Root Bio::Cluster::FamilyI);
  1         1  
  1         281  
109              
110             =head2 new
111              
112             Title : new
113             Usage : my $family = Bio::Cluster::SequenceFamily->new(
114             -family_id=>"Family_1",
115             -description=>"Family Description Here",
116             -annotation_score=>"100",
117             -members=>\@mem);
118             Function: Constructor for SequenceFamily object
119             Returns : Bio::Cluster::SequenceFamily object
120              
121             See L.
122              
123             =cut
124              
125             sub new {
126 1     1 1 17 my ($class,@args) = @_;
127 1         6 my $self = $class->SUPER::new(@args);
128 1         7 my ($id,$description,$version,$annot_score,
129             $family_score,$members) = $self->_rearrange([qw(FAMILY_ID DESCRIPTION VERSION
130             ANNOTATION_SCORE
131             FAMILY_SCORE MEMBERS)],@args);
132 1         3 $self->{'_members'} = [];
133 1 50       5 $id && $self->family_id($id);
134 1 50       4 $description && $self->description($description);
135 1 50       4 $version && $self->version($version);
136 1 50       4 $annot_score && $self->annotation_score($annot_score);
137 1 50       3 $family_score && $self->family_score($family_score);
138 1 50       4 $members && $self->add_members($members);
139              
140 1         3 return $self;
141             }
142              
143             =head2 version
144              
145             Title : version
146             Usage : $family->version("1.0");
147             Function: get/set for version
148             Returns : a string version of the family generated.
149              
150             =cut
151              
152             sub version{
153 2     2 1 2 my ($self,$value) = @_;
154 2 100       5 if($value){
155 1         1 $self->{'_version'} =$value;
156             }
157 2         4 return $self->{'_version'};
158             }
159              
160             =head2 annotation_score
161              
162             Title : annotation_score
163             Usage : $family->annotation_score(100);
164             Function: get/set for annotation_score which
165             represent the confidence in which the
166             consensus description has been assigned
167             to the family.
168             Returns : Bio::SimpleAlign
169              
170             See L
171              
172             =cut
173              
174             sub annotation_score{
175 2     2 1 4 my ($self,$score) = @_;
176 2 100       4 if($score){
177 1         3 $self->{'_annotation_score'} = $score;
178             }
179 2         5 return $self->{'_annotation_score'};
180             }
181              
182             =head2 alignment
183              
184             Title : alignment
185             Usage : $family->alignment($align);
186             Function: get/set for an alignment object representing
187             the multiple alignment of the members of the family.
188             Returns : Bio::SimpleAlign
189              
190             See L
191              
192             =cut
193              
194             sub alignment {
195 0     0 1 0 my ($self,$align) = @_;
196 0 0       0 if($align){
197 0         0 $self->{'_alignment'} = $align;
198             }
199 0         0 return $self->{'_alignment'};
200             }
201              
202             =head2 tree
203              
204             Title : tree
205             Usage : $family->tree($tree);
206             Function: get/set for an tree object representing
207             the phylogenetic tree of the family.
208             Returns : Bio::Tree
209              
210             See L
211              
212             =cut
213              
214             sub tree {
215 0     0 1 0 my ($self,$tree) = @_;
216 0 0       0 if($tree) {
217 0         0 $self->{'_tree'} = $tree;
218             }
219 0         0 return $self->{'_tree'};
220             }
221              
222             =head1 L methods
223              
224             =cut
225              
226             =head2 family_score
227              
228             Title : family_score
229             Usage : Bio::Cluster::FamilyI->family_score(95);
230             Function: get/set for the score of algorithm used to generate
231             the family if present
232              
233             This is aliased to cluster_score().
234              
235             Returns : the score
236             Args : the score
237              
238             =cut
239              
240             sub family_score {
241 2     2 1 9 return shift->cluster_score(@_);
242             }
243              
244              
245             =head2 family_id
246              
247             Title : family_id
248             Usage : $family->family_id("Family_1");
249             Function: get/set for family id
250              
251             This is aliased to display_id().
252              
253             Returns : a string specifying identifier of the family
254              
255             =cut
256              
257             sub family_id{
258 2     2 1 6 return shift->display_id(@_);
259             }
260              
261             =head1 L methods
262              
263             =cut
264              
265             =head2 display_id
266              
267             Title : display_id
268             Usage :
269             Function: Get/set the display name or identifier for the cluster
270             Returns : a string
271             Args : optional, on set the display ID ( a string)
272              
273             =cut
274              
275             sub display_id{
276 2     2 1 3 my ($self,$id) = @_;
277 2 100       4 if($id){
278 1         2 $self->{'_cluster_id'} = $id;
279             }
280 2         6 return $self->{'_cluster_id'};
281             }
282              
283             =head2 description
284              
285             Title : description
286             Usage : $fam->description("POLYUBIQUITIN")
287             Function: get/set for the consensus description of the cluster
288             Returns : the description string
289             Args : Optional the description string
290              
291             =cut
292              
293             sub description{
294 2     2 1 5 my ($self,$desc) = @_;
295 2 100       5 if($desc){
296 1         2 $self->{'_description'} = $desc;
297             }
298 2         8 return $self->{'_description'};
299             }
300              
301             =head2 get_members
302              
303             Title : get_members
304             Usage : Valid criteria:
305             -common_name
306             -binomial
307             -ncbi_taxid
308             -organelle
309             -genus
310             $family->get_members(-common_name =>"human");
311             $family->get_members(-species =>"homo sapiens");
312             $family->get_members(-ncbi_taxid => 9606);
313             For now, multiple critieria are ORed.
314              
315             Will return all members if no criteria are provided.
316              
317             Function: get members using methods from L
318             the phylogenetic tree of the family.
319             Returns : an array of objects that are member of this family.
320              
321             =cut
322              
323             sub get_members {
324 2     2 1 422 my $self = shift;
325 2 50       6 return @{$self->{'_members'}} unless @_;
  0         0  
326              
327             ## since the logic behind the checks is OR, we keep the ids in an hash for
328             ## performance (skip the test if it's already there) and to avoid repats
329 2         3 my %match;
330 2         4 my %filter = @_;
331 2         4 foreach my $key (keys %filter) {
332 2         9 (my $method = $key) =~ s/^-//;
333 8         17 %match = (%match, map { $_ => $_ } grep {
334             ! $match{$_} && $_->species &&
335             ($_->species->can($method) ||
336             $self->throw("$method is an invalid criteria")) &&
337 14 50 33     42 $_->species->$method() eq $filter{$key}
      33        
      33        
338 2         4 } @{$self->{'_members'}});
  2         4  
339             }
340 2         4 return map {$match{$_}} keys (%match);
  6         10  
341             }
342              
343             =head2 size
344              
345             Title : size
346             Usage : $fam->size();
347             Function: get/set for the size of the family,
348             calculated from the number of members
349             Returns : the size of the family
350             Args :
351              
352             =cut
353              
354             sub size {
355 3     3 1 6 my ($self) = @_;
356 3         4 return scalar(@{$self->{'_members'}});
  3         10  
357             }
358              
359             =head2 cluster_score
360              
361             Title : cluster_score
362             Usage : $fam->cluster_score(100);
363             Function: get/set for cluster_score which
364             represent the score in which the clustering
365             algorithm assigns to this cluster.
366             Returns : a number
367              
368             =cut
369              
370             sub cluster_score{
371 3     3 1 3 my ($self,$score) = @_;
372 3 100       6 if($score){
373 1         2 $self->{'_cluster_score'} = $score;
374             }
375 3         8 return $self->{'_cluster_score'};
376             }
377              
378              
379             =head1 Implementation specific methods
380              
381             These are mostly for adding/removing/changing.
382              
383             =cut
384              
385             =head2 add_members
386              
387             Title : add_members
388             Usage : $fam->add_member([$seq1,$seq1]);
389             Function: add members to a family
390             Returns :
391             Args : the member(s) to add, as an array or arrayref
392              
393             =cut
394              
395             sub add_members{
396 3     3 1 5 my ($self,@mems) = @_;
397              
398 3 50       5 if (@mems) {
399 3         3 my $mem = shift(@mems);
400 3 100       8 if(ref($mem) eq "ARRAY"){
401 1         1 push @{$self->{'_members'}},@{$mem};
  1         2  
  1         3  
402             } else {
403 2         2 push @{$self->{'_members'}},$mem;
  2         5  
404             }
405 3         3 push @{$self->{'_members'}}, @mems;
  3         26  
406             }
407 3         4 return 1;
408             }
409              
410             =head2 remove_members
411              
412             Title : remove_members
413             Usage : $fam->remove_members();
414             Function: remove all members from a family
415             Returns : the previous array of members
416             Args : none
417              
418             =cut
419              
420             sub remove_members{
421 1     1 1 407 my ($self) = @_;
422 1         2 my $mems = $self->{'_members'};
423 1         2 $self->{'_members'} = [];
424 1         2 return @$mems;
425             }
426              
427             #####################################################################
428             # aliases for naming consistency or other reasons #
429             #####################################################################
430              
431             *flush_members = \&remove_members;
432             *add_member = \&add_members;
433              
434             =head2 members
435              
436             Title : members
437             Usage : $members = $fam->members([$seq1,$seq1]);
438             Function: Deprecated. Use add_members() or get_members() instead
439              
440             =cut
441              
442             sub members{
443 0     0 1   my $self = shift;
444 0 0         if(@_) {
445             # this is in set mode
446 0           $self->warn("setting members() in ".ref($self)." is deprecated.\n".
447             "Use add_members() instead.");
448 0           return $self->add_members(@_);
449             } else {
450             # get mode
451 0           $self->warn("members() in ".ref($self)." is deprecated.\n".
452             "Use get_members() instead.");
453 0           return $self->get_members();
454             }
455             }
456              
457             1;