maint: restructure to use Dist::Zilla
[bioperl-live.git] / lib / Bio / Map / Marker.pm
blobb369996c0f8a01803fd3f79fb9b62e9b5353c7c6
2 # BioPerl module for Bio::Map::Marker
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Sendu Bala <bix@sendu.me.uk>
8 # Copyright Chad Matsalla
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
14 =head1 NAME
16 Bio::Map::Marker - An central map object representing a generic marker
17 that can have multiple location in several maps.
19 =head1 SYNOPSIS
21 # get map objects somehow
23 # a marker with complex localisation
24 $o_usat = Bio::Map::Marker->new(-name=>'Chad Super Marker 2',
25 -positions => [ [$map1, $position1],
26 [$map1, $position2]
27 ] );
29 # The markers deal with Bio::Map::Position objects which can also
30 # be explicitly created and passed on to markers as an array ref:
31 $o_usat2 = Bio::Map::Marker->new(-name=>'Chad Super Marker 3',
32 -positions => [ $pos1,
33 $pos2
34 ] );
36 # a marker with unique position in a map
37 $marker1 = Bio::Map::Marker->new(-name=>'hypervariable1',
38 -map => $map1,
39 -position => 100
42 # another way of creating a marker with unique position in a map:
43 $marker2 = Bio::Map::Marker->new(-name=>'hypervariable2');
44 $map1->add_element($marker2);
45 $marker2->position(100);
47 # position method is a short cut for get/setting unique positions
48 # which overwrites previous values
49 # to place a marker to other maps or to have multiple positions
50 # for a map within the same map use add_position()
52 $marker2->add_position(200); # new position in the same map
53 $marker2->add_position($map2,200); # new map
55 # setting a map() in a marker or adding a marker into a map are
56 # identical mathods. Both set the bidirectional connection which is
57 # used by the marker to remember its latest, default map.
59 # Regardes of how marker positions are created, they are stored and
60 # returned as Bio::Map::PositionI objects:
62 # unique position
63 print $marker1->position->value, "\n";
64 # several positions
65 foreach $pos ($marker2->each_position($map1)) {
66 print $pos->value, "\n";
69 See L<Bio::Map::Position> and L<Bio::Map::PositionI> for more information.
71 =head1 DESCRIPTION
73 A Marker is a Bio::Map::Mappable with some properties particular to markers.
74 It also offers a number of convienience methods to make dealing with map
75 elements easier.
77 =head1 FEEDBACK
79 =head2 Mailing Lists
81 User feedback is an integral part of the evolution of this and other
82 Bioperl modules. Send your comments and suggestions preferably to the
83 Bioperl mailing list. Your participation is much appreciated.
85 bioperl-l@bioperl.org - General discussion
86 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
88 =head2 Support
90 Please direct usage questions or support issues to the mailing list:
92 I<bioperl-l@bioperl.org>
94 rather than to the module maintainer directly. Many experienced and
95 reponsive experts will be able look at the problem and quickly
96 address it. Please include a thorough description of the problem
97 with code and data examples if at all possible.
99 =head2 Reporting Bugs
101 Report bugs to the Bioperl bug tracking system to help us keep track
102 of the bugs and their resolution. Bug reports can be submitted via the
103 web:
105 https://github.com/bioperl/bioperl-live/issues
107 =head1 AUTHOR - Chad Matsalla
109 Email bioinformatics1@dieselwurks.com
111 =head1 CONTRIBUTORS
113 Heikki Lehvaslaiho heikki-at-bioperl-dot-org
114 Lincoln Stein lstein@cshl.org
115 Jason Stajich jason@bioperl.org
116 Sendu Bala bix@sendu.me.uk
118 =head1 APPENDIX
120 The rest of the documentation details each of the object methods.
121 Internal methods are usually preceded with a _
123 =cut
125 # Let the code begin...
127 package Bio::Map::Marker;
128 use strict;
129 use Bio::Map::Position;
131 use base qw(Bio::Map::Mappable Bio::Map::MarkerI);
133 =head2 new
135 Title : new
136 Usage : my $marker = Bio::Map::Marker->new( -name => 'Whizzy marker',
137 -position => $position);
138 Function: Builds a new Bio::Map::Marker object
139 Returns : Bio::Map::Marker
140 Args :
141 -name => name of this microsatellite
142 [optional], string,default 'Unknown'
143 -default_map => the default map for this marker, a Bio::Map::MapI
144 -position => map position for this marker, a Bio::Map::PositionI
145 -positions => array ref of Bio::Map::PositionI objects
147 position and positions can also take as values anything the
148 corresponding methods can take
150 =cut
152 sub new {
153 my ($class, @args) = @_;
154 my $self = $class->SUPER::new(@args);
155 bless($self, ref $class || $class);
157 my ($name, $default_map, $map, $position, $positions) =
158 $self->_rearrange([qw(NAME
159 DEFAULT_MAP
161 POSITION
162 POSITIONS
163 )], @args);
165 if ($name) { $self->name($name); }
166 else {$self->name('Unnamed marker'); }
168 $map && $self->default_map($map);
169 $default_map && $self->default_map($default_map);
170 $position && $self->position($position);
171 $positions && $self->positions($positions);
173 return $self;
176 =head2 default_map
178 Title : default_map
179 Usage : my $map = $marker->default_map();
180 Function: Get/Set the default map for the marker.
181 Returns : L<Bio::Map::MapI>
182 Args : [optional] new L<Bio::Map::MapI>
184 =cut
186 sub default_map {
187 my ($self, $map) = @_;
188 if (defined $map) {
189 $self->thow("This is [$map], not Bio::Map::MapI object") unless $map->isa('Bio::Map::MapI');
190 $self->{'_default_map'} = $map;
192 return $self->{'_default_map'} || return;
195 =head2 map
197 Title : map
198 Function: This is a synonym of the default_map() method
200 *** does not actually add this marker to the map! ***
202 Status : deprecated, will be removed in next version
204 =cut
206 *map = \&default_map;
208 =head2 get_position_object
210 Title : get_position_class
211 Usage : my $position = $marker->get_position_object();
212 Function: To get an object of the default Position class
213 for this Marker. Subclasses should redefine this method.
214 The Position returned needs to be a L<Bio::Map::PositionI> with
215 -element set to self.
216 Returns : L<Bio::Map::PositionI>
217 Args : none for an 'empty' PositionI object, optionally
218 Bio::Map::MapI and value string to set the Position's -map and -value
219 attributes.
221 =cut
223 sub get_position_object {
224 my ($self, $map, $value) = @_;
225 $map ||= $self->default_map;
226 if ($value) {
227 $self->throw("Value better be scalar, not [$value]") unless ref($value) eq '';
230 my $pos = Bio::Map::Position->new();
231 $pos->map($map) if $map;
232 $pos->value($value) if defined($value);
233 $pos->element($self);
234 return $pos;
237 =head2 position
239 Title : position
240 Usage : my $position = $mappable->position();
241 $mappable->position($position);
242 Function: Get/Set the Position of this Marker (where it is on which map),
243 purging all other positions before setting.
244 Returns : L<Bio::Map::PositionI>
245 Args : Bio::Map::PositionI
247 Bio::Map::MapI AND
248 scalar
250 scalar, but only if the marker has a default map
252 =cut
254 sub position {
255 my ($self, $pos, $pos_actual) = @_;
257 if ($pos) {
258 $self->purge_positions;
259 $self->add_position($pos, $pos_actual);
262 my @positions = $self->each_position;
263 $self->warn('This marker has more than one Position, returning the most recently added') if scalar @positions > 1;
264 return pop(@positions);
267 =head2 add_position
269 Title : add_position
270 Usage : $marker->add_position($position);
271 Function: Add a Position to this marker
272 Returns : n/a
273 Args : Bio::Map::PositionI
275 Bio::Map::MapI AND
276 scalar
278 scalar, but only if the marker has a default map
280 =cut
282 sub add_position {
283 my ($self, $pos, $pos_actual) = @_;
284 $self->throw("Must give a Position") unless defined $pos;
286 my $map = $self->default_map;
287 my $pos_map;
288 if (ref($pos)) {
289 if (ref($pos) eq 'ARRAY') {
290 ($pos, $pos_actual) = @{$pos};
291 unless ($pos && $pos_actual && ref($pos)) {
292 $self->throw("Supplied an array ref but did not contain two values, the first an object");
296 if ($pos->isa('Bio::Map::PositionI')) {
297 $pos_map = $pos->map;
298 $self->default_map($pos_map) unless $map;
299 $map = $pos_map if $pos_map;
301 elsif ($pos->isa('Bio::Map::MapI')) {
302 $self->default_map($pos) unless $map;
303 $map = $pos;
304 $pos = $pos_actual;
306 else {
307 $self->throw("This is [$pos], not a Bio::Map::PositionI or Bio::Map::MapI object");
311 $self->throw("You need to give a marker a default map before you can set positions without explicit map!" ) unless $map;
313 if (ref($pos) && $pos->isa('Bio::Map::PositionI')) {
314 $pos->map($map) unless $pos_map;
315 $self->SUPER::add_position($pos);
317 else {
318 $self->get_position_object($map, $pos); # adds position to us
322 =head2 positions
324 Title : positions
325 Usage : $marker->positions([$pos1, $pos2, $pos3]);
326 Function: Add multiple Bio::Map::PositionI to this marker
327 Returns : n/a
328 Args : array ref of $map/value tuples or array ref of Bio::Map::PositionI
330 =cut
332 sub positions {
333 my ($self, $args_ref) = @_;
335 foreach my $arg (@{$args_ref}) {
336 if (ref($arg) eq 'ARRAY') {
337 $self->add_position(@{$arg});
339 else {
340 $self->add_position($arg);
345 =head2 in_map
347 Title : in_map
348 Usage : if ( $marker->in_map($map) ) {}
349 Function: Tests if this marker is found on a specific map
350 Returns : boolean
351 Args : a map unique id OR Bio::Map::MapI
353 =cut
355 sub in_map {
356 my ($self, $query) = @_;
357 $self->throw("Must supply an argument") unless defined($query);
359 if (ref($query) eq '') {
360 foreach my $map ($self->known_maps) {
361 my $uid = $map->unique_id;
362 if ($uid) {
363 ($uid eq $query) && return 1;
367 else {
368 return $self->SUPER::in_map($query);
371 return 0;