~ubuntu-branches/ubuntu/lucid/bioperl/lucid

« back to all changes in this revision

Viewing changes to Bio/Location/Simple.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matt Hope
  • Date: 2004-04-18 14:24:11 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040418142411-gr92uexquw4w8liq
Tags: 1.4-1
* New upstream release
* Examples and working code are installed by default to usr/bin,
  this has been moved to usr/share/doc/bioperl/bin

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
# $Id: Simple.pm,v 1.20 2002/03/08 20:00:00 jason Exp $
 
1
# $Id: Simple.pm,v 1.35 2003/12/18 13:15:20 jason Exp $
2
2
#
3
3
# BioPerl module for Bio::Location::Simple
4
 
# Cared for by Jason Stajich <jason@chg.mc.duke.edu>
 
4
# Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk>
5
5
#
6
 
# Copyright Jason Stajich
 
6
# Copyright Heikki Lehvaslaiho
7
7
#
8
8
# You may distribute this module under the same terms as perl itself
9
9
# POD documentation - main docs before the code
27
27
 
28
28
=head1 DESCRIPTION
29
29
 
30
 
This is an implementation of Bio::LocationI to manage simple location
31
 
information on a Sequence.
 
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
 
32
37
 
33
38
=head1 FEEDBACK
34
39
 
46
51
or the web:
47
52
 
48
53
  bioperl-bugs@bio.perl.org
49
 
  http://bio.perl.org/bioperl-bugs/
50
 
 
51
 
=head1 AUTHOR - Jason Stajich
52
 
 
53
 
Email jason@chg.mc.duke.edu
 
54
  http://bugzilla.bioperl.org/
 
55
 
 
56
=head1 AUTHOR - Heikki Lehvaslaiho
 
57
 
 
58
Email heikki@ebi.ac.uk
54
59
 
55
60
=head1 APPENDIX
56
61
 
66
71
use vars qw(@ISA);
67
72
use strict;
68
73
 
69
 
use Bio::Root::Root;
70
 
use Bio::LocationI;
71
 
 
72
 
 
73
 
@ISA = qw(Bio::Root::Root Bio::LocationI);
 
74
use Bio::Location::Atomic;
 
75
 
 
76
@ISA = qw( Bio::Location::Atomic );
 
77
 
 
78
BEGIN {
 
79
    use vars qw(  %RANGEENCODE  %RANGEDECODE  );
 
80
 
 
81
    %RANGEENCODE  = ('\.\.' => 'EXACT',
 
82
                     '\^' => 'IN-BETWEEN' );
 
83
 
 
84
    %RANGEDECODE  = ('EXACT' => '..',
 
85
                     'IN-BETWEEN' => '^' );
 
86
 
 
87
}
74
88
 
75
89
sub new { 
76
90
    my ($class, @args) = @_;
77
 
    my $self = {};
78
 
 
79
 
    bless $self,$class;
80
 
 
81
 
    my ($v,$start,$end,$strand,$seqid) = $self->_rearrange([qw(VERBOSE
82
 
                                                               START 
83
 
                                                            END 
84
 
                                                            STRAND
85
 
                                                            SEQID)],@args);
86
 
    defined $v && $self->verbose($v);
87
 
    defined $strand && $self->strand($strand);
88
 
    defined $start  && $self->start($start);
89
 
    defined $end    && $self->end($end);
90
 
    if( defined $self->start && defined $self->end &&
91
 
        $self->start > $self->end ) {
92
 
        $self->warn("When building a location start ($start) is expected to be less than end ($end), however it was not was not. Switching start and end and setting strand to -1");
93
 
 
94
 
        $self->strand(-1);
95
 
        my $e = $self->end;
96
 
        my $s = $self->start;
97
 
        $self->start($e);
98
 
        $self->end($s);
99
 
    }
100
 
    $seqid          && $self->seq_id($seqid);
 
91
    my $self = $class->SUPER::new(@args);
 
92
 
 
93
    my ($locationtype) = $self->_rearrange([qw(LOCATION_TYPE)],@args);
 
94
 
 
95
    $locationtype && $self->location_type($locationtype);
101
96
 
102
97
    return $self;
103
98
}
115
110
 
116
111
sub start {
117
112
  my ($self, $value) = @_;
118
 
  $self->min_start($value) if( defined $value );
119
 
  return $self->SUPER::start();
 
113
 
 
114
  $self->{'_start'} = $value if defined $value ;
 
115
 
 
116
  $self->throw("Only adjacent residues when location type ".
 
117
               "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
 
118
               $self->{'_end'}. "]" )
 
119
      if defined $self->{'_start'} && defined $self->{'_end'} && 
 
120
          $self->location_type eq 'IN-BETWEEN' &&
 
121
          ($self->{'_end'} - 1 != $self->{'_start'});
 
122
  return $self->{'_start'};
120
123
}
121
124
 
 
125
 
