|
0
|
1 # $Id: CytoMarker.pm,v 1.3 2002/10/22 07:45:15 lapp Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Map::CytoMarker
|
|
|
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::Map::CytoMarker - An object representing a marker.
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 $o_usat = new Bio::Map::CytoMarker(-name=>'Chad Super Marker 2',
|
|
|
20 -position => $pos);
|
|
|
21
|
|
|
22 =head1 DESCRIPTION
|
|
|
23
|
|
|
24 This object handles markers with a positon in a cytogenetic map known.
|
|
|
25 This marker will have a name and a position.
|
|
|
26
|
|
|
27
|
|
|
28 =head1 FEEDBACK
|
|
|
29
|
|
|
30 =head2 Mailing Lists
|
|
|
31
|
|
|
32 User feedback is an integral part of the evolution of this and other
|
|
|
33 Bioperl modules. Send your comments and suggestions preferably to the
|
|
|
34 Bioperl mailing list. Your participation is much appreciated.
|
|
|
35
|
|
|
36 bioperl-l@bioperl.org - General discussion
|
|
|
37 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
38
|
|
|
39 =head2 Reporting Bugs
|
|
|
40
|
|
|
41 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
42 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
43 email or the web:
|
|
|
44
|
|
|
45 bioperl-bugs@bioperl.org
|
|
|
46 http://bugzilla.bioperl.org/
|
|
|
47
|
|
|
48 =head1 AUTHOR - Heikki Lehvaslaiho
|
|
|
49
|
|
|
50 Email heikki@ebi.ac.uk
|
|
|
51
|
|
|
52 =head1 CONTRIBUTORS
|
|
|
53
|
|
|
54 Chad Matsalla bioinformatics1@dieselwurks.com
|
|
|
55 Lincoln Stein lstein@cshl.org
|
|
|
56 Jason Stajich jason@bioperl.org
|
|
|
57
|
|
|
58 =head1 APPENDIX
|
|
|
59
|
|
|
60 The rest of the documentation details each of the object methods.
|
|
|
61 Internal methods are usually preceded with a _
|
|
|
62
|
|
|
63 =cut
|
|
|
64
|
|
|
65 # Let the code begin...
|
|
|
66
|
|
|
67 package Bio::Map::CytoMarker;
|
|
|
68 use vars qw(@ISA);
|
|
|
69 use strict;
|
|
|
70 use Bio::Map::Marker;
|
|
|
71 use Bio::Map::CytoPosition;
|
|
|
72 use Bio::RangeI;
|
|
|
73
|
|
|
74 @ISA = qw(Bio::Map::Marker Bio::RangeI );
|
|
|
75
|
|
|
76
|
|
|
77 =head2 Bio::Map::MarkerI methods
|
|
|
78
|
|
|
79 =cut
|
|
|
80
|
|
|
81 =head2 get_position_object
|
|
|
82
|
|
|
83 Title : get_position_class
|
|
|
84 Usage : my $pos = $marker->get_position_object();
|
|
|
85 Function: To get an object of the default Position class
|
|
|
86 for this Marker. Subclasses should redefine this method.
|
|
|
87 The Position needs to be L<Bio::Map::PositionI>.
|
|
|
88 Returns : L<Bio::Map::CytoPosition>
|
|
|
89 Args : none
|
|
|
90
|
|
|
91 =cut
|
|
|
92
|
|
|
93 sub get_position_object {
|
|
|
94 my ($self) = @_;
|
|
|
95 return new Bio::Map::CytoPosition();
|
|
|
96 }
|
|
|
97
|
|
|
98
|
|
|
99 =head2 Comparison methods
|
|
|
100
|
|
|
101 The numeric values for cutogeneic loctions go from the p tip of
|
|
|
102 chromosome 1, down to the q tip and similarly throgh consecutive
|
|
|
103 chromosomes, through X and end the the q tip of X. See
|
|
|
104 L<Bio::Map::CytoPosition::cytorange> for more details.
|
|
|
105
|
|
|
106 The numeric values for cytogenetic positions are ranges of type
|
|
|
107 L<Bio::Range>, so MarkerI type of operators (equals, less_than,
|
|
|
108 greater_than) are not very meaningful, but they might be of some use
|
|
|
109 combined with L<Bio::RangeI> methods (overlaps, contains, equals,
|
|
|
110 intersection, union). equals(), present in both interfaces is treated
|
|
|
111 as a more precice RangeI method.
|
|
|
112
|
|
|
113 CytoMarker has a method L<get_chr> which might turn out to be useful
|
|
|
114 in this context.
|
|
|
115
|
|
|
116 The L<less_than> and L<greater_than> methods are implemented by
|
|
|
117 comparing the end values of the range, so you better first check that
|
|
|
118 markers do not overlap, or you get an opposite result than expected.
|
|
|
119 The numerical values are not metric, so avarages are not meaningful.
|
|
|
120
|
|
|
121 Note: These methods always return a value. A false value (0) might
|
|
|
122 mean that you have not set the position! Check those warnings.
|
|
|
123
|
|
|
124 =cut
|
|
|
125
|
|
|
126 =head2 Bio::Map::MarkerI comparison methods
|
|
|
127
|
|
|
128 =cut
|
|
|
129
|
|
|
130 =head2 tuple
|
|
|
131
|
|
|
132 Title : tuple
|
|
|
133 Usage : ($me, $you) = $self->_tuple($compare)
|
|
|
134 Function: Utility method to extract numbers and test for missing values.
|
|
|
135 Returns : two ranges or tuple of -1
|
|
|
136 Args : Bio::Map::MappableI or Bio::Map::PositionI
|
|
|
137
|
|
|
138 =cut
|
|
|
139
|
|
|
140 =head2 less_than
|
|
|
141
|
|
|
142 Title : less_than
|
|
|
143 Usage : if( $mappable->less_than($m2) ) ...
|
|
|
144 Function: Tests if a position is less than another position
|
|
|
145 Returns : boolean
|
|
|
146 Args : Bio::Map::MappableI or Bio::Map::PositionI
|
|
|
147
|
|
|
148 =cut
|
|
|
149
|
|
|
150
|
|
|
151 sub less_than {
|
|
|
152 my ($self,$compare) = @_;
|
|
|
153
|
|
|
154 my ($me, $you) = $self->tuple($compare);
|
|
|
155 return 0 if $me == -1 or $you == -1 ;
|
|
|
156
|
|
|
157 $me = $me->end;
|
|
|
158 $you = $you->start;
|
|
|
159
|
|
|
160 print STDERR "me=$me, you=$you\n" if $self->verbose > 0;
|
|
|
161 return $me < $you;
|
|
|
162 }
|
|
|
163
|
|
|
164 =head2 greater_than
|
|
|
165
|
|
|
166 Title : greater_than
|
|
|
167 Usage : if( $mappable->greater_than($m2) ) ...
|
|
|
168 Function: Tests if position is greater than another position
|
|
|
169 Returns : boolean
|
|
|
170 Args : Bio::Map::MappableI or Bio::Map::PositionI
|
|
|
171
|
|
|
172 =cut
|
|
|
173
|
|
|
174
|
|
|
175 sub greater_than {
|
|
|
176 my ($self,$compare) = @_;
|
|
|
177
|
|
|
178 my ($me, $you) = $self->tuple($compare);
|
|
|
179 return 0 if $me == -1 or $you == -1 ;
|
|
|
180
|
|
|
181 $me = $me->start;
|
|
|
182 $you = $you->end;
|
|
|
183 print STDERR "me=$me, you=$you\n" if $self->verbose > 0;
|
|
|
184 return $me > $you;
|
|
|
185 }
|
|
|
186
|
|
|
187 =head2 RangeI methods
|
|
|
188
|
|
|
189 =cut
|
|
|
190
|
|
|
191
|
|
|
192 =head2 equals
|
|
|
193
|
|
|
194 Title : equals
|
|
|
195 Usage : if( $mappable->equals($mapable2)) ...
|
|
|
196 Function: Test if a position is equal to another position
|
|
|
197 Returns : boolean
|
|
|
198 Args : Bio::Map::MappableI or Bio::Map::PositionI
|
|
|
199
|
|
|
200 =cut
|
|
|
201
|
|
|
202 sub equals {
|
|
|
203 my ($self,$compare) = @_;
|
|
|
204
|
|
|
205 my ($me, $you) = $self->tuple($compare);
|
|
|
206 return 0 unless $me->isa('Bio::RangeI') and $you->isa('Bio::RangeI');
|
|
|
207
|
|
|
208 return $me->equals($you);
|
|
|
209 }
|
|
|
210
|
|
|
211 =head2 overlaps
|
|
|
212
|
|
|
213 Title : overlaps
|
|
|
214 Usage : if($r1->overlaps($r2)) { do stuff }
|
|
|
215 Function : tests if $r2 overlaps $r1
|
|
|
216 Args : a range to test for overlap with
|
|
|
217 Returns : true if the ranges overlap, false otherwise
|
|
|
218 Inherited: Bio::RangeI
|
|
|
219
|
|
|
220 =cut
|
|
|
221
|
|
|
222 sub overlaps {
|
|
|
223 my ($self,$compare) = @_;
|
|
|
224
|
|
|
225 my ($me, $you) = $self->tuple($compare);
|
|
|
226 return 0 unless $me->isa('Bio::RangeI') and $you->isa('Bio::RangeI');
|
|
|
227
|
|
|
228 return $me->overlaps($you);
|
|
|
229 }
|
|
|
230
|
|
|
231 =head2 contains
|
|
|
232
|
|
|
233 Title : contains
|
|
|
234 Usage : if($r1->contains($r2) { do stuff }
|
|
|
235 Function : tests wether $r1 totaly contains $r2
|
|
|
236 Args : a range to test for being contained
|
|
|
237 Returns : true if the argument is totaly contained within this range
|
|
|
238 Inherited: Bio::RangeI
|
|
|
239
|
|
|
240 =cut
|
|
|
241
|
|
|
242 sub contains {
|
|
|
243 my ($self,$compare) = @_;
|
|
|
244
|
|
|
245 my ($me, $you) = $self->tuple($compare);
|
|
|
246 return 0 unless $me->isa('Bio::RangeI') and $you->isa('Bio::RangeI');
|
|
|
247 print STDERR "me=", $me->start. "-", $me->end, " ",
|
|
|
248 "you=", $you->start. "-", $you->end, "\n"
|
|
|
249 if $self->verbose > 0;
|
|
|
250
|
|
|
251 return $me->contains($you);
|
|
|
252 }
|
|
|
253
|
|
|
254 =head2 intersection
|
|
|
255
|
|
|
256 Title : intersection
|
|
|
257 Usage : ($start, $stop, $strand) = $r1->intersection($r2)
|
|
|
258 Function : gives the range that is contained by both ranges
|
|
|
259 Args : a range to compare this one to
|
|
|
260 Returns : nothing if they do not overlap, or the range that they do overlap
|
|
|
261 Inherited: Bio::RangeI::intersection
|
|
|
262
|
|
|
263 =cut
|
|
|
264
|
|
|
265 sub intersection {
|
|
|
266 my ($self,$compare) = @_;
|
|
|
267
|
|
|
268 my ($me, $you) = $self->tuple($compare);
|
|
|
269 return 0 unless $me->isa('Bio::RangeI') and $you->isa('Bio::RangeI');
|
|
|
270
|
|
|
271 return $me->intersection($you);
|
|
|
272 }
|
|
|
273
|
|
|
274 =head2 union
|
|
|
275
|
|
|
276 Title : union
|
|
|
277 Usage : ($start, $stop, $strand) = $r1->union($r2);
|
|
|
278 : ($start, $stop, $strand) = Bio::Range->union(@ranges);
|
|
|
279 Function : finds the minimal range that contains all of the ranges
|
|
|
280 Args : a range or list of ranges to find the union of
|
|
|
281 Returns : the range containing all of the ranges
|
|
|
282 Inherited: Bio::RangeI::union
|
|
|
283
|
|
|
284 =cut
|
|
|
285
|
|
|
286 sub union {
|
|
|
287 my ($self,$compare) = @_;
|
|
|
288
|
|
|
289 my ($me, $you) = $self->tuple($compare);
|
|
|
290 return 0 unless $me->isa('Bio::RangeI') and $you->isa('Bio::RangeI');
|
|
|
291
|
|
|
292 return $me->union($you);
|
|
|
293 }
|
|
|
294
|
|
|
295
|
|
|
296 =head2 New methods
|
|
|
297
|
|
|
298 =cut
|
|
|
299
|
|
|
300
|
|
|
301 =head2 get_chr
|
|
|
302
|
|
|
303 Title : get_chr
|
|
|
304 Usage : my $mychr = $marker->get_chr();
|
|
|
305 Function: Read only method for the chromosome string of the location.
|
|
|
306 A shotrcut to $marker->position->chr().
|
|
|
307 Returns : chromosome value
|
|
|
308 Args : [optional] new chromosome value
|
|
|
309
|
|
|
310 =cut
|
|
|
311
|
|
|
312
|
|
|
313 sub get_chr {
|
|
|
314 my ($self) = @_;
|
|
|
315 return undef unless $self->position;
|
|
|
316 return $self->position->chr;
|
|
|
317 }
|
|
|
318
|
|
|
319 1;
|
|
|
320
|
