Bio/Map/Marker.pm

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