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