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