|
0
|
1 # BioPerl module for Bio::Map::Marker
|
|
|
2 #
|
|
|
3 # Cared for by Chad Matsalla <bioinformatics1@dieselwurks.com>
|
|
|
4 #
|
|
|
5 # Copyright Chad Matsalla
|
|
|
6 #
|
|
|
7 # You may distribute this module under the same terms as perl itself
|
|
|
8
|
|
|
9 # POD documentation - main docs before the code
|
|
|
10
|
|
|
11 =head1 NAME
|
|
|
12
|
|
|
13 Bio::Map::Marker - An central map object representing a generic marker
|
|
|
14 that can have multiple location in several maps.
|
|
|
15
|
|
|
16 =head1 SYNOPSIS
|
|
|
17
|
|
|
18 # get map objects somehow
|
|
|
19
|
|
|
20 # a marker with complex localisation
|
|
|
21 $o_usat = new Bio::Map::Marker (-name=>'Chad Super Marker 2',
|
|
|
22 -positions => [ [$map1, $position1],
|
|
|
23 [$map1, $position2]
|
|
|
24 ] );
|
|
|
25
|
|
|
26 # The markers deal with Bio::Map::Position objects which can also
|
|
|
27 # be explicitely created and passed on to markers as an array ref:
|
|
|
28 $o_usat2 = new Bio::Map::Marker (-name=>'Chad Super Marker 3',
|
|
|
29 -positions => [ $pos1,
|
|
|
30 $pos2
|
|
|
31 ] );
|
|
|
32
|
|
|
33 # a marker with unique position in a map
|
|
|
34 $marker1 = new Bio::Map::Marker (-name=>'hypervariable1',
|
|
|
35 -map => $map1,
|
|
|
36 -position => 100
|
|
|
37 )
|
|
|
38
|
|
|
39 # an other way of creating a marker with unique position in a map:
|
|
|
40 $marker2 = new Bio::Map::Marker (-name=>'hypervariable2');
|
|
|
41 $map1->add_marker($marker2);
|
|
|
42 $marker2->position(100);
|
|
|
43
|
|
|
44 # position method is a short cut for get/set'ing unigue positions
|
|
|
45 # which overwrites previous values
|
|
|
46 # to place a marker to other maps or to have multiple positions
|
|
|
47 # for a map within the same map use add_position()
|
|
|
48
|
|
|
49 $marker2->add_position(200); # new position in the same map
|
|
|
50 $marker2->add_position($map2,200); # new map
|
|
|
51
|
|
|
52 # setting a map() in a marker or adding a marker into a map are
|
|
|
53 # identical mathods. Both set the bidirectional connection which is
|
|
|
54 # used by the marker to remember its latest, default map.
|
|
|
55
|
|
|
56 # Regardes of how marker positions are created, they are stored and
|
|
|
57 # returned as Bio::Map::PositionI objects:
|
|
|
58
|
|
|
59 # unique position
|
|
|
60 print $marker1->position->value, "\n";
|
|
|
61 # several positions
|
|
|
62 foreach $pos ($marker2->each_position($map1)) {
|
|
|
63 print $pos->value, "\n";
|
|
|
64 }
|
|
|
65
|
|
|
66 See L<Bio::Map::Position> and L<Bio::Map::PositionI> for more information.
|
|
|
67
|
|
|
68 =head1 DESCRIPTION
|
|
|
69
|
|
|
70 This object handles the notion of a generic marker. This marker will
|
|
|
71 have a name and a position in a map.
|
|
|
72
|
|
|
73 This object is intended to be used by a marker parser like Mapmaker.pm
|
|
|
74 and then blessed into the proper type of marker (ie Microsatellite) by
|
|
|
75 the calling script.
|
|
|
76
|
|
|
77 =head2 Design principles
|
|
|
78
|
|
|
79 A Marker is a central object in Bio::Map name space. A Map is a holder
|
|
|
80 class for objects. A Marker has a Position in a Map. A Marker can be
|
|
|
81 compared to an other Markers using boolean methods. Positions can have
|
|
|
82 non-numeric values or other methods to store the locations, so they
|
|
|
83 have a method numeric() which does the conversion.
|
|
|
84
|
|
|
85 A Marker has a convinience method position() which is able to create
|
|
|
86 Positions of required class from scalars by calling method
|
|
|
87 get_position_object().
|
|
|
88
|
|
|
89 For more complex situations, a Marker can have multiple positions in
|
|
|
90 multiple Maps. It is therefore possible to extract Positions (all or
|
|
|
91 belonging to certain Map) and compare Markers to them. It is up to the
|
|
|
92 programmer to make sure position values and Maps they belong to can be
|
|
|
93 sensibly compared.
|
|
|
94
|
|
|
95 =head1 FEEDBACK
|
|
|
96
|
|
|
97 =head2 Mailing Lists
|
|
|
98
|
|
|
99 User feedback is an integral part of the evolution of this and other
|
|
|
100 Bioperl modules. Send your comments and suggestions preferably to the
|
|
|
101 Bioperl mailing list. Your participation is much appreciated.
|
|
|
102
|
|
|
103 bioperl-l@bioperl.org - General discussion
|
|
|
104 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
105
|
|
|
106 =head2 Reporting Bugs
|
|
|
107
|
|
|
108 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
109 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
110 email or the web:
|
|
|
111
|
|
|
112 bioperl-bugs@bioperl.org
|
|
|
113 http://bugzilla.bioperl.org/
|
|
|
114
|
|
|
115 =head1 AUTHOR - Chad Matsalla
|
|
|
116
|
|
|
117 Email bioinformatics1@dieselwurks.com
|
|
|
118
|
|
|
119 =head1 CONTRIBUTORS
|
|
|
120
|
|
|
121 Heikki Lehvaslaiho heikki@ebi.ac.uk
|
|
|
122 Lincoln Stein lstein@cshl.org
|
|
|
123 Jason Stajich jason@bioperl.org
|
|
|
124
|
|
|
125 =head1 APPENDIX
|
|
|
126
|
|
|
127 The rest of the documentation details each of the object methods.
|
|
|
128 Internal methods are usually preceded with a _
|
|
|
129
|
|
|
130 =cut
|
|
|
131
|
|
|
132 # Let the code begin...
|
|
|
133
|
|
|
134 package Bio::Map::Marker;
|
|
|
135 use vars qw(@ISA);
|
|
|
136 use strict;
|
|
|
137 use Bio::Root::Root;
|
|
|
138 use Bio::Map::MarkerI;
|
|
|
139 use Bio::Map::Position;
|
|
|
140
|
|
|
141 @ISA = qw(Bio::Root::Root Bio::Map::MarkerI);
|
|
|
142
|
|
|
143 =head2 new
|
|
|
144
|
|
|
145 Title : new
|
|
|
146 Usage : $o_marker = new Bio::Map::Marker( -name => 'Whizzy marker',
|
|
|
147 -position => $position);
|
|
|
148 Function: Builds a new Bio::Map::Marker object
|
|
|
149 Returns : Bio::Map::Marker
|
|
|
150 Args :
|
|
|
151 -name => name of this microsatellite
|
|
|
152 [optional], string,default 'Unknown'
|
|
|
153
|
|
|
154 -positions => map position for this marker, [optional]
|
|
|
155 Bio::Map::PositionI-inherited obj, no default)
|
|
|
156
|
|
|
157 =cut
|
|
|
158
|
|
|
159 sub new {
|
|
|
160 my ($class,@args) = @_;
|
|
|
161 my $self = $class->SUPER::new(@args);
|
|
|
162 $self->{'_positions'} = [];
|
|
|
163 my ($name, $map, $position, $positions) =
|
|
|
164 $self->_rearrange([qw(NAME
|
|
|
165 MAP
|
|
|
166 POSITION
|
|
|
167 POSITIONS
|
|
|
168 )], @args);
|
|
|
169 if ($name) { $self->name($name); }
|
|
|
170 else {$self->name('Unnamed marker'); }
|
|
|
171 $position && $self->position($position);
|
|
|
172 $positions && $self->positions($positions);
|
|
|
173 $map && $self->map($map);
|
|
|
174
|
|
|
175 return $self;
|
|
|
176 }
|
|
|
177
|
|
|
178 =head2 name
|
|
|
179
|
|
|
180 Title : name
|
|
|
181 Usage : $o_usat->name($new_name) _or_
|
|
|
182 my $name = $o_usat->name()
|
|
|
183 Function: Get/Set the name for this Microsatellite
|
|
|
184 Returns : A scalar representing the current name of this marker
|
|
|
185 Args : If provided, the current name of this marker
|
|
|
186 will be set to $new_name.
|
|
|
187
|
|
|
188 =cut
|
|
|
189
|
|
|
190 sub name {
|
|
|
191 my ($self,$name) = @_;
|
|
|
192 my $last = $self->{'_name'};
|
|
|
193 if ($name) {
|
|
|
194 $self->{'_name'} = $name;
|
|
|
195 }
|
|
|
196 return $last;
|
|
|
197 }
|
|
|
198
|
|
|
199
|
|
|
200 =head2 map
|
|
|
201
|
|
|
202 Title : map
|
|
|
203 Usage : my $mymap = $marker->map();
|
|
|
204 Function: Get/Set the default map for the marker.
|
|
|
205 This is set by L<Bio::Map::CytoMap::add_element> method
|
|
|
206 Returns : L<Bio::Map::MapI>
|
|
|
207 Args : [optional] new L<Bio::Map::MapI>
|
|
|
208
|
|
|
209 =cut
|
|
|
210
|
|
|
211 sub map {
|
|
|
212 my ($self,$map) = @_;
|
|
|
213 if( defined $map ) {
|
|
|
214 $self->thow('This is [$map], not Bio::Map::MapI object')
|
|
|
215 unless $map->isa('Bio::Map::MapI');
|
|
|
216 $self->{'_default_map'} = $map;
|
|
|
217 }
|
|
|
218 return $self->{'_default_map'};
|
|
|
219 }
|
|
|
220
|
|
|
221
|
|
|
222
|
|
|
223 =head2 get_position_object
|
|
|
224
|
|
|
225 Title : get_position_class
|
|
|
226 Usage : my $pos = $marker->get_position_object();
|
|
|
227 Function: To get an object of the default Position class
|
|
|
228 for this Marker. Subclasses should redefine this method.
|
|
|
229 The Position needs to be Bio::Map::PositionI.
|
|
|
230 Returns : Bio::Map::Position
|
|
|
231 Args : none
|
|
|
232
|
|
|
233 See L<Bio::Map::Position> and L<Bio::Map::PositionI> for more information.
|
|
|
234
|
|
|
235 =cut
|
|
|
236
|
|
|
237 sub get_position_object {
|
|
|
238 my ($self) = @_;
|
|
|
239 return new Bio::Map::Position();
|
|
|
240 }
|
|
|
241
|
|
|
242
|
|
|
243 =head2 position
|
|
|
244
|
|
|
245 Title : position
|
|
|
246 Usage : $position = $mappable->position($map); OR
|
|
|
247 $mappable->position($position); # $position can be Bio::Map::PositionI
|
|
|
248 $mappable->position(100); # or scalar if the marker has a default map
|
|
|
249 $mappable->position($map, 100); # if not give explicit $map
|
|
|
250 Function: Get/Set the Bio::Map::PositionI for a mappable element
|
|
|
251 in a specific Map
|
|
|
252 Adds the marker to a map automatically if Map is given.
|
|
|
253 Altenaitvely, you can add the merker to the map first
|
|
|
254 (L<Bio::Map::Map::add_element>) to set the default map
|
|
|
255 Returns : Bio::Map::PositionI
|
|
|
256 Args : $position - Bio::Map::PositionI # Position we want to set
|
|
|
257 OR
|
|
|
258 $map - Bio::Map::MapI AND
|
|
|
259 scalar
|
|
|
260 OR
|
|
|
261 scalar, but only if the marker has been added to a map
|
|
|
262
|
|
|
263 =cut
|
|
|
264
|
|
|
265 sub position {
|
|
|
266 my ($self, $pos, $secondary_pos) = @_;
|
|
|
267 my ($map);
|
|
|
268 POS: {
|
|
|
269 if ($pos) {
|
|
|
270 if (ref($pos) eq 'SCALAR' || ref($pos) eq '') {
|
|
|
271 $map = $self->map;
|
|
|
272 }
|
|
|
273 elsif (ref($pos) eq 'ARRAY') {
|
|
|
274 $map = $pos->[0];
|
|
|
275 $pos = $pos->[1];
|
|
|
276 }
|
|
|
277 elsif ($pos->isa('Bio::Map::PositionI')) {
|
|
|
278 $pos->marker($self);
|
|
|
279
|
|
|
280 $self->purge_positions;
|
|
|
281 $self->add_position($pos);
|
|
|
282 $map = $pos->map;
|
|
|
283 $map->add_element($self) unless defined($self->map) && $self->map eq $map;
|
|
|
284 last POS;
|
|
|
285 }
|
|
|
286
|
|
|
287 elsif ($pos->isa('Bio::Map::MapI')) {
|
|
|
288 $map = $pos;
|
|
|
289 $pos = $secondary_pos;
|
|
|
290 } else {
|
|
|
291 $map = $self->map;
|
|
|
292 }
|
|
|
293 $self->throw("You need to add a marker to a map before ".
|
|
|
294 "you can set positions without explicit map!" )
|
|
|
295 unless $map;
|
|
|
296 $self->throw("Position better be scalar, not [$pos=". ref($pos) ."]")
|
|
|
297 unless ref($pos) eq 'SCALAR' || ref($pos) eq '';
|
|
|
298
|
|
|
299 my $newpos = $self->get_position_object;
|
|
|
300 $newpos->map($map);
|
|
|
301 $newpos->value($pos);
|
|
|
302 $newpos->marker($self);
|
|
|
303
|
|
|
304 $map->add_element($self) unless defined($self->map) && $self->map eq $map;
|
|
|
305 $self->purge_positions;
|
|
|
306 $self->add_position($newpos)
|
|
|
307 }
|
|
|
308 }
|
|
|
309 my @array = $self->each_position();
|
|
|
310 $self->warn('More than one value is associated with this position')
|
|
|
311 if scalar @array > 1;
|
|
|
312 return $array[0];
|
|
|
313 }
|
|
|
314
|
|
|
315 =head2 add_position
|
|
|
316
|
|
|
317 Title : add_position
|
|
|
318 Usage : $position->add_position($position)
|
|
|
319 Function: Add the Position to the Marker container.
|
|
|
320 If you are using this method, you need to
|
|
|
321 add the Marker to the Map yourself
|
|
|
322 Returns : none
|
|
|
323 Args : Position - Reference to Bio::Map::PositionI
|
|
|
324
|
|
|
325 =cut
|
|
|
326
|
|
|
327 sub add_position{
|
|
|
328 my ($self, $pos) = @_;
|
|
|
329 $self->throw("Must give a Position") unless defined $pos;
|
|
|
330
|
|
|
331 $self->throw("Must give a Bio::Map::PositionI, not [". ref($pos) ."]")
|
|
|
332 unless $pos->isa('Bio::Map::PositionI');
|
|
|
333
|
|
|
334 my $map = $pos->map;
|
|
|
335 $map->add_element($self) unless defined($self->map) && $self->map eq $map;
|
|
|
336
|
|
|
337 push @{$self->{'_positions'}}, $pos;
|
|
|
338
|
|
|
339 }
|
|
|
340
|
|
|
341 =head2 positions
|
|
|
342
|
|
|
343 Title : positions
|
|
|
344 Usage : $mappable->positions([$pos1, $pos2, $pos3]);
|
|
|
345 Function: Add multiple Bio::Map::PositionI for a mappable element
|
|
|
346 in a Map.
|
|
|
347 Returns : boolean
|
|
|
348 Args : array ref of $map/value tuples or array ref of Positions
|
|
|
349
|
|
|
350 =cut
|
|
|
351
|
|
|
352 sub positions {
|
|
|
353 my ($self, $arrayref) = @_;
|
|
|
354 my ($map);
|
|
|
355 $self->throw_not_implemented();
|
|
|
356 }
|
|
|
357
|
|
|
358 =head2 each_position
|
|
|
359
|
|
|
360 Title : each_position
|
|
|
361 Usage : my @positions = $position->each_position('mapname');
|
|
|
362 Function: Retrieve a list of Positions
|
|
|
363 Returns : Array of L<Bio::Map::PositionI>
|
|
|
364 Args : none
|
|
|
365
|
|
|
366 =cut
|
|
|
367
|
|
|
368 sub each_position {
|
|
|
369 my ($self,$mapname) = @_;
|
|
|
370 $self->warn("Retrieving positions in a named map only is ".
|
|
|
371 "not implemented. Getting all.") if $mapname;
|
|
|
372 return @{$self->{'_positions'}};
|
|
|
373 }
|
|
|
374
|
|
|
375 =head2 purge_positions
|
|
|
376
|
|
|
377 Title : purge_positions
|
|
|
378 Usage : $marker->purge_positions
|
|
|
379 Function: Remove all the position values stored for a Marker
|
|
|
380 Returns : none
|
|
|
381 Args : [optional] only purge values for a given map
|
|
|
382
|
|
|
383 =cut
|
|
|
384
|
|
|
385 sub purge_positions{
|
|
|
386 my ($self, $map) = @_;
|
|
|
387 $self->warn("Retrieving positions in a named map only, not implemented ") if $map;
|
|
|
388 $self->{'_positions'} = [];
|
|
|
389 }
|
|
|
390
|
|
|
391 =head2 known_maps
|
|
|
392
|
|
|
393 Title : known_maps
|
|
|
394 Usage : my @maps = $marker->known_maps
|
|
|
395 Function: Returns the list of maps that this position has values for
|
|
|
396 Returns : list of Bio::Map::MapI unique ids
|
|
|
397 Args : none
|
|
|
398
|
|
|
399 =cut
|
|
|
400
|
|
|
401 sub known_maps{
|
|
|
402 my ($self) = @_;
|
|
|
403 my %hash;
|
|
|
404 foreach my $pos ($self->each_position) {
|
|
|
405 $hash{$pos->map->unique_id} = 1;
|
|
|
406 }
|
|
|
407 return keys %hash;
|
|
|
408 }
|
|
|
409
|
|
|
410 =head2 in_map
|
|
|
411
|
|
|
412 Title : in_map
|
|
|
413 Usage : if ( $position->in_map($map) ) {}
|
|
|
414 Function: Tests if a position has values in a specific map
|
|
|
415 Returns : boolean
|
|
|
416 Args : a map unique id OR Bio::Map::MapI
|
|
|
417
|
|
|
418 =cut
|
|
|
419
|
|
|
420 sub in_map{
|
|
|
421 my ($self,$map) = @_;
|
|
|
422
|
|
|
423 $self->throw("Need an argument") unless $map;
|
|
|
424
|
|
|
425 if (ref($map) && $map->isa('Bio::Map::MapI')) {
|
|
|
426 foreach my $pos ($self->each_position) {
|
|
|
427 return 1 if $pos->map eq $map;
|
|
|
428 }
|
|
|
429 } else { # assuming a scalar
|
|
|
430 foreach my $pos ($self->each_position) {
|
|
|
431 return 1 if $pos->map->unique_id eq $map;
|
|
|
432 }
|
|
|
433 }
|
|
|
434 return 0;
|
|
|
435 }
|
|
|
436
|
|
|
437 =head2 Comparison methods
|
|
|
438
|
|
|
439 =cut
|
|
|
440
|
|
|
441 =head2 tuple
|
|
|
442
|
|
|
443 Title : tuple
|
|
|
444 Usage : ($me, $you) = $self->_tuple($compare)
|
|
|
445 Function: Utility ethod to extract numbers and test for missing values.
|
|
|
446 Returns : tuple values
|
|
|
447 Args : Bio::Map::MappableI or Bio::Map::PositionI
|
|
|
448
|
|
|
449 =cut
|
|
|
450
|
|
|
451 sub tuple {
|
|
|
452 my ($self,$compare) = @_;
|
|
|
453 my ($me, $you) = (-1, -1);
|
|
|
454
|
|
|
455 $self->warn("Trying to compare [". $self->name. "] to nothing.") &&
|
|
|
456 return ($me, $you) unless defined $compare;
|
|
|
457 $self->warn("[". $self->name. "] has no position.") &&
|
|
|
458 return ($me, $you) unless $self->position;
|
|
|
459
|
|
|
460 $me = $self->position->numeric;
|
|
|
461
|
|
|
462 if( $compare->isa('Bio::Map::MappableI') ){
|
|
|
463 $self->warn("[". $compare->name. "] has no position.") &&
|
|
|
464 return ($me, $you) unless $compare->position;
|
|
|
465
|
|
|
466 $you = $compare->position->numeric;
|
|
|
467 return ($me, $you);
|
|
|
468
|
|
|
469 } elsif( $compare->isa('Bio::Map::PositionI') ) {
|
|
|
470
|
|
|
471 $you = $compare->numeric;
|
|
|
472 return ($me, $you);
|
|
|
473
|
|
|
474 } else {
|
|
|
475 $self->warn("Can only run equals with Bio::Map::MappableI or ".
|
|
|
476 "Bio::Map::PositionI not [$compare]");
|
|
|
477 }
|
|
|
478 return ($me, $you);
|
|
|
479 }
|
|
|
480
|
|
|
481
|
|
|
482 =head2 equals
|
|
|
483
|
|
|
484 Title : equals
|
|
|
485 Usage : if( $mappable->equals($mapable2)) ...
|
|
|
486 Function: Test if a position is equal to another position
|
|
|
487 Returns : boolean
|
|
|
488 Args : Bio::Map::MappableI or Bio::Map::PositionI
|
|
|
489
|
|
|
490 =cut
|
|
|
491
|
|
|
492 sub equals {
|
|
|
493 my ($self,$compare) = @_;
|
|
|
494
|
|
|
495 my ($me, $you) = $self->tuple($compare);
|
|
|
496 return 0 if $me == -1 or $you == -1 ;
|
|
|
497 return $me == $you;
|
|
|
498 }
|
|
|
499
|
|
|
500 =head2 less_than
|
|
|
501
|
|
|
502 Title : less_than
|
|
|
503 Usage : if( $mappable->less_than($m2) ) ...
|
|
|
504 Function: Tests if a position is less than another position
|
|
|
505 Returns : boolean
|
|
|
506 Args : Bio::Map::MappableI or Bio::Map::PositionI
|
|
|
507
|
|
|
508 =cut
|
|
|
509
|
|
|
510 sub less_than {
|
|
|
511 my ($self,$compare) = @_;
|
|
|
512
|
|
|
513 my ($me, $you) = $self->tuple($compare);
|
|
|
514 return 0 if $me == -1 or $you == -1 ;
|
|
|
515 return $me < $you;
|
|
|
516 }
|
|
|
517
|
|
|
518 =head2 greater_than
|
|
|
519
|
|
|
520 Title : greater_than
|
|
|
521 Usage : if( $mappable->greater_than($m2) ) ...
|
|
|
522 Function: Tests if position is greater than another position
|
|
|
523 Returns : boolean
|
|
|
524 Args : Bio::Map::MappableI or Bio::Map::PositionI
|
|
|
525
|
|
|
526 =cut
|
|
|
527
|
|
|
528 sub greater_than {
|
|
|
529 my ($self,$compare) = @_;
|
|
|
530
|
|
|
531
|
|
|
532 my ($me, $you) = $self->tuple($compare);
|
|
|
533 return 0 if $me == -1 or $you == -1 ;
|
|
|
534 return $me > $you;
|
|
|
535 }
|
|
|
536
|
|
|
537 1;
|
