|
0
|
1 # $Id: Result.pm,v 1.5.2.1 2003/02/20 05:11:45 heikki Exp $
|
|
|
2 #
|
|
|
3 # bioperl module for Bio::Coordinate::Result
|
|
|
4 #
|
|
|
5 # Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk>
|
|
|
6 #
|
|
|
7 # Copyright Heikki Lehvaslaiho
|
|
|
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::Coordinate::Result - Results from coordinate transformation
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 use Bio::Coordinate::Result;
|
|
|
20
|
|
|
21 #get results from a Bio::Coordinate::MapperI
|
|
|
22 $matched = $result->each_match;
|
|
|
23
|
|
|
24 =head1 DESCRIPTION
|
|
|
25
|
|
|
26 The results from Bio::Coordinate::MapperI are kept in an object which
|
|
|
27 itself is a split location, See L<Bio::Location::Split>. The results
|
|
|
28 are either Matches or Gaps. See L<Bio::Coordinate::Result::Match> and
|
|
|
29 L<Bio::Coordinate::Result::Match>.
|
|
|
30
|
|
|
31 If only one Match is returned, there is a convenience method of
|
|
|
32 retrieving it or accessing its methods. Same holds true for a Gap.
|
|
|
33
|
|
|
34 =head1 FEEDBACK
|
|
|
35
|
|
|
36 =head2 Mailing Lists
|
|
|
37
|
|
|
38 User feedback is an integral part of the evolution of this and other
|
|
|
39 Bioperl modules. Send your comments and suggestions preferably to the
|
|
|
40 Bioperl mailing lists Your participation is much appreciated.
|
|
|
41
|
|
|
42 bioperl-l@bioperl.org - General discussion
|
|
|
43 http://bio.perl.org/MailList.html - About the mailing lists
|
|
|
44
|
|
|
45 =head2 Reporting Bugs
|
|
|
46
|
|
|
47 report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
48 the bugs and their resolution. Bug reports can be submitted via
|
|
|
49 email or the web:
|
|
|
50
|
|
|
51 bioperl-bugs@bio.perl.org
|
|
|
52 http://bugzilla.bioperl.org/
|
|
|
53
|
|
|
54 =head1 AUTHOR - Heikki Lehvaslaiho
|
|
|
55
|
|
|
56 Email: heikki@ebi.ac.uk
|
|
|
57 Address:
|
|
|
58
|
|
|
59 EMBL Outstation, European Bioinformatics Institute
|
|
|
60 Wellcome Trust Genome Campus, Hinxton
|
|
|
61 Cambs. CB10 1SD, United Kingdom
|
|
|
62
|
|
|
63 =head1 CONTRIBUTORS
|
|
|
64
|
|
|
65 Additional contributors names and emails here
|
|
|
66
|
|
|
67 =head1 APPENDIX
|
|
|
68
|
|
|
69 The rest of the documentation details each of the object
|
|
|
70 methods. Internal methods are usually preceded with a _
|
|
|
71
|
|
|
72 =cut
|
|
|
73
|
|
|
74
|
|
|
75 # Let the code begin...
|
|
|
76
|
|
|
77 package Bio::Coordinate::Result;
|
|
|
78 use vars qw(@ISA );
|
|
|
79 use strict;
|
|
|
80
|
|
|
81 use Bio::Location::Split;
|
|
|
82 use Bio::Coordinate::ResultI;
|
|
|
83
|
|
|
84 @ISA = qw(Bio::Location::Split Bio::Coordinate::ResultI);
|
|
|
85
|
|
|
86
|
|
|
87 =head2 add_location
|
|
|
88
|
|
|
89 Title : add_sub_Location
|
|
|
90 Usage : $obj->add_sub_Location($variant)
|
|
|
91 Function:
|
|
|
92
|
|
|
93 Pushes one Bio::LocationI into the list of variants.
|
|
|
94
|
|
|
95 Example :
|
|
|
96 Returns : 1 when succeeds
|
|
|
97 Args : Location object
|
|
|
98
|
|
|
99 =cut
|
|
|
100
|
|
|
101 sub add_sub_Location {
|
|
|
102 my ($self,$value) = @_;
|
|
|
103 $self->throw("Is not a Bio::LocationI but [$value]")
|
|
|
104 unless $value->isa('Bio::LocationI');
|
|
|
105
|
|
|
106 $self->{'_match'} = $value
|
|
|
107 if $value->isa('Bio::Coordinate::Result::Match');
|
|
|
108
|
|
|
109 $self->{'_gap'} = $value
|
|
|
110 if $value->isa('Bio::Coordinate::Result::Gap');
|
|
|
111
|
|
|
112 $self->SUPER::add_sub_Location($value);
|
|
|
113
|
|
|
114 }
|
|
|
115
|
|
|
116 =head2 add_result
|
|
|
117
|
|
|
118 Title : add_result
|
|
|
119 Usage : $obj->add_result($result)
|
|
|
120 Function: Adds the contents of one Bio::Coordinate::Result
|
|
|
121 Example :
|
|
|
122 Returns : 1 when succeeds
|
|
|
123 Args : Result object
|
|
|
124
|
|
|
125 =cut
|
|
|
126
|
|
|
127 sub add_result {
|
|
|
128 my ($self,$value) = @_;
|
|
|
129
|
|
|
130 $self->throw("Is not a Bio::Coordinate::Result but [$value]")
|
|
|
131 unless $value->isa('Bio::Coordinate::Result');
|
|
|
132
|
|
|
133 map { $self->add_sub_Location($_);} $value->each_Location;
|
|
|
134
|
|
|
135 }
|
|
|
136
|
|
|
137 =head2 seq_id
|
|
|
138
|
|
|
139 Title : seq_id
|
|
|
140 Usage : my $seqid = $location->seq_id();
|
|
|
141 Function: Get/Set seq_id that location refers to
|
|
|
142
|
|
|
143 We override this here in order to propagate to all sublocations
|
|
|
144 which are not remote (provided this root is not remote either)
|
|
|
145
|
|
|
146 Returns : seq_id
|
|
|
147 Args : [optional] seq_id value to set
|
|
|
148
|
|
|
149
|
|
|
150 =cut
|
|
|
151
|
|
|
152 sub seq_id {
|
|
|
153 my ($self, $seqid) = @_;
|
|
|
154
|
|
|
155 my @ls = $self->each_Location;
|
|
|
156 if (@ls) {
|
|
|
157 return $ls[0]->seq_id;
|
|
|
158 } else {
|
|
|
159 return undef;
|
|
|
160 }
|
|
|
161
|
|
|
162 }
|
|
|
163
|
|
|
164
|
|
|
165 =head2 Convenience methods
|
|
|
166
|
|
|
167 These methods are shortcuts to Match and Gap locations.
|
|
|
168
|
|
|
169 =cut
|
|
|
170
|
|
|
171 =head2 each_gap
|
|
|
172
|
|
|
173 Title : each_gap
|
|
|
174 Usage : $obj->each_gap();
|
|
|
175 Function:
|
|
|
176
|
|
|
177 Returns a list of Bio::Coordianate::Result::Gap objects.
|
|
|
178
|
|
|
179 Returns : list of gaps
|
|
|
180 Args : none
|
|
|
181
|
|
|
182 =cut
|
|
|
183
|
|
|
184 sub each_gap{
|
|
|
185 my ($self) = @_;
|
|
|
186
|
|
|
187
|
|
|
188 my @gaps;
|
|
|
189 foreach my $gap ($self->each_Location) {
|
|
|
190 push @gaps, $gap if $gap->isa('Bio::Coordinate::Result::Gap');
|
|
|
191 }
|
|
|
192 return @gaps;
|
|
|
193
|
|
|
194 }
|
|
|
195
|
|
|
196
|
|
|
197 =head2 each_match
|
|
|
198
|
|
|
199 Title : each_match
|
|
|
200 Usage : $obj->each_match();
|
|
|
201 Function:
|
|
|
202
|
|
|
203 Returns a list of Bio::Coordinate::Result::Match objects.
|
|
|
204
|
|
|
205 Returns : list of Matchs
|
|
|
206 Args : none
|
|
|
207
|
|
|
208 =cut
|
|
|
209
|
|
|
210 sub each_match {
|
|
|
211 my ($self) = @_;
|
|
|
212
|
|
|
213 my @matches;
|
|
|
214 foreach my $match ($self->each_Location) {
|
|
|
215 push @matches, $match if $match->isa('Bio::Coordinate::Result::Match');
|
|
|
216 }
|
|
|
217 return @matches;
|
|
|
218 }
|
|
|
219
|
|
|
220 =head2 match
|
|
|
221
|
|
|
222 Title : match
|
|
|
223 Usage : $match_object = $obj->match(); #or
|
|
|
224 $gstart = $obj->gap->start;
|
|
|
225 Function: Read only method for retrieving or accessing the match object.
|
|
|
226 Returns : one Bio::Coordinate::Result::Match
|
|
|
227 Args :
|
|
|
228
|
|
|
229 =cut
|
|
|
230
|
|
|
231 sub match {
|
|
|
232 my ($self) = @_;
|
|
|
233
|
|
|
234 $self->warn("More than one match in results")
|
|
|
235 if $self->each_match > 1 and $self->verbose > 0;
|
|
|
236 unless (defined $self->{'_match'} ) {
|
|
|
237 my @m = $self->each_match;
|
|
|
238 $self->{'_match'} = $m[-1];
|
|
|
239 }
|
|
|
240 return $self->{'_match'};
|
|
|
241 }
|
|
|
242
|
|
|
243 =head2 gap
|
|
|
244
|
|
|
245 Title : gap
|
|
|
246 Usage : $gap_object = $obj->gap(); #or
|
|
|
247 $gstart = $obj->gap->start;
|
|
|
248 Function: Read only method for retrieving or accessing the gap object.
|
|
|
249 Returns : one Bio::Coordinate::Result::Gap
|
|
|
250 Args :
|
|
|
251
|
|
|
252 =cut
|
|
|
253
|
|
|
254 sub gap {
|
|
|
255 my ($self) = @_;
|
|
|
256
|
|
|
257 $self->warn("More than one gap in results")
|
|
|
258 if $self->each_gap > 1 and $self->verbose > 0;
|
|
|
259 unless (defined $self->{'_gap'} ) {
|
|
|
260 my @m = $self->each_gap;
|
|
|
261 $self->{'_gap'} = $m[-1];
|
|
|
262 }
|
|
|
263 return $self->{'_gap'};
|
|
|
264 }
|
|
|
265
|
|
|
266
|
|
|
267 =head2 purge_gaps
|
|
|
268
|
|
|
269 Title : purge_gaps
|
|
|
270 Usage : $gap_count = $obj->purge_gaps;
|
|
|
271 Function: remove all gaps from the Result
|
|
|
272 Returns : count of removed gaps
|
|
|
273 Args :
|
|
|
274
|
|
|
275 =cut
|
|
|
276
|
|
|
277 sub purge_gaps {
|
|
|
278 my ($self) = @_;
|
|
|
279 my @matches;
|
|
|
280 my $count = 0;
|
|
|
281
|
|
|
282 foreach my $loc ($self->each_Location) {
|
|
|
283 if ($loc->isa('Bio::Coordinate::Result::Match')) {
|
|
|
284 push @matches, $loc;
|
|
|
285 } else {
|
|
|
286 $count++
|
|
|
287 }
|
|
|
288 }
|
|
|
289 @{$self->{'_sublocations'}} = ();
|
|
|
290 delete $self->{'_gap'} ;
|
|
|
291 push @{$self->{'_sublocations'}}, @matches;
|
|
|
292 return $count;
|
|
|
293 }
|
|
|
294
|
|
|
295
|
|
|
296 1;
|
