File Coverage

Bio/SeqFeature/Computation.pm
Criterion Covered Total %
statement 81 123 65.8
branch 34 68 50.0
condition 1 3 33.3
subroutine 15 21 71.4
pod 19 19 100.0
total 150 234 64.1


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::SeqFeature::Generic
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by mark Fiers
7             #
8             # Copyright Ewan Birney, Mark Fiers
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::SeqFeature::Computation - Computation SeqFeature
17              
18             =head1 SYNOPSIS
19              
20             $feat = Bio::SeqFeature::Computation->new(
21             -start => 10,
22             -end => 100,
23             -strand => -1,
24             -primary => 'repeat',
25             -program_name => 'GeneMark',
26             -program_date => '12-5-2000',
27             -program_version => 'x.y',
28             -database_name => 'Arabidopsis',
29             -database_date => '12-dec-2000',
30             -computation_id => 2231,
31             -score => { no_score => 334 }
32             );
33              
34             =head1 DESCRIPTION
35              
36             Bio::SeqFeature::Computation extends the Generic seqfeature object with
37             a set of computation related fields and a more flexible set of storing
38             more types of score and subseqfeatures. It is compatible with the Generic
39             SeqFeature object.
40              
41             The new way of storing score values is similar to the tag structure in the
42             Generic object. For storing sets of subseqfeatures the array containg the
43             subseqfeatures is now a hash which contains arrays of seqfeatures
44             Both the score and subSeqfeature methods can be called in exactly the same
45             way, the value's will be stored as a 'default' score or subseqfeature.
46              
47             =head1 FEEDBACK
48              
49             =head2 Mailing Lists
50              
51             User feedback is an integral part of the evolution of this and other
52             Bioperl modules. Send your comments and suggestions preferably to one
53             of the Bioperl mailing lists. Your participation is much appreciated.
54              
55             bioperl-l@bioperl.org - General discussion
56             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
57              
58             =head2 Support
59              
60             Please direct usage questions or support issues to the mailing list:
61              
62             I
63              
64             rather than to the module maintainer directly. Many experienced and
65             reponsive experts will be able look at the problem and quickly
66             address it. Please include a thorough description of the problem
67             with code and data examples if at all possible.
68              
69             =head2 Reporting Bugs
70              
71             Report bugs to the Bioperl bug tracking system to help us keep track
72             the bugs and their resolution. Bug reports can be submitted via the
73             web:
74              
75             https://github.com/bioperl/bioperl-live/issues
76              
77             =head1 AUTHOR - Ewan Birney, Mark Fiers
78              
79             Ewan Birney Ebirney@sanger.ac.ukE
80              
81             Mark Fiers Em.w.e.j.fiers@plant.wag-ur.nlE
82              
83             =head1 DEVELOPERS
84              
85             This class has been written with an eye out of inheritance. The fields
86             the actual object hash are:
87              
88             _gsf_sub_hash = reference to a hash containing sets of sub arrays
89             _gsf_score_hash= reference to a hash for the score values
90              
91             =head1 APPENDIX
92              
93             The rest of the documentation details each of the object
94             methods. Internal methods are usually preceded with a _
95              
96             =cut
97              
98             # Let the code begin...
99              
100             package Bio::SeqFeature::Computation;
101 1     1   485 use strict;
  1         1  
  1         24  
102              
103 1     1   2 use base qw(Bio::SeqFeature::Generic);
  1         1  
  1         344  
