Bio/Map/Marker.pm

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