Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/Map/Position.pm @ 0:1f6dce3d34e0
Uploaded
| author | mahtabm | 
|---|---|
| date | Thu, 11 Apr 2013 02:01:53 -0400 | 
| parents | |
| children | 
   comparison
  equal
  deleted
  inserted
  replaced
| -1:000000000000 | 0:1f6dce3d34e0 | 
|---|---|
| 1 # $Id: Position.pm,v 1.9 2002/10/22 07:45:16 lapp Exp $ | |
| 2 # | |
| 3 # BioPerl module for Bio::Map::Position | |
| 4 # | |
| 5 # Cared for by Jason Stajich <jason@bioperl.org> | |
| 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::Position - A single position of a Marker in a Map | |
| 16 | |
| 17 =head1 SYNOPSIS | |
| 18 | |
| 19 use Bio::Map::Position; | |
| 20 my $position = new Bio::Map::Position(-map => $map, | |
| 21 -marker => $marker | |
| 22 -value => 100 | |
| 23 ); | |
| 24 | |
| 25 =head1 DESCRIPTION | |
| 26 | |
| 27 This object is an implementation of the PositionI interface that | |
| 28 handles the specific values of a position. This allows an element | |
| 29 (e.g. Marker) to have multiple positions within a map and still be | |
| 30 treated as a single entity. | |
| 31 | |
| 32 This does not directly handle the concept of a relative map in which | |
| 33 no known exact positions exist but markers are just ordered relative | |
| 34 to one another - in that case arbitrary values must be assigned for | |
| 35 position values. | |
| 36 | |
| 37 No units are assumed here - units are handled by context of which Map | |
| 38 a position is placed in or the subclass of this Position. | |
| 39 | |
| 40 =head1 FEEDBACK | |
| 41 | |
| 42 =head2 Mailing Lists | |
| 43 | |
| 44 User feedback is an integral part of the evolution of this and other | |
| 45 Bioperl modules. Send your comments and suggestions preferably to | |
| 46 the Bioperl mailing list. Your participation is much appreciated. | |
| 47 | |
| 48 bioperl-l@bioperl.org - General discussion | |
| 49 http://bioperl.org/MailList.shtml - About the mailing lists | |
| 50 | |
| 51 =head2 Reporting Bugs | |
| 52 | |
| 53 Report bugs to the Bioperl bug tracking system to help us keep track | |
| 54 of the bugs and their resolution. Bug reports can be submitted via | |
| 55 email or the web: | |
| 56 | |
| 57 bioperl-bugs@bioperl.org | |
| 58 http://bugzilla.bioperl.org/ | |
| 59 | |
| 60 =head1 AUTHOR - Jason Stajich | |
| 61 | |
| 62 Email jason@bioperl.org | |
| 63 | |
| 64 Describe contact details here | |
| 65 | |
| 66 =head1 CONTRIBUTORS | |
| 67 | |
| 68 Lincoln Stein, lstein@cshl.org | |
| 69 Heikki Lehvaslaiho, heikki@ebi.ac.uk | |
| 70 Chad Matsalla, bioinformatics1@dieselwurks.com | |
| 71 | |
| 72 =head1 APPENDIX | |
| 73 | |
| 74 The rest of the documentation details each of the object methods. | |
| 75 Internal methods are usually preceded with a _ | |
| 76 | |
| 77 =cut | |
| 78 | |
| 79 | |
| 80 # Let the code begin... | |
| 81 | |
| 82 | |
| 83 package Bio::Map::Position; | |
| 84 use vars qw(@ISA); | |
| 85 use strict; | |
| 86 | |
| 87 # Object preamble - inherits from Bio::Root::Root | |
| 88 | |
| 89 use Bio::Root::Root; | |
| 90 use Bio::Map::PositionI; | |
| 91 | |
| 92 @ISA = qw(Bio::Root::Root Bio::Map::PositionI ); | |
| 93 | |
| 94 =head2 new | |
| 95 | |
| 96 Title : new | |
| 97 Usage : my $obj = new Bio::Map::Position(); | |
| 98 Function: Builds a new Bio::Map::Position object | |
| 99 Returns : Bio::Map::Position | |
| 100 Args : -map a <Bio::Map::MapI> object | |
| 101 -marker a <Bio::Map::MarkerI> object | |
| 102 -value string or number | |
| 103 | |
| 104 =cut | |
| 105 | |
| 106 sub new { | |
| 107 my($class,@args) = @_; | |
| 108 my $self = $class->SUPER::new(@args); | |
| 109 | |
| 110 my ($map, $marker, $value) = | |
| 111 $self->_rearrange([qw( MAP | |
| 112 MARKER | |
| 113 VALUE | |
| 114 )], @args); | |
| 115 | |
| 116 $map && $self->map($map); | |
| 117 $marker && $self->marker($marker); | |
| 118 $value && $self->value($value); | |
| 119 | |
| 120 return $self; | |
| 121 } | |
| 122 | |
| 123 =head2 map | |
| 124 | |
| 125 Title : map | |
| 126 Usage : my $id = map->$map; | |
| 127 Function: Get/Set the map the position is in. | |
| 128 Returns : L<Bio::Map::MapI> | |
| 129 Args : [optional] new L<Bio::Map::MapI> | |
| 130 | |
| 131 =cut | |
| 132 | |
| 133 sub map { | |
| 134 my ($self,$map) = @_; | |
| 135 if( defined $map ) { | |
| 136 $self->throw("This is [$map], not a Bio::Map::MapI object") | |
| 137 unless $map->isa('Bio::Map::MapI'); | |
| 138 $self->{'_map'} = $map; | |
| 139 } | |
| 140 return $self->{'_map'}; | |
| 141 } | |
| 142 | |
| 143 =head2 marker | |
| 144 | |
| 145 Title : marker | |
| 146 Usage : my $id = marker->$marker; | |
| 147 Function: Get/Set the marker the position is in. | |
| 148 Returns : L<Bio::Map::MarkerI> | |
| 149 Args : [optional] new L<Bio::Map::MarkerI> | |
| 150 | |
| 151 =cut | |
| 152 | |
| 153 sub marker { | |
| 154 my ($self,$marker) = @_; | |
| 155 if( defined $marker ) { | |
| 156 $self->thow("This is [$marker], not a Bio::Map::MarkerI object") | |
| 157 unless $marker->isa('Bio::Map::MarkerI'); | |
| 158 $self->{'_marker'} = $marker; | |
| 159 } | |
| 160 return $self->{'_marker'}; | |
| 161 } | |
| 162 | |
| 163 =head2 value | |
| 164 | |
| 165 Title : value | |
| 166 Usage : my $pos = $position->value; | |
| 167 Function: Get/Set the value for this postion | |
| 168 Returns : scalar, value | |
| 169 Args : [optional] new value to set | |
| 170 | |
| 171 =cut | |
| 172 | |
| 173 sub value { | |
| 174 my ($self,$value) = @_; | |
| 175 if( defined $value ) { | |
| 176 $self->{'_value'} = $value; | |
| 177 } | |
| 178 return $self->{'_value'}; | |
| 179 } | |
| 180 | |
| 181 =head2 numeric | |
| 182 | |
| 183 Title : numeric | |
| 184 Usage : my $num = $position->numeric; | |
| 185 Function: Read-only method that is guarantied to return a numeric | |
| 186 representation for this position. | |
| 187 Returns : numeric (int or real) | |
| 188 Args : none | |
| 189 | |
| 190 =cut | |
| 191 | |
| 192 sub numeric { | |
| 193 my ($self) = @_; | |
| 194 my $num = $self->{'_value'} || 0; | |
| 195 | |
| 196 # expand this to cover scientific notation, too! | |
| 197 $self->throw("This value [$num] is not numeric!") | |
| 198 unless $num && $num =~ /^[+-]?[\d.]+$/; | |
| 199 return $num; | |
| 200 } | |
| 201 | |
| 202 1; | 
