0
|
1 # $Id: SimpleMap.pm,v 1.8 2002/10/22 07:45:16 lapp Exp $
|
|
2 #
|
|
3 # BioPerl module for Bio::Map::SimpleMap
|
|
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::SimpleMap - A MapI implementation handling the basics of a Map
|
|
16
|
|
17 =head1 SYNOPSIS
|
|
18
|
|
19 use Bio::Map::SimpleMap;
|
|
20 my $map = new Bio::Map::SimpleMap(-name => 'genethon',
|
|
21 -type => 'Genetic',
|
|
22 -units=> 'cM',
|
|
23 -species => $human);
|
|
24 foreach my $marker ( @markers ) { # get a list of markers somewhere
|
|
25 $map->add_element($marker);
|
|
26 }
|
|
27
|
|
28 =head1 DESCRIPTION
|
|
29
|
|
30 This is the basic implementation of a Bio::Map::MapI. It handles the
|
|
31 essential storage of name, species, type, and units as well as in
|
|
32 memory representation of the elements of a map.
|
|
33
|
|
34 Subclasses might need to redefine or hardcode type(), length() and
|
|
35 units().
|
|
36
|
|
37 =head1 FEEDBACK
|
|
38
|
|
39 =head2 Mailing Lists
|
|
40
|
|
41 User feedback is an integral part of the evolution of this and other
|
|
42 Bioperl modules. Send your comments and suggestions preferably to
|
|
43 the Bioperl mailing list. Your participation is much appreciated.
|
|
44
|
|
45 bioperl-l@bioperl.org - General discussion
|
|
46 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
47
|
|
48 =head2 Reporting Bugs
|
|
49
|
|
50 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
51 of the bugs and their resolution. Bug reports can be submitted via
|
|
52 email or the web:
|
|
53
|
|
54 bioperl-bugs@bioperl.org
|
|
55 http://bugzilla.bioperl.org/
|
|
56
|
|
57 =head1 AUTHOR - Jason Stajich
|
|
58
|
|
59 Email jason@bioperl.org
|
|
60
|
|
61 =head1 CONTRIBUTORS
|
|
62
|
|
63 Heikki Lehvaslaiho heikki@ebi.ac.uk
|
|
64 Lincoln Stein lstein@cshl.org
|
|
65
|
|
66 =head1 APPENDIX
|
|
67
|
|
68 The rest of the documentation details each of the object methods.
|
|
69 Internal methods are usually preceded with a _
|
|
70
|
|
71 =cut
|
|
72
|
|
73
|
|
74 # Let the code begin...
|
|
75
|
|
76
|
|
77 package Bio::Map::SimpleMap;
|
|
78 use vars qw(@ISA $MAPCOUNT);
|
|
79 use strict;
|
|
80
|
|
81 # Object preamble - inherits from Bio::Root::Root
|
|
82
|
|
83 use Bio::Root::Root;
|
|
84 use Bio::Map::MapI;
|
|
85
|
|
86 @ISA = qw(Bio::Root::Root Bio::Map::MapI);
|
|
87 BEGIN { $MAPCOUNT = 1; }
|
|
88
|
|
89 =head2 new
|
|
90
|
|
91 Title : new
|
|
92 Usage : my $obj = new Bio::Map::SimpleMap();
|
|
93 Function: Builds a new Bio::Map::SimpleMap object
|
|
94 Returns : Bio::Map::SimpleMap
|
|
95 Args : -name => name of map (string)
|
|
96 -species => species for this map (Bio::Species) [optional]
|
|
97 -units => map units (string)
|
|
98 -elements=> elements to initialize with
|
|
99 (arrayref of Bio::Map::MappableI objects) [optional]
|
|
100
|
|
101 -uid => Unique Id
|
|
102 =cut
|
|
103
|
|
104 sub new {
|
|
105 my($class,@args) = @_;
|
|
106
|
|
107 my $self = $class->SUPER::new(@args);
|
|
108
|
|
109 $self->{'_elements'} = [];
|
|
110 $self->{'_name'} = '';
|
|
111 $self->{'_species'} = '';
|
|
112 $self->{'_units'} = '';
|
|
113 $self->{'_type'} = '';
|
|
114 $self->{'_uid'} = $MAPCOUNT++;
|
|
115 my ($name, $type,$species, $units,
|
|
116 $elements,$uid) = $self->_rearrange([qw(NAME TYPE
|
|
117 SPECIES UNITS
|
|
118 ELEMENTS UID)], @args);
|
|
119 defined $name && $self->name($name);
|
|
120 defined $species && $self->species($species);
|
|
121 defined $units && $self->units($units);
|
|
122 defined $type && $self->type($type);
|
|
123 defined $uid && $self->unique_id($uid);
|
|
124
|
|
125 if( $elements && ref($elements) =~ /array/ ) {
|
|
126 foreach my $item ( @$elements ) {
|
|
127 $self->add_element($item);
|
|
128 }
|
|
129 }
|
|
130 return $self;
|
|
131 }
|
|
132
|
|
133 =head2 species
|
|
134
|
|
135 Title : species
|
|
136 Usage : my $species = $map->species;
|
|
137 Function: Get/Set Species for a map
|
|
138 Returns : Bio::Species object or string
|
|
139 Args : (optional) Bio::Species or string
|
|
140
|
|
141 =cut
|
|
142
|
|
143 sub species{
|
|
144 my ($self,$value) = @_;
|
|
145 if( defined $value ) {
|
|
146 $self->{'_species'} = $value;
|
|
147 }
|
|
148 return $self->{'_species'};
|
|
149 }
|
|
150
|
|
151 =head2 units
|
|
152
|
|
153 Title : units
|
|
154 Usage : $map->units('cM');
|
|
155 Function: Get/Set units for a map
|
|
156 Returns : units for a map
|
|
157 Args : units for a map (string)
|
|
158
|
|
159 =cut
|
|
160
|
|
161 sub units{
|
|
162 my ($self,$value) = @_;
|
|
163 if( defined $value ) {
|
|
164 $self->{'_units'} = $value;
|
|
165 }
|
|
166 return $self->{'_units'};
|
|
167 }
|
|
168
|
|
169 =head2 type
|
|
170
|
|
171 Title : type
|
|
172 Usage : my $type = $map->type
|
|
173 Function: Get/Set Map type
|
|
174 Returns : String coding map type
|
|
175 Args : (optional) string
|
|
176
|
|
177 =cut
|
|
178
|
|
179 sub type {
|
|
180 my ($self,$value) = @_;
|
|
181 # this may be hardcoded/overriden by subclasses
|
|
182
|
|
183 if( defined $value ) {
|
|
184 $self->{'_type'} = $value;
|
|
185 }
|
|
186 return $self->{'_type'};
|
|
187 }
|
|
188
|
|
189
|
|
190 =head2 name
|
|
191
|
|
192 Title : name
|
|
193 Usage : my $name = $map->name
|
|
194 Function: Get/Set Map name
|
|
195 Returns : Map name
|
|
196 Args : (optional) string
|
|
197
|
|
198 =cut
|
|
199
|
|
200 sub name {
|
|
201 my ($self,$value) = @_;
|
|
202 if( defined $value ) {
|
|
203 $self->{'_name'} = $value;
|
|
204 }
|
|
205 return $self->{'_name'};
|
|
206 }
|
|
207
|
|
208 =head2 length
|
|
209
|
|
210 Title : length
|
|
211 Usage : my $length = $map->length();
|
|
212 Function: Retrieves the length of the map,
|
|
213 It is possible for the length to be unknown
|
|
214 for maps such as Restriction Enzyme, will return undef
|
|
215 in that case
|
|
216 Returns : integer representing length of map in current units
|
|
217 will return undef if length is not calculateable
|
|
218 Args : none
|
|
219
|
|
220 =cut
|
|
221
|
|
222 sub length {
|
|
223 my ($self) = @_;
|
|
224 my ($len ) = 0;
|
|
225
|
|
226 foreach my $marker ($self->each_element) {
|
|
227 $len = $marker->position->numeric if $marker->position->numeric > $len;
|
|
228 }
|
|
229 return $len;
|
|
230 }
|
|
231
|
|
232
|
|
233 =head2 unique_id
|
|
234
|
|
235 Title : unique_id
|
|
236 Usage : my $id = $map->unique_id;
|
|
237 Function: Get/Set the unique ID for this map
|
|
238 Returns : a unique identifier
|
|
239 Args : [optional] new identifier to set
|
|
240
|
|
241 =cut
|
|
242
|
|
243 sub unique_id {
|
|
244 my ($self,$id) = @_;
|
|
245 if( defined $id ) {
|
|
246 $self->{'_uid'} = $id;
|
|
247 }
|
|
248 return $self->{'_uid'};
|
|
249 }
|
|
250
|
|
251
|
|
252 =head2 add_element
|
|
253
|
|
254 Title : add_element
|
|
255 Usage : $map->add_element($marker)
|
|
256 Function: Add a Bio::Map::MappableI object to the Map
|
|
257 Returns : none
|
|
258 Args : Bio::Map::MappableI object
|
|
259
|
|
260 =cut
|
|
261
|
|
262 sub add_element{
|
|
263 my ($self,$mapelement) = @_;
|
|
264 return unless ( defined $mapelement);
|
|
265
|
|
266 $self->throw("This is not a Bio::Map::MarkerI object but a [$self]")
|
|
267 unless $mapelement->isa('Bio::Map::MarkerI');
|
|
268
|
|
269 $mapelement->map($self); # tell the marker its default map
|
|
270
|
|
271 push @{$self->{'_elements'}}, $mapelement;
|
|
272
|
|
273 }
|
|
274
|
|
275 =head2 each_element
|
|
276
|
|
277 Title : each_element
|
|
278 Usage : my @elements = $map->each_element;
|
|
279 Function: Retrieves all the elements in a map
|
|
280 unordered
|
|
281 Returns : Array of Bio::Map::MappableI objects
|
|
282 Args : none
|
|
283
|
|
284
|
|
285 =cut
|
|
286
|
|
287 sub each_element{
|
|
288 my ($self) = @_;
|
|
289 return @{$self->{'_elements'}};
|
|
290 }
|
|
291
|
|
292 1;
|