104              
105             sub new {
106 3     3 1 125 my ( $class, @args) = @_;
107            
108 3         14 my $self = $class->SUPER::new(@args);
109              
110              
111 3         11 my ( $computation_id, $program_name, $program_date, $program_version,
112             $database_name, $database_date, $database_version) =
113             $self->_rearrange([qw( COMPUTATION_ID
114             PROGRAM_NAME
115             PROGRAM_DATE
116             PROGRAM_VERSION
117             DATABASE_NAME
118             DATABASE_DATE
119             DATABASE_VERSION )],@args);
120              
121 3 100       10 $program_name && $self->program_name($program_name);
122 3 100       6 $program_date && $self->program_date($program_date);
123 3 100       6 $program_version && $self->program_version($program_version);
124 3 100       6 $database_name && $self->database_name($database_name);
125 3 100       6 $database_date && $self->database_date($database_date);
126 3 50       4 $database_version && $self->database_version($database_version);
127 3 100       5 $computation_id && $self->computation_id($computation_id);
128            
129 3         11 return $self;
130             }
131              
132             =head2 has_score
133              
134             Title : has_score
135             Usage : $value = $self->has_score('some_score')
136             Function: Tests wether a feature contains a score
137             Returns : TRUE if the SeqFeature has the score,
138             and FALSE otherwise.
139             Args : The name of a score
140              
141             =cut
142              
143             sub has_score {
144 0     0 1 0 my ($self, $score) = @_;
145 0 0       0 return unless defined $score;
146 0         0 return exists $self->{'_gsf_score_hash'}->{$score};
147             }
148              
149             =head2 add_score_value
150              
151             Title : add_score_value
152             Usage : $self->add_score_value('P_value',224);
153             Returns : TRUE on success
154             Args : score (string) and value (any scalar)
155              
156             =cut
157              
158             sub add_score_value {
159 3     3 1 5 my ($self, $score, $value) = @_;
160 3 50 33     11 if( ! defined $score || ! defined $value ) {
161 0         0 $self->warn("must specify a valid $score and $value to add_score_value");
162 0         0 return 0;
163             }
164              
165 3 50       7 if ( !defined $self->{'_gsf_score_hash'}->{$score} ) {
166 3         4 $self->{'_gsf_score_hash'}->{$score} = [];
167             }
168              
169 3         3 push(@{$self->{'_gsf_score_hash'}->{$score}},$value);
  3         10  
170             }
171              
172             =head2 score
173              
174             Title : score
175             Usage : $value = $comp_obj->score()
176             $comp_obj->score($value)
177             Function: Returns the 'default' score or sets the 'default' score
178             This method exist for compatibility options
179             It would equal ($comp_obj->each_score_value('default'))[0];
180             Returns : A value
181             Args : (optional) a new value for the 'default' score
182              
183             =cut
184              
185             sub score {
186 1     1 1 2 my ($self, $value) = @_;
187 1         1 my @v;
188 1 50       2 if (defined $value) {
189              
190 1 50       5 if( ref($value) =~ /HASH/i ) {
191 1         1 while( my ($t,$val) = each %{ $value } ) {
  2         8  
192 1         2 $self->add_score_value($t,$val);
193             }
194             } else {
195 0         0 @v = $value;
196 0         0 $self->add_score_value('default', $value);
197             }
198              
199             } else {
200 0         0 @v = $self->each_score_value('default');
201             }
202 1         2 return $v[0];
203             }
204              
205             =head2 each_score_value
206              
207             Title : each_score_value
208             Usage : @values = $gsf->each_score_value('note');
209             Function: Returns a list of all the values stored
210             under a particular score.
211             Returns : A list of scalars
212             Args : The name of the score
213              
214             =cut
215              
216             sub each_score_value {
217 1     1 1 2 my ($self, $score) = @_;
218 1 50       5 if ( ! exists $self->{'_gsf_score_hash'}->{$score} ) {
219 0         0 $self->warn("asking for score value that does not exist $score");
220 0         0 return;
221             }
222 1         1 return @{$self->{'_gsf_score_hash'}->{$score}};
  1         4  
223             }
224              
225              
226             =head2 all_scores
227              
228             Title : all_scores
229             Usage : @scores = $feat->all_scores()
230             Function: Get a list of all the scores in a feature
231             Returns : An array of score names
232             Args : none
233              
234              
235             =cut
236              
237             sub all_scores {
238 0     0 1 0 my ($self, @args) = @_;
239              
240 0         0 return keys %{$self->{'_gsf_score_hash'}};
  0         0  
241             }
242              
243              
244             =head2 remove_score
245              
246             Title : remove_score
247             Usage : $feat->remove_score('some_score')
248             Function: removes a score from this feature
249             Returns : nothing
250             Args : score (string)
251              
252              
253             =cut
254              
255             sub remove_score {
256 0     0 1 0 my ($self, $score) = @_;
257              
258 0 0       0 if ( ! exists $self->{'_gsf_score_hash'}->{$score} ) {
259 0         0 $self->warn("trying to remove a score that does not exist: $score");
260             }
261              
262 0         0 delete $self->{'_gsf_score_hash'}->{$score};
263             }
264              
265             =head2 computation_id
266              
267             Title : computation_id
268             Usage : $computation_id = $feat->computation_id()
269             $feat->computation_id($computation_id)
270             Function: get/set on program name information
271             Returns : string
272             Args : none if get, the new value if set
273              
274              
275             =cut
276              
277             sub computation_id {
278 3     3 1 3 my ($self,$value) = @_;
279              
280 3 100       19 if (defined($value)) {
281 2         4 $self->{'_gsf_computation_id'} = $value;
282             }
283              
284 3         8 return $self->{'_gsf_computation_id'};
285             }
286              
287              
288              
289              
290             =head2 program_name
291              
292             Title : program_name
293             Usage : $program_name = $feat->program_name()
294             $feat->program_name($program_name)
295             Function: get/set on program name information
296             Returns : string
297             Args : none if get, the new value if set
298              
299              
300             =cut
301              
302             sub program_name {
303 1     1 1 2 my ($self,$value) = @_;
304              
305 1 50       3 if (defined($value)) {
306 1         3 $self->{'_gsf_program_name'} = $value;
307             }
308              
309 1         1 return $self->{'_gsf_program_name'};
310             }
311              
312             =head2 program_date
313              
314             Title : program_date
315             Usage : $program_date = $feat->program_date()
316             $feat->program_date($program_date)
317             Function: get/set on program date information
318             Returns : date (string)
319             Args : none if get, the new value if set
320              
321              
322             =cut
323              
324             sub program_date {
325 1     1 1 2 my ($self,$value) = @_;
326              
327 1 50       2 if (defined($value)) {
328 1         2 $self->{'_gsf_program_date'} = $value;
329             }
330              
331 1         2 return $self->{'_gsf_program_date'};
332             }
333              
334              
335             =head2 program_version
336              
337             Title : program_version
338             Usage : $program_version = $feat->program_version()
339             $feat->program_version($program_version)
340             Function: get/set on program version information
341             Returns : date (string)
342             Args : none if get, the new value if set
343              
344              
345             =cut
346              
347             sub program_version {
348 1     1 1 2 my ($self,$value) = @_;
349              
350 1 50       3 if (defined($value)) {
351 1         2 $self->{'_gsf_program_version'} = $value;
352             }
353              
354 1         1 return $self->{'_gsf_program_version'};
355             }
356              
357             =head2 database_name
358              
359             Title : database_name
360             Usage : $database_name = $feat->database_name()
361             $feat->database_name($database_name)
362             Function: get/set on program name information
363             Returns : string
364             Args : none if get, the new value if set
365              
366             =cut
367              
368             sub database_name {
369 1     1 1 1 my ($self,$value) = @_;
370              
371 1 50       3 if (defined($value)) {
372 1         2 $self->{'_gsf_database_name'} = $value;
373             }
374              
375 1         1 return $self->{'_gsf_database_name'};
376             }
377              
378             =head2 database_date
379              
380             Title : database_date
381             Usage : $database_date = $feat->database_date()
382             $feat->database_date($database_date)
383             Function: get/set on program date information
384             Returns : date (string)
385             Args : none if get, the new value if set
386              
387              
388             =cut
389              
390             sub database_date {
391 1     1 1 1 my ($self,$value) = @_;
392              
393 1 50       3 if (defined($value)) {
394 1         2 $self->{'_gsf_database_date'} = $value;
395             }
396              
397 1         1 return $self->{'_gsf_database_date'};
398             }
399              
400              
401             =head2 database_version
402              
403             Title : database_version
404             Usage : $database_version = $feat->database_version()
405             $feat->database_version($database_version)
406             Function: get/set on program version information
407             Returns : date (string)
408             Args : none if get, the new value if set
409              
410              
411             =cut
412              
413             sub database_version {
414 0     0 1 0 my ($self,$value) = @_;
415              
416 0 0       0 if (defined($value)) {
417 0         0 $self->{'_gsf_database_version'} = $value;
418             }
419              
420 0         0 return $self->{'_gsf_database_version'};
421              
422             }
423              
424             =head2 get_SeqFeature_type
425              
426             Title : get_SeqFeature_type
427             Usage : $SeqFeature_type = $feat->get_SeqFeature_type()
428             $feat->get_SeqFeature_type($SeqFeature_type)
429             Function: Get SeqFeature type which is automatically set when adding
430             a computation (SeqFeature) to a computation object
431             Returns : SeqFeature_type (string)
432             Args : none if get, the new value if set
433              
434             =cut
435              
436             sub get_SeqFeature_type {
437 1     1 1 1 my ($self, $value) = @_;
438              
439 1 50       2 if (defined($value)) {
440 1         2 $self->{'_gsf_sub_SeqFeature_type'} = $value;
441             }
442 1         1 return $self->{'_gsf_sub_SeqFeature_type'};
443             }
444              
445             =head2 get_all_SeqFeature_types
446              
447             Title : get_all_SeqFeature_types
448             Usage : @all_SeqFeature_types = $comp->get_all_SeqFeature_types();
449             Function: Returns an array with all subseqfeature types
450             Returns : An array
451             Args : none
452              
453             =cut
454              
455             sub get_all_SeqFeature_types {
456 1     1 1 1 my ($self) = @_;
457 1         2 return keys ( %{$self->{'gsf_sub_hash'}} );
  1         5  
458             }
459              
460             =head2 get_SeqFeatures
461              
462             Title : get_SeqFeatures('feature_type')
463             Usage : @feats = $feat->get_SeqFeatures();
464             @feats = $feat->get_SeqFeatures('feature_type');
465             Function: Returns an array of sub Sequence Features of a specific
466             type or, if the type is ommited, all sub Sequence Features
467             Returns : An array
468             Args : (optional) a SeqFeature type (ie exon, pattern)
469              
470             =cut
471              
472             sub get_SeqFeatures {
473 0     0 1 0 my ($self, $ssf_type) = @_;
474 0         0 my (@return_array) = ();
475 0 0       0 if ($ssf_type eq '') {
476             #return all SeqFeatures
477 0         0 foreach (keys ( %{$self->{'gsf_sub_hash'}} )){
  0         0  
478 0         0 push @return_array, @{$self->{'gsf_sub_hash'}->{$_}};
  0         0  
479             }
480 0         0 return @return_array;
481             } else {
482 0 0       0 if (defined ($self->{'gsf_sub_hash'}->{$ssf_type})) {
483 0         0 return @{$self->{'gsf_sub_hash'}->{$ssf_type}};
  0         0  
484             } else {
485 0         0 $self->warn("$ssf_type is not a valid sub SeqFeature type");
486             }
487             }
488             }
489              
490             =head2 add_SeqFeature
491              
492             Title : add_SeqFeature
493             Usage : $feat->add_SeqFeature($subfeat);
494             $feat->add_SeqFeature($subfeat,'seqfeature_type')
495             $feat->add_SeqFeature($subfeat,'EXPAND')
496             $feat->add_SeqFeature($subfeat,'EXPAND','seqfeature_type')
497             Function: adds a SeqFeature into a specific subSeqFeature array.
498             with no 'EXPAND' qualifer, subfeat will be tested
499             as to whether it lies inside the parent, and throw
500             an exception if not.
501             If EXPAND is used, the parents start/end/strand will
502             be adjusted so that it grows to accommodate the new
503             subFeature,
504             optionally a seqfeature type can be defined.
505             Returns : nothing
506             Args : An object which has the SeqFeatureI interface
507             (optional) 'EXPAND'
508             (optional) 'SeqFeature_type'
509              
510             =cut
511              
512             sub add_SeqFeature{
513 1     1 1 2 my ($self,$feat,$var1, $var2) = @_;
514 1 50       4 $var1 = '' unless( defined $var1);
515 1 50       2 $var2 = '' unless( defined $var2);
516 1         3 my ($expand, $ssf_type) = ('', $var1 . $var2);
517 1 50       3 $expand = 'EXPAND' if ($ssf_type =~ s/EXPAND//);
518              
519 1 50       9 if ( !$feat->isa('Bio::SeqFeatureI') ) {
520 0         0 $self->warn("$feat does not implement Bio::SeqFeatureI. Will add it anyway, but beware...");
521             }
522              
523 1 50       3 if($expand eq 'EXPAND') {
524 0         0 $self->_expand_region($feat);
525             } else {
526 1 50       7 if ( !$self->contains($feat) ) {
527 0         0 $self->throw("$feat is not contained within parent feature, and expansion is not valid");
528             }
529             }
530              
531 1 50       3 $ssf_type = 'default' if ($ssf_type eq '');
532            
533 1 50       5 if (!(defined ($self->{'gsf_sub_hash'}->{$ssf_type}))) {
534 1         1 @{$self->{'gsf_sub_hash'}->{$ssf_type}} = ();
  1         2  
535             }
536 1         4 $feat->get_SeqFeature_type($ssf_type);
537 1         1 push @{$self->{'gsf_sub_hash'}->{$ssf_type}}, $feat;
  1         4  
538             }
539              
540             =head2 remove_SeqFeatures
541              
542             Title : remove_SeqFeatures
543             Usage : $sf->remove_SeqFeatures
544             $sf->remove_SeqFeatures('SeqFeature_type');
545             Function: Removes all sub SeqFeature or all sub SeqFeatures of a specified type
546             (if you want to remove a more specific subset, take an array of them
547             all, flush them, and add back only the guys you want)
548             Example :
549             Returns : none
550             Args : none
551              
552              
553             =cut
554              
555             sub remove_SeqFeatures {
556 0     0 1   my ($self, $ssf_type) = @_;
557 0 0         if ($ssf_type) {
558 0 0         if ((defined ($self->{'gsf_sub_hash'}->{$ssf_type}))) {
559 0           delete $self->{'gsf_sub_hash'}->{$ssf_type};
560             } else {
561 0           $self->warn("$ssf_type is not a valid sub SeqFeature type");
562             }
563             } else {
564 0           $self->{'_gsf_sub_hash'} = {}; # zap the complete hash implicitly.
565             }
566             }
567              
568              
569             # Aliases to better match Bio::SeqFeature function names
570             *sub_SeqFeature_type = \&get_SeqFeature_type;
571             *all_sub_SeqFeature_types = \&get_all_SeqFeature_types;
572             *sub_SeqFeature = \&get_SeqFeatures;
573             *add_sub_SeqFeature = \&add_SeqFeature;
574             *flush_sub_SeqFeatures = \&remove_SeqFeatures;
575             *flush_sub_SeqFeature = \&remove_SeqFeatures;
576              
577             1;