Bio/Map/SimpleMap.pm

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