Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/Location/Simple.pm @ 0:1f6dce3d34e0
Uploaded
author | mahtabm |
---|---|
date | Thu, 11 Apr 2013 02:01:53 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:1f6dce3d34e0 |
---|---|
1 # $Id: Simple.pm,v 1.31 2002/10/22 07:38:35 lapp Exp $ | |
2 # | |
3 # BioPerl module for Bio::Location::Simple | |
4 # Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk> | |
5 # | |
6 # Copyright Heikki Lehvaslaiho | |
7 # | |
8 # You may distribute this module under the same terms as perl itself | |
9 # POD documentation - main docs before the code | |
10 | |
11 =head1 NAME | |
12 | |
13 Bio::Location::Simple - Implementation of a Simple Location on a Sequence | |
14 | |
15 =head1 SYNOPSIS | |
16 | |
17 use Bio::Location::Simple; | |
18 | |
19 my $location = new Bio::Location::Simple(-start => 1, -end => 100, | |
20 -strand => 1 ); | |
21 | |
22 if( $location->strand == -1 ) { | |
23 printf "complement(%d..%d)\n", $location->start, $location->end; | |
24 } else { | |
25 printf "%d..%d\n", $location->start, $location->end; | |
26 } | |
27 | |
28 =head1 DESCRIPTION | |
29 | |
30 This is an implementation of Bio::LocationI to manage exact location | |
31 information on a Sequence: '22' or '12..15' or '16^17'. | |
32 | |
33 You can test the type of the location using lenght() function () or | |
34 directly location_type() which can one of two values: 'EXACT' or | |
35 'IN-BETWEEN'. | |
36 | |
37 | |
38 =head1 FEEDBACK | |
39 | |
40 User feedback is an integral part of the evolution of this and other | |
41 Bioperl modules. Send your comments and suggestions preferably to one | |
42 of the Bioperl mailing lists. Your participation is much appreciated. | |
43 | |
44 bioperl-l@bioperl.org - General discussion | |
45 http://bio.perl.org/MailList.html - About the mailing lists | |
46 | |
47 =head2 Reporting Bugs | |
48 | |
49 Report bugs to the Bioperl bug tracking system to help us keep track | |
50 the bugs and their resolution. Bug reports can be submitted via email | |
51 or the web: | |
52 | |
53 bioperl-bugs@bio.perl.org | |
54 http://bugzilla.bioperl.org/ | |
55 | |
56 =head1 AUTHOR - Heikki Lehvaslaiho | |
57 | |
58 Email heikki@ebi.ac.uk | |
59 | |
60 =head1 APPENDIX | |
61 | |
62 The rest of the documentation details each of the object | |
63 methods. Internal methods are usually preceded with a _ | |
64 | |
65 =cut | |
66 | |
67 # Let the code begin... | |
68 | |
69 | |
70 package Bio::Location::Simple; | |
71 use vars qw(@ISA); | |
72 use strict; | |
73 | |
74 use Bio::Root::Root; | |
75 use Bio::Location::Atomic; | |
76 | |
77 | |
78 @ISA = qw( Bio::Location::Atomic ); | |
79 | |
80 BEGIN { | |
81 use vars qw( %RANGEENCODE %RANGEDECODE ); | |
82 | |
83 %RANGEENCODE = ('\.\.' => 'EXACT', | |
84 '\^' => 'IN-BETWEEN' ); | |
85 | |
86 %RANGEDECODE = ('EXACT' => '..', | |
87 'IN-BETWEEN' => '^' ); | |
88 | |
89 } | |
90 | |
91 sub new { | |
92 my ($class, @args) = @_; | |
93 my $self = $class->SUPER::new(@args); | |
94 | |
95 my ($locationtype) = $self->_rearrange([qw(LOCATION_TYPE)],@args); | |
96 | |
97 $locationtype && $self->location_type($locationtype); | |
98 | |
99 return $self; | |
100 } | |
101 | |
102 =head2 start | |
103 | |
104 Title : start | |
105 Usage : $start = $loc->start(); | |
106 Function: get/set the start of this range | |
107 Returns : the start of this range | |
108 Args : optionaly allows the start to be set | |
109 : using $loc->start($start) | |
110 | |
111 =cut | |
112 | |
113 sub start { | |
114 my ($self, $value) = @_; | |
115 | |
116 $self->{'_start'} = $value if defined $value ; | |
117 | |
118 $self->throw("Only adjacent residues when location type ". | |
119 "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [". | |
120 $self->{'_end'}. "]" ) | |
121 if defined $self->{'_start'} && defined $self->{'_end'} && | |
122 $self->location_type eq 'IN-BETWEEN' && | |
123 ($self->{'_end'} - 1 != $self->{'_start'}); | |
124 return $self->{'_start'}; | |
125 } | |
126 | |
127 | |
128 =head2 end | |
129 | |
130 Title : end | |
131 Usage : $end = $loc->end(); | |
132 Function: get/set the end of this range | |
133 Returns : the end of this range | |
134 Args : optionaly allows the end to be set | |
135 : using $loc->end($start) | |
136 | |
137 =cut | |
138 | |
139 sub end { | |
140 my ($self, $value) = @_; | |
141 | |
142 $self->{'_end'} = $value if defined $value ; | |
143 $self->throw("Only adjacent residues when location type ". | |
144 "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [". | |
145 $self->{'_end'}. "]" ) | |
146 if defined $self->{'_start'} && defined $self->{'_end'} && | |
147 $self->location_type eq 'IN-BETWEEN' && | |
148 ($self->{'_end'} - 1 != $self->{'_start'}); | |
149 | |
150 return $self->{'_end'}; | |
151 } | |
152 | |
153 =head2 strand | |
154 | |
155 Title : strand | |
156 Usage : $strand = $loc->strand(); | |
157 Function: get/set the strand of this range | |
158 Returns : the strandidness (-1, 0, +1) | |
159 Args : optionaly allows the strand to be set | |
160 : using $loc->strand($strand) | |
161 | |
162 =cut | |
163 | |
164 =head2 length | |
165 | |
166 Title : length | |
167 Usage : $len = $loc->length(); | |
168 Function: get the length in the coordinate space this location spans | |
169 Example : | |
170 Returns : an integer | |
171 Args : none | |
172 | |
173 | |
174 =cut | |
175 | |
176 sub length { | |
177 my ($self) = @_; | |
178 if ($self->location_type eq 'IN-BETWEEN' ) { | |
179 return 0; | |
180 } else { | |
181 return abs($self->end - $self->start) + 1; | |
182 } | |
183 | |
184 } | |
185 | |
186 =head2 min_start | |
187 | |
188 Title : min_start | |
189 Usage : my $minstart = $location->min_start(); | |
190 Function: Get minimum starting location of feature startpoint | |
191 Returns : integer or undef if no minimum starting point. | |
192 Args : none | |
193 | |
194 =cut | |
195 | |
196 =head2 max_start | |
197 | |
198 Title : max_start | |
199 Usage : my $maxstart = $location->max_start(); | |
200 Function: Get maximum starting location of feature startpoint. | |
201 | |
202 In this implementation this is exactly the same as min_start(). | |
203 | |
204 Returns : integer or undef if no maximum starting point. | |
205 Args : none | |
206 | |
207 =cut | |
208 | |
209 =head2 start_pos_type | |
210 | |
211 Title : start_pos_type | |
212 Usage : my $start_pos_type = $location->start_pos_type(); | |
213 Function: Get start position type (ie <,>, ^). | |
214 | |
215 Returns : type of position coded as text | |
216 ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN', 'IN-BETWEEN') | |
217 Args : none | |
218 | |
219 =cut | |
220 | |
221 =head2 min_end | |
222 | |
223 Title : min_end | |
224 Usage : my $minend = $location->min_end(); | |
225 Function: Get minimum ending location of feature endpoint | |
226 Returns : integer or undef if no minimum ending point. | |
227 Args : none | |
228 | |
229 =cut | |
230 | |
231 | |
232 =head2 max_end | |
233 | |
234 Title : max_end | |
235 Usage : my $maxend = $location->max_end(); | |
236 Function: Get maximum ending location of feature endpoint | |
237 | |
238 In this implementation this is exactly the same as min_end(). | |
239 | |
240 Returns : integer or undef if no maximum ending point. | |
241 Args : none | |
242 | |
243 =cut | |
244 | |
245 =head2 end_pos_type | |
246 | |
247 Title : end_pos_type | |
248 Usage : my $end_pos_type = $location->end_pos_type(); | |
249 Function: Get end position type (ie <,>, ^) | |
250 | |
251 Returns : type of position coded as text | |
252 ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN', 'IN-BETWEEN') | |
253 Args : none | |
254 | |
255 =cut | |
256 | |
257 =head2 location_type | |
258 | |
259 Title : location_type | |
260 Usage : my $location_type = $location->location_type(); | |
261 Function: Get location type encoded as text | |
262 Returns : string ('EXACT' or 'IN-BETWEEN') | |
263 Args : 'EXACT' or '..' or 'IN-BETWEEN' or '^' | |
264 | |
265 =cut | |
266 | |
267 sub location_type { | |
268 my ($self, $value) = @_; | |
269 | |
270 if( defined $value || ! defined $self->{'_location_type'} ) { | |
271 $value = 'EXACT' unless defined $value; | |
272 $value = uc $value; | |
273 if (! defined $RANGEDECODE{$value}) { | |
274 $value = '\^' if $value eq '^'; | |
275 $value = '\.\.' if $value eq '..'; | |
276 $value = $RANGEENCODE{$value}; | |
277 } | |
278 $self->throw("Did not specify a valid location type. [$value] is no good") | |
279 unless defined $value; | |
280 $self->{'_location_type'} = $value; | |
281 } | |
282 $self->throw("Only adjacent residues when location type ". | |
283 "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [". | |
284 $self->{'_end'}. "]" ) | |
285 if $self->{'_location_type'} eq 'IN-BETWEEN' && | |
286 defined $self->{'_start'} && | |
287 defined $self->{'_end'} && | |
288 ($self->{'_end'} - 1 != $self->{'_start'}); | |
289 | |
290 return $self->{'_location_type'}; | |
291 } | |
292 | |
293 =head2 is_remote | |
294 | |
295 Title : is_remote | |
296 Usage : $self->is_remote($newval) | |
297 Function: Getset for is_remote value | |
298 Returns : value of is_remote | |
299 Args : newvalue (optional) | |
300 | |
301 | |
302 =cut | |
303 | |
304 =head2 to_FTstring | |
305 | |
306 Title : to_FTstring | |
307 Usage : my $locstr = $location->to_FTstring() | |
308 Function: returns the FeatureTable string of this location | |
309 Returns : string | |
310 Args : none | |
311 | |
312 =cut | |
313 | |
314 sub to_FTstring { | |
315 my($self) = @_; | |
316 | |
317 my $str; | |
318 if( $self->start == $self->end ) { | |
319 return $self->start; | |
320 } | |
321 $str = $self->start . $RANGEDECODE{$self->location_type} . $self->end; | |
322 if($self->is_remote() && $self->seq_id()) { | |
323 $str = $self->seq_id() . ":" . $str; | |
324 } | |
325 if( $self->strand == -1 ) { | |
326 $str = "complement(".$str.")"; | |
327 } | |
328 return $str; | |
329 } | |
330 | |
331 # | |
332 # not tested | |
333 # | |
334 sub trunc { | |
335 my ($self,$start,$end,$relative_ori) = @_; | |
336 | |
337 my $newstart = $self->start - $start+1; | |
338 my $newend = $self->end - $start+1; | |
339 my $newstrand = $relative_ori * $self->strand; | |
340 | |
341 my $out; | |
342 if( $newstart < 1 || $newend > ($end-$start+1) ) { | |
343 $out = Bio::Location::Simple->new(); | |
344 $out->start($self->start); | |
345 $out->end($self->end); | |
346 $out->strand($self->strand); | |
347 $out->seq_id($self->seqid); | |
348 $out->is_remote(1); | |
349 } else { | |
350 $out = Bio::Location::Simple->new(); | |
351 $out->start($newstart); | |
352 $out->end($newend); | |
353 $out->strand($newstrand); | |
354 $out->seq_id(); | |
355 } | |
356 | |
357 return $out; | |
358 } | |
359 | |
360 1; | |
361 |