122
126
=head2 end
123
127
 
124
128
  Title   : end
133
137
sub end {
134
138
  my ($self, $value) = @_;
135
139
 
136
 
  $self->min_end($value) if( defined $value );
137
 
  return $self->SUPER::end();
 
140
  $self->{'_end'} = $value if defined $value ;
 
141
  $self->throw("Only adjacent residues when location type ".
 
142
              "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
 
143
               $self->{'_end'}. "]" )
 
144
      if defined $self->{'_start'} && defined $self->{'_end'} && 
 
145
          $self->location_type eq 'IN-BETWEEN' &&
 
146
          ($self->{'_end'} - 1 != $self->{'_start'});
 
147
 
 
148
  return $self->{'_end'};
138
149
}
139
150
 
140
151
=head2 strand
148
159
 
149
160
=cut
150
161
 
151
 
sub strand {
152
 
  my ($self, $value) = @_;
153
 
 
154
 
  if ( defined $value ||  
155
 
       ! defined $self->{'_strand'} ) {
156
 
      # let's go ahead and force to '0' if
157
 
      # we are requesting the strand without it
158
 
      # having been set previously
159
 
 
160
 
       $value = 0 unless defined($value);
161
 
 
162
 
       if ( $value eq '+' ) { $value = 1; }
163
 
       elsif ( $value eq '-' ) { $value = -1; }
164
 
       elsif ( $value eq '.' ) { $value = 0; }
165
 
       elsif ( $value != -1 && $value != 1 && $value != 0 ) {
166
 
           $self->throw("$value is not a valid strand info");
167
 
       }
168
 
       $self->{'_strand'} = $value
169
 
   }
170
 
   return $self->{'_strand'};
171
 
}
172
 
 
173
162
=head2 length
174
163
 
175
164
 Title   : length
184
173
 
185
174
sub length {
186
175
   my ($self) = @_;
187
 
   return abs($self->end() - $self->start()) + 1;
 
176
   if ($self->location_type eq 'IN-BETWEEN' ) {
 
177
       return 0;
 
178
   } else {
 
179
       return abs($self->end - $self->start) + 1;
 
180
   }
 
181
 
188
182
}
189
183
 
190
184
=head2 min_start
191
185
 
192
186
  Title   : min_start
193
187
  Usage   : my $minstart = $location->min_start();
194
 
  Function: Get minimum starting location of feature startpoint   
 
188
  Function: Get minimum starting location of feature startpoint
195
189
  Returns : integer or undef if no minimum starting point.
196
190
  Args    : none
197
191
 
198
192
=cut
199
193
 
200
 
sub min_start {
201
 
    my ($self,$value) = @_;
202
 
 
203
 
    if(defined($value)) {
204
 
        $self->{'_start'} = $value;
205
 
    }
206
 
    return $self->{'_start'};
207
 
}
208
 
 
209
194
=head2 max_start
210
195
 
211
196
  Title   : max_start
219
204
 
220
205
=cut
221
206
 
222
 
sub max_start {
223
 
    my ($self,@args) = @_;
224
 
    return $self->min_start(@args);
225
 
}
226
 
 
227
207
=head2 start_pos_type
228
208
 
229
209
  Title   : start_pos_type
230
210
  Usage   : my $start_pos_type = $location->start_pos_type();
231
211
  Function: Get start position type (ie <,>, ^).
232
212
 
233
 
            In this implementation this will always be 'EXACT'.
234
 
 
235
213
  Returns : type of position coded as text 
236
 
            ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN')
 
214
            ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN', 'IN-BETWEEN')
237
215
  Args    : none
238
216
 
239
217
=cut
240
218
 
241
 
sub start_pos_type {
242
 
    my($self) = @_;
243
 
    return 'EXACT';
244
 
}
245
 
 
246
219
=head2 min_end
247
220
 
248
221
  Title   : min_end
253
226
 
254
227
=cut
255
228
 
256
 
sub min_end {
257
 
    my($self,$value) = @_;
258
 
 
259
 
    if(defined($value)) {
260
 
        $self->{'_end'} = $value;
261
 
    }
262
 
    return $self->{'_end'};
263
 
}
264
229
 
265
230
=head2 max_end
266
231
 
275
240
 
276
241
=cut
277
242
 
278
 
sub max_end {
279
 
    my($self,@args) = @_;
280
 
    return $self->min_end(@args);
281
 
}
282
 
 
283
243
=head2 end_pos_type
284
244
 
