lib/Bio/Map/Marker.pm

   1 #
   2 # BioPerl module for Bio::Map::Marker
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Sendu Bala <bix@sendu.me.uk>
   7 #
   8 # Copyright Chad Matsalla
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::Map::Marker - An central map object representing a generic marker
  17 that can have multiple location in several maps.
  18
  19 =head1 SYNOPSIS
  20
  21   # get map objects somehow
  22
  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                                                 ] );
  28
  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                                                 ] );
  35
  36   # a marker with unique position in a map
  37   $marker1 = Bio::Map::Marker->new(-name=>'hypervariable1',
  38                                    -map => $map1,
  39                                    -position => 100
  40                                    );
  41
  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);
  46
  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()
  51
  52   $marker2->add_position(200);  # new position in the same map
  53   $marker2->add_position($map2,200); # new map
  54
  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.
  58
  59   # Regardes of how marker positions are created, they are stored and
  60   # returned as Bio::Map::PositionI objects:
  61
  62   # unique position
  63   print $marker1->position->value, "\n";
  64   # several positions
  65   foreach $pos ($marker2->each_position($map1)) {
  66      print $pos->value, "\n";
  67   }
  68
  69 See L<Bio::Map::Position> and L<Bio::Map::PositionI> for more information.
  70
  71 =head1 DESCRIPTION
  72
  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.
  76
  77 =head1 FEEDBACK
  78
  79 =head2 Mailing Lists
  80
  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.
  84
  85   bioperl-l@bioperl.org                  - General discussion
  86   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  87
  88 =head2 Support
  89
  90 Please direct usage questions or support issues to the mailing list:
  91
  92 I<bioperl-l@bioperl.org>
  93
  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.
  98
  99 =head2 Reporting Bugs
 100
 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:
 104
 105   https://github.com/bioperl/bioperl-live/issues
 106
 107 =head1 AUTHOR - Chad Matsalla
 108
 109 Email bioinformatics1@dieselwurks.com
 110
 111 =head1 CONTRIBUTORS
 112
 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
 117
 118 =head1 APPENDIX
 119
 120 The rest of the documentation details each of the object methods.
 121 Internal methods are usually preceded with a _
 122
 123 =cut
 124
 125 # Let the code begin...
 126
 127 package Bio::Map::Marker;
 128 use strict;
 129 use Bio::Map::Position;
 130
 131 use base qw(Bio::Map::Mappable Bio::Map::MarkerI);
 132
 133 =head2 new
 134
 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
 146
 147            position and positions can also take as values anything the
 148            corresponding methods can take
 149
 150 =cut
 151
 152 sub new {
 153     my ($class, @args) = @_;
 154     my $self = $class->SUPER::new(@args);
 155         bless($self, ref $class || $class);
 156
 157     my ($name, $default_map, $map, $position, $positions) =
 158         $self->_rearrange([qw(NAME
 159                                   DEFAULT_MAP
 160                               MAP
 161                               POSITION
 162                               POSITIONS
 163                               )], @args);
 164
 165     if ($name) { $self->name($name); }
 166     else {$self->name('Unnamed marker'); }
 167
 168     $map         && $self->default_map($map);
 169         $default_map && $self->default_map($default_map);
 170     $position    && $self->position($position);
 171     $positions   && $self->positions($positions);
 172
 173     return $self;
 174 }
 175
 176 =head2 default_map
 177
 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>
 183
 184 =cut
 185
 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;
 191         }
 192         return $self->{'_default_map'} || return;
 193 }
 194
 195 =head2 map
 196
 197  Title   : map
 198  Function: This is a synonym of the default_map() method
 199
 200                    *** does not actually add this marker to the map! ***
 201
 202  Status  : deprecated, will be removed in next version
 203
 204 =cut
 205
 206 *map = \&default_map;
 207
 208 =head2 get_position_object
 209
 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.
 220
 221 =cut
 222
 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 '';
 228         }
 229
 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;
 235 }
 236
 237 =head2 position
 238
 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
 246             OR
 247            Bio::Map::MapI AND
 248            scalar
 249             OR
 250            scalar, but only if the marker has a default map
 251
 252 =cut
 253
 254 sub position {
 255     my ($self, $pos, $pos_actual) = @_;
 256
 257         if ($pos) {
 258                 $self->purge_positions;
 259                 $self->add_position($pos, $pos_actual);
 260         }
 261
 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);
 265 }
 266
 267 =head2 add_position
 268
 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
 274             OR
 275            Bio::Map::MapI AND
 276            scalar
 277             OR
 278            scalar, but only if the marker has a default map
 279
 280 =cut
 281
 282 sub add_position  {
 283     my ($self, $pos, $pos_actual) = @_;
 284     $self->throw("Must give a Position") unless defined $pos;
 285
 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");
 293                         }
 294                 }
 295
 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;
 300                 }
 301                 elsif ($pos->isa('Bio::Map::MapI')) {
 302                         $self->default_map($pos) unless $map;
 303                         $map = $pos;
 304                         $pos = $pos_actual;
 305                 }
 306                 else {
 307                         $self->throw("This is [$pos], not a Bio::Map::PositionI or Bio::Map::MapI object");
 308                 }
 309         }
 310
 311         $self->throw("You need to give a marker a default map before you can set positions without explicit map!" ) unless $map;
 312
 313         if (ref($pos) && $pos->isa('Bio::Map::PositionI')) {
 314                 $pos->map($map) unless $pos_map;
 315                 $self->SUPER::add_position($pos);
 316         }
 317         else {
 318                 $self->get_position_object($map, $pos); # adds position to us
 319         }
 320 }
 321
 322 =head2 positions
 323
 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
 329
 330 =cut
 331
 332 sub positions {
 333     my ($self, $args_ref) = @_;
 334
 335     foreach my $arg (@{$args_ref}) {
 336         if (ref($arg) eq 'ARRAY') {
 337             $self->add_position(@{$arg});
 338         }
 339         else {
 340             $self->add_position($arg);
 341         }
 342     }
 343 }
 344
 345 =head2 in_map
 346
 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
 352
 353 =cut
 354
 355 sub in_map {
 356         my ($self, $query) = @_;
 357         $self->throw("Must supply an argument") unless defined($query);
 358
 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;
 364                         }
 365                 }
 366         }
 367     else {
 368                 return $self->SUPER::in_map($query);
 369         }
 370
 371     return 0;
 372 }
 373
 374 1;