|
0
|
1 # $Id: ExtrapolatingPair.pm,v 1.6.2.1 2003/02/20 05:11:45 heikki Exp $
|
|
|
2 #
|
|
|
3 # bioperl module for Bio::Coordinate::ExtrapolatingPair
|
|
|
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::ExtrapolatingPair - Continuous match between two coordinate sets
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19
|
|
|
20 use Bio::Location::Simple;
|
|
|
21 use Bio::Coordinate::ExtrapolatingPair;
|
|
|
22
|
|
|
23
|
|
|
24 $match1 = Bio::Location::Simple->new
|
|
|
25 (-seq_id => 'propeptide', -start => 21, -end => 40, -strand=>1 );
|
|
|
26 $match2 = Bio::Location::Simple->new
|
|
|
27 (-seq_id => 'peptide', -start => 1, -end => 20, -strand=>1 );
|
|
|
28
|
|
|
29 $pair = Bio::Coordinate::ExtrapolatingPair->
|
|
|
30 new(-in => $match1,
|
|
|
31 -out => $match2,
|
|
|
32 -strict => 1
|
|
|
33 );
|
|
|
34
|
|
|
35 $pos = Bio::Location::Simple->new
|
|
|
36 (-start => 40, -end => 60, -strand=> 1 );
|
|
|
37 $res = $pair->map($pos);
|
|
|
38 $res->start eq 20;
|
|
|
39 $res->end eq 20;
|
|
|
40
|
|
|
41 =head1 DESCRIPTION
|
|
|
42
|
|
|
43 This class represents a one continuous match between two coordinate
|
|
|
44 systems represented by Bio::Location::Simple objects. The relationship
|
|
|
45 is directed and reversible. It implements methods to ensure internal
|
|
|
46 consistency, and map continuous and split locations from one
|
|
|
47 coordinate system to another.
|
|
|
48
|
|
|
49 This class is an elaboration of Bio::Coordoinate::Pair. The map
|
|
|
50 function returns only matches which is the mode needed most of
|
|
|
51 tehtime. By default the matching regions between coordinate systems
|
|
|
52 are boundless, so that you can say e.g. that gene starts from here in
|
|
|
53 the chromosomal coordinate system and extends indefinetely in both
|
|
|
54 directions. If you want to define the matching regions exactly, you
|
|
|
55 can do that and set strict() to true.
|
|
|
56
|
|
|
57
|
|
|
58 =head1 FEEDBACK
|
|
|
59
|
|
|
60 =head2 Mailing Lists
|
|
|
61
|
|
|
62 User feedback is an integral part of the evolution of this and other
|
|
|
63 Bioperl modules. Send your comments and suggestions preferably to the
|
|
|
64 Bioperl mailing lists Your participation is much appreciated.
|
|
|
65
|
|
|
66 bioperl-l@bioperl.org - General discussion
|
|
|
67 http://bio.perl.org/MailList.html - About the mailing lists
|
|
|
68
|
|
|
69 =head2 Reporting Bugs
|
|
|
70
|
|
|
71 report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
72 the bugs and their resolution. Bug reports can be submitted via email
|
|
|
73 or the web:
|
|
|
74
|
|
|
75 bioperl-bugs@bio.perl.org
|
|
|
76 http://bugzilla.bioperl.org/
|
|
|
77
|
|
|
78 =head1 AUTHOR - Heikki Lehvaslaiho
|
|
|
79
|
|
|
80 Email: heikki@ebi.ac.uk
|
|
|
81 Address:
|
|
|
82
|
|
|
83 EMBL Outstation, European Bioinformatics Institute
|
|
|
84 Wellcome Trust Genome Campus, Hinxton
|
|
|
85 Cambs. CB10 1SD, United Kingdom
|
|
|
86
|
|
|
87 =head1 APPENDIX
|
|
|
88
|
|
|
89 The rest of the documentation details each of the object
|
|
|
90 methods. Internal methods are usually preceded with a _
|
|
|
91
|
|
|
92 =cut
|
|
|
93
|
|
|
94
|
|
|
95 # Let the code begin...
|
|
|
96
|
|
|
97 package Bio::Coordinate::ExtrapolatingPair;
|
|
|
98 use vars qw(@ISA );
|
|
|
99 use strict;
|
|
|
100
|
|
|
101 # Object preamble - inherits from Bio::Root::Root
|
|
|
102 use Bio::Root::Root;
|
|
|
103 use Bio::LocationI;
|
|
|
104 use Bio::Coordinate::Pair;
|
|
|
105
|
|
|
106 @ISA = qw(Bio::Coordinate::Pair);
|
|
|
107
|
|
|
108
|
|
|
109 sub new {
|
|
|
110 my($class,@args) = @_;
|
|
|
111 my $self = $class->SUPER::new(@args);
|
|
|
112
|
|
|
113 my($strict) =
|
|
|
114 $self->_rearrange([qw(STRICT
|
|
|
115 )],
|
|
|
116 @args);
|
|
|
117
|
|
|
118 $strict && $self->strict($strict);
|
|
|
119 return $self;
|
|
|
120 }
|
|
|
121
|
|
|
122
|
|
|
123 =head2 strict
|
|
|
124
|
|
|
125 Title : strict
|
|
|
126 Usage : $obj->strict(1);
|
|
|
127 Function: Set and read the strictness of the coordinate system.
|
|
|
128 Example :
|
|
|
129 Returns : value of input system
|
|
|
130 Args : boolean
|
|
|
131
|
|
|
132 =cut
|
|
|
133
|
|
|
134 sub strict {
|
|
|
135 my ($self,$value) = @_;
|
|
|
136 if( defined $value) {
|
|
|
137 $self->{'_strict'} = 1 if $value;
|
|
|
138 }
|
|
|
139 return $self->{'_strict'};
|
|
|
140 }
|
|
|
141
|
|
|
142
|
|
|
143 =head2 map
|
|
|
144
|
|
|
145 Title : map
|
|
|
146 Usage : $newpos = $obj->map($loc);
|
|
|
147 Function: Map the location from the input coordinate system
|
|
|
148 to a new value in the output coordinate system.
|
|
|
149
|
|
|
150 In extrapolating coodinate system there is no location zero.
|
|
|
151 Locations are...
|
|
|
152 Example :
|
|
|
153 Returns : new location in the output coordinate system or undef
|
|
|
154 Args : Bio::Location::Simple
|
|
|
155
|
|
|
156 =cut
|
|
|
157
|
|
|
158 sub map {
|
|
|
159 my ($self,$value) = @_;
|
|
|
160
|
|
|
161 $self->throw("Need to pass me a value.")
|
|
|
162 unless defined $value;
|
|
|
163 $self->throw("I need a Bio::Location, not [$value]")
|
|
|
164 unless $value->isa('Bio::LocationI');
|
|
|
165 $self->throw("Input coordinate system not set")
|
|
|
166 unless $self->in;
|
|
|
167 $self->throw("Output coordinate system not set")
|
|
|
168 unless $self->out;
|
|
|
169
|
|
|
170 my $match;
|
|
|
171
|
|
|
172 if ($value->isa("Bio::Location::SplitLocationI")) {
|
|
|
173
|
|
|
174 my $split = Bio::Coordinate::Result->new(-seq_id=>$self->out->seq_id);
|
|
|
175 foreach my $loc ( sort { $a->start <=> $b->start }
|
|
|
176 $value->sub_Location ) {
|
|
|
177
|
|
|
178 $match = $self->_map($loc);
|
|
|
179 $split->add_sub_Location($match) if $match;
|
|
|
180
|
|
|
181 }
|
|
|
182 $split->each_Location ? (return $split) : (return undef) ;
|
|
|
183
|
|
|
184 } else {
|
|
|
185 return $self->_map($value);
|
|
|
186 }
|
|
|
187 }
|
|
|
188
|
|
|
189
|
|
|
190 =head2 _map
|
|
|
191
|
|
|
192 Title : _map
|
|
|
193 Usage : $newpos = $obj->_map($simpleloc);
|
|
|
194 Function: Internal method that does the actual mapping. Called
|
|
|
195 multiple times by map() if the location to be mapped is a
|
|
|
196 split location
|
|
|
197
|
|
|
198 Example :
|
|
|
199 Returns : new location in the output coordinate system or undef
|
|
|
200 Args : Bio::Location::Simple
|
|
|
201
|
|
|
202 =cut
|
|
|
203
|
|
|
204 sub _map {
|
|
|
205 my ($self,$value) = @_;
|
|
|
206
|
|
|
207 my ($offset, $start, $end);
|
|
|
208
|
|
|
209 if ($self->strand == -1) {
|
|
|
210 $offset = $self->in->end + $self->out->start;
|
|
|
211 $start = $offset - $value->end;
|
|
|
212 $end = $offset - $value->start ;
|
|
|
213 } else { # undef, 0 or 1
|
|
|
214 $offset = $self->in->start - $self->out->start;
|
|
|
215 $start = $value->start - $offset;
|
|
|
216 $end = $value->end - $offset;
|
|
|
217 }
|
|
|
218
|
|
|
219 # strict prevents matches outside stated range
|
|
|
220 if ($self->strict) {
|
|
|
221 return undef if $start < 0 and $end < 0;
|
|
|
222 return undef if $start > $self->out->end;
|
|
|
223 $start = 1 if $start < 0;
|
|
|
224 $end = $self->out->end if $end > $self->out->end;
|
|
|
225 }
|
|
|
226
|
|
|
227 my $match = Bio::Location::Simple->
|
|
|
228 new(-start => $start,
|
|
|
229 -end => $end,
|
|
|
230 -strand => $self->strand,
|
|
|
231 -seq_id => $self->out->seq_id,
|
|
|
232 -location_type => $value->location_type
|
|
|
233 );
|
|
|
234 $match->strand($match->strand * $value->strand) if $value->strand;
|
|
|
235 bless $match, 'Bio::Coordinate::Result::Match';
|
|
|
236
|
|
|
237 return $match;
|
|
|
238 }
|
|
|
239
|
|
|
240 1;
|