285
245
  Title   : end_pos_type
286
246
  Usage   : my $end_pos_type = $location->end_pos_type();
287
247
  Function: Get end position type (ie <,>, ^) 
288
248
 
289
 
            In this implementation this will always be 'EXACT'.
290
 
 
291
249
  Returns : type of position coded as text 
292
 
            ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN')
 
250
            ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN', 'IN-BETWEEN')
293
251
  Args    : none
294
252
 
295
253
=cut
296
254
 
297
 
sub end_pos_type {
298
 
    my($self) = @_;
299
 
    return 'EXACT';
300
 
}
301
 
 
302
255
=head2 location_type
303
256
 
304
257
  Title   : location_type
305
258
  Usage   : my $location_type = $location->location_type();
306
259
  Function: Get location type encoded as text
307
 
  Returns : string ('EXACT', 'WITHIN', 'BETWEEN')
308
 
  Args    : none
 
260
  Returns : string ('EXACT' or 'IN-BETWEEN')
 
261
  Args    : 'EXACT' or '..' or 'IN-BETWEEN' or '^'
309
262
 
310
263
=cut
311
264
 
312
265
sub location_type {
313
 
    my ($self) = @_;
314
 
    return 'EXACT';
 
266
    my ($self, $value) = @_;
 
267
 
 
268
    if( defined $value || ! defined $self->{'_location_type'} ) {
 
269
        $value = 'EXACT' unless defined $value;
 
270
        $value = uc $value;
 
271
        if (! defined $RANGEDECODE{$value}) {
 
272
            $value = '\^' if $value eq '^';
 
273
            $value = '\.\.' if $value eq '..';
 
274
            $value = $RANGEENCODE{$value};
 
275
        }
 
276
        $self->throw("Did not specify a valid location type. [$value] is no good")
 
277
            unless defined $value;
 
278
        $self->{'_location_type'} = $value;
 
279
    }
 
280
    $self->throw("Only adjacent residues when location type ".
 
281
                 "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
 
282
                 $self->{'_end'}. "]" )
 
283
        if $self->{'_location_type'} eq 'IN-BETWEEN' &&
 
284
            defined $self->{'_start'} &&
 
285
                defined $self->{'_end'} &&
 
286
                    ($self->{'_end'} - 1 != $self->{'_start'});
 
287
 
 
288
    return $self->{'_location_type'};
315
289
}
316
290
 
317
291
=head2 is_remote
325
299
 
326
300
=cut
327
301
 
328
 
sub is_remote {
329
 
   my $self = shift;
330
 
   if( @_ ) {
331
 
       my $value = shift;
332
 
       $self->{'is_remote'} = $value;
333
 
   }
334
 
   return $self->{'is_remote'};
335
 
 
336
 
}
337
 
 
338
 
 
339
302
=head2 to_FTstring
340
303
 
341
304
  Title   : to_FTstring
348
311
 
349
312
sub to_FTstring { 
350
313
    my($self) = @_;
 
314
 
 
315
    my $str;
351
316
    if( $self->start == $self->end ) {
352
 
        return $self->start;
353
 
    }
354
 
    my $str = $self->start . ".." . $self->end;
355
 
    if( $self->strand == -1 ) {
356
 
        $str = sprintf("complement(%s)", $str);
 
317
        $str =  $self->start;
 
318
    } else {
 
319
        $str = $self->start . $RANGEDECODE{$self->location_type} . $self->end;
 
320
    }
 
321
    if($self->is_remote() && $self->seq_id()) {
 
322
        $str = $self->seq_id() . ":" . $str;
 
323
    }
 
324
    if( defined $self->strand &&
 
325
        $self->strand == -1 ) {
 
326
        $str = "complement(".$str.")";
357
327
    }
358
328
    return $str;
359
329
}
360
330
 
 
331
# comments, not function added by jason 
 
332
#
 
333
# trunc is untested, and as of now unannounced method for truncating a
 
334
# location.  This is to eventually be part of the procedure to
 
335
# truncate a sequence with annotatioin and properly remap the location
 
336
# of all the features contained within the truncated segment.
 
337
 
 
338
# presumably this might do things a little differently for the case 
 
339
# where the truncation splits the location in half
 
340
 
341
# in short- you probably don't want to use  this method.
361
342
 
362
343
sub trunc {
363
344
  my ($self,$start,$end,$relative_ori) = @_;
364
 
 
365
 
  
366
345
  my $newstart  = $self->start - $start+1;
367
346
  my $newend    = $self->end   - $start+1;
368
347
  my $newstrand = $relative_ori * $self->strand;