Bio/Map/SimpleMap.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Map::SimpleMap
   4 #
   5 # Cared for by Sendu Bala <bix@sendu.me.uk>
   6 #
   7 # Copyright Jason Stajich
   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::SimpleMap - A MapI implementation handling the basics of a Map
  16
  17 =head1 SYNOPSIS
  18
  19     use Bio::Map::SimpleMap;
  20
  21     my $map = Bio::Map::SimpleMap->new(-name => 'genethon',
  22                                       -type => 'Genetic',
  23                                       -units=> 'cM',
  24                                       -species => $human);
  25
  26     foreach my $marker ( @markers ) { # get a list of markers somewhere
  27                 $map->add_element($marker);
  28     }
  29
  30     foreach my $marker ($map->get_elements) {
  31         # do something with this Bio::Map::MappableI
  32     }
  33
  34 =head1 DESCRIPTION
  35
  36 This is the basic implementation of a Bio::Map::MapI. It handles the
  37 essential storage of name, species, type, and units.
  38
  39 It knows which map elements (mappables) belong to it, and their
  40 position.
  41
  42 Subclasses might need to redefine or hardcode type(), length() and
  43 units().
  44
  45 =head1 FEEDBACK
  46
  47 =head2 Mailing Lists
  48
  49 User feedback is an integral part of the evolution of this and other
  50 Bioperl modules. Send your comments and suggestions preferably to
  51 the Bioperl mailing list.  Your participation is much appreciated.
  52
  53   bioperl-l@bioperl.org                  - General discussion
  54   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  55
  56 =head2 Reporting Bugs
  57
  58 Report bugs to the Bioperl bug tracking system to help us keep track
  59 of the bugs and their resolution. Bug reports can be submitted via the
  60 web:
  61
  62   http://bugzilla.open-bio.org/
  63
  64 =head1 AUTHOR - Jason Stajich
  65
  66 Email jason@bioperl.org
  67
  68 =head1 CONTRIBUTORS
  69
  70 Heikki Lehvaslaiho heikki-at-bioperl-dot-org
  71 Lincoln Stein      lstein@cshl.org
  72 Sendu Bala         bix@sendu.me.uk
  73
  74 =head1 APPENDIX
  75
  76 The rest of the documentation details each of the object methods.
  77 Internal methods are usually preceded with a _
  78
  79 =cut
  80
  81 # Let the code begin...
  82
  83 package Bio::Map::SimpleMap;
  84 use vars qw($MAPCOUNT);
  85 use strict;
  86
  87
  88 use base qw(Bio::Root::Root Bio::Map::MapI);
  89 BEGIN { $MAPCOUNT = 1; }
  90
  91 =head2 new
  92
  93  Title   : new
  94  Usage   : my $obj = Bio::Map::SimpleMap->new();
  95  Function: Builds a new Bio::Map::SimpleMap object
  96  Returns : Bio::Map::SimpleMap
  97  Args    : -name    => name of map (string)
  98            -species => species for this map (Bio::Species) [optional]
  99            -units   => map units (string)
 100            -uid     => Unique Id [defaults to a unique integer]
 101
 102 =cut
 103
 104 sub new {
 105   my($class,@args) = @_;
 106
 107   my $self = $class->SUPER::new(@args);
 108
 109   $self->{'_name'}     = '';
 110   $self->{'_species'}  = '';
 111   $self->{'_units'}    = '';
 112   $self->{'_type'}    = '';
 113   $self->{'_uid'} = $MAPCOUNT++;
 114   my ($name, $type,$species, $units,$uid) = $self->_rearrange([qw(NAME TYPE
 115                                               SPECIES UNITS
 116                                               UID)], @args);
 117   defined $name     && $self->name($name);
 118   defined $species  && $self->species($species);
 119   defined $units    && $self->units($units);
 120   defined $type     && $self->type($type);
 121   defined $uid      && $self->unique_id($uid);
 122
 123   return $self;
 124 }
 125
 126 =head2 species
 127
 128  Title   : species
 129  Usage   : my $species = $map->species;
 130  Function: Get/Set Species for a map
 131  Returns : Bio::Taxon object or string
 132  Args    : (optional) Bio::Taxon or string
 133
 134 =cut
 135
 136 sub species{
 137    my ($self,$value) = @_;
 138    if( defined $value ) {
 139        $self->{'_species'} = $value;
 140    }
 141    return $self->{'_species'};
 142 }
 143
 144 =head2 units
 145
 146  Title   : units
 147  Usage   : $map->units('cM');
 148  Function: Get/Set units for a map
 149  Returns : units for a map
 150  Args    : units for a map (string)
 151
 152 =cut
 153
 154 sub units{
 155    my ($self,$value) = @_;
 156    if( defined $value ) {
 157        $self->{'_units'} = $value;
 158    }
 159    return $self->{'_units'};
 160 }
 161
 162 =head2 type
 163
 164  Title   : type
 165  Usage   : my $type = $map->type
 166  Function: Get/Set Map type
 167  Returns : String coding map type
 168  Args    : (optional) string
 169
 170 =cut
 171
 172 sub type {
 173    my ($self,$value) = @_;
 174    # this may be hardcoded/overriden by subclasses
 175
 176    if( defined $value ) {
 177        $self->{'_type'} = $value;
 178    }
 179    return $self->{'_type'};
 180 }
 181
 182 =head2 name
 183
 184  Title   : name
 185  Usage   : my $name = $map->name
 186  Function: Get/Set Map name
 187  Returns : Map name
 188  Args    : (optional) string
 189
 190 =cut
 191
 192 sub name {
 193    my ($self,$value) = @_;
 194    if( defined $value ) {
 195        $self->{'_name'} = $value;
 196    }
 197    return $self->{'_name'};
 198 }
 199
 200 =head2 length
 201
 202  Title   : length
 203  Usage   : my $length = $map->length();
 204  Function: Retrieves the length of the map.
 205            It is possible for the length to be unknown for maps such as
 206            Restriction Enzyme, will return 0 in that case.
 207  Returns : integer representing length of map in current units
 208            will return 0 if length is not calculateable
 209  Args    : none
 210
 211 =cut
 212
 213 sub length {
 214         my $self = shift;
 215
 216         my $len = 0;
 217     foreach my $element ($self->get_elements) {
 218         foreach my $pos ($element->get_positions($self)) {
 219             if ($pos->value) {
 220                 $len = $pos->end if $pos->end > $len;
 221             }
 222         }
 223         }
 224
 225         return $len;
 226 }
 227
 228 =head2 unique_id
 229
 230  Title   : unique_id
 231  Usage   : my $id = $map->unique_id;
 232  Function: Get/Set the unique ID for this map
 233  Returns : a unique identifier
 234  Args    : [optional] new identifier to set
 235
 236 =cut
 237
 238 sub unique_id {
 239    my ($self,$id) = @_;
 240    if( defined $id ) {
 241        $self->{'_uid'} = $id;
 242    }
 243    return $self->{'_uid'};
 244 }
 245
 246 =head2 add_element
 247
 248  Title   : add_element
 249  Usage   : $map->add_element($element)
 250  Function: Tell a Bio::Map::MappableI object its default Map is this one; same
 251            as calling $element->default_map($map).
 252
 253                    *** does not actually add the element to this map! ***
 254
 255  Returns : none
 256  Args    : Bio::Map::MappableI object
 257  Status  : Deprecated, will be removed in next version
 258
 259 =cut
 260
 261 sub add_element {
 262     my ($self, $element) = @_;
 263     return unless $element;
 264
 265     $self->throw("This is not a Bio::Map::MappableI object but a [$element]")
 266         unless $element->isa('Bio::Map::MappableI');
 267
 268     $element->default_map($self);
 269 }
 270
 271 =head2 get_elements
 272
 273  Title   : get_elements
 274  Usage   : my @elements = $map->get_elements;
 275  Function: Retrieves all the elements on a map (unordered unless all elements
 276            have just 1 position on the map, in which case sorted)
 277  Returns : Array of Map elements (L<Bio::Map::MappableI>)
 278  Args    : none
 279
 280 =cut
 281
 282 sub get_elements {
 283         my $self = shift;
 284
 285     my @elements = $self->SUPER::get_elements;
 286
 287         # for backward compatability with MapIO tests, and for 'niceness', when
 288         # there is only 1 position per element we will return the elements in
 289         # order, as long as the positions have values set
 290     my $only_1 = 1;
 291     foreach my $element (@elements) {
 292         my @positions = $element->get_positions($self);
 293         if (@positions > 1 || (@positions == 1 && ! $positions[0]->value)) {
 294             $only_1 = 0;
 295         }
 296     }
 297         if ($only_1) {
 298                 @elements = map { $_->[1] }
 299                     sort { $a->[0] <=> $b->[0] }
 300                     map { [${[$_->get_positions($self)]}[0]->sortable, $_] }
 301                     @elements;
 302         }
 303
 304         return @elements;
 305 }
 306
 307 =head2 each_element
 308
 309  Title   : each_element
 310  Function: Synonym of the get_elements() method.
 311  Status  : deprecated, will be removed in the next version
 312
 313 =cut
 314
 315 *each_element = \&get_elements;
 316
 317 =head2 purge_element
 318
 319  Title   : purge_element
 320  Usage   : $map->purge_element($element)
 321  Function: Purge an element from the map.
 322  Returns : none
 323  Args    : Bio::Map::MappableI object
 324
 325 =cut
 326
 327 sub purge_element {
 328     my ($self, $element) = @_;
 329     $self->throw("Must supply an argument") unless $element;
 330     $self->throw("This is [$element], not an object") unless ref($element);
 331     $self->throw("This is [$element], not a Bio::Map::MappableI object") unless $element->isa('Bio::Map::MappableI');
 332
 333         $self->purge_positions($element);
 334 }
 335
 336 =head2 annotation
 337
 338  Title   : annotation
 339  Usage   : $map->annotation($an_col);
 340            my $an_col = $map->annotation();
 341  Function: Get the annotation collection (see Bio::AnnotationCollectionI)
 342            for this annotatable object.
 343  Returns : a Bio::AnnotationCollectionI implementing object, or undef
 344  Args    : none to get, OR
 345            a Bio::AnnotationCollectionI implementing object to set
 346
 347 =cut
 348
 349 sub annotation {
 350     my $self = shift;
 351     if (@_) { $self->{_annotation} = shift }
 352     return $self->{_annotation} || return;
 353 }
 354
 355 1;