~ubuntu-branches/ubuntu/lucid/bioperl/lucid

« back to all changes in this revision

Viewing changes to Bio/Map/CytoMarker.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2007-09-21 22:52:22 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20070921225222-tt20m2yy6ycuy2d8
Tags: 1.5.2.102-1
* Developer release.
* Upgraded source package to debhelper 5 and standards-version 3.7.2.
* Added libmodule-build-perl and libtest-harness-perl to
  build-depends-indep.
* Disabled automatic CRAN download.
* Using quilt instead of .diff.gz to manage modifications.
* Updated Recommends list for the binary package.
* Moved the "production-quality" scripts to /usr/bin/.
* New maintainer: Debian-Med packaging team mailing list.
* New uploaders: Charles Plessy and Steffen Moeller.
* Updated Depends, Recommends and Suggests.
* Imported in Debian-Med's SVN repository on Alioth.
* Executing the regression tests during package building.
* Moved the Homepage: field out from the package's description.
* Updated watch file.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
# $Id: CytoMarker.pm,v 1.3 2002/10/22 07:45:15 lapp Exp $
 
1
# $Id: CytoMarker.pm,v 1.12.4.1 2006/10/02 23:10:21 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::Map::CytoMarker
4
4
#
5
 
# Cared for by Heikki Lehvaslaiho heikki@ebi.ac.uk
 
5
# Cared for by Sendu Bala <bix@sendu.me.uk>
6
6
#
7
7
# Copyright Heikki Lehvaslaiho
8
8
#
24
24
This object handles markers with a positon in a cytogenetic map known.
25
25
This marker will have a name and a position.
26
26
 
27
 
 
28
27
=head1 FEEDBACK
29
28
 
30
29
=head2 Mailing Lists
33
32
Bioperl modules. Send your comments and suggestions preferably to the
34
33
Bioperl mailing list.  Your participation is much appreciated.
35
34
 
36
 
  bioperl-l@bioperl.org              - General discussion
37
 
  http://bioperl.org/MailList.shtml  - About the mailing lists
 
35
  bioperl-l@bioperl.org                  - General discussion
 
36
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
38
37
 
39
38
=head2 Reporting Bugs
40
39
 
41
40
Report bugs to the Bioperl bug tracking system to help us keep track
42
 
of the bugs and their resolution. Bug reports can be submitted via
43
 
email or the web:
 
41
of the bugs and their resolution. Bug reports can be submitted via the
 
42
web:
44
43
 
45
 
  bioperl-bugs@bioperl.org
46
 
  http://bugzilla.bioperl.org/
 
44
  http://bugzilla.open-bio.org/
47
45
 
48
46
=head1 AUTHOR - Heikki Lehvaslaiho 
49
47
 
50
 
Email heikki@ebi.ac.uk
 
48
Email heikki-at-bioperl-dot-org
51
49
 
52
50
=head1 CONTRIBUTORS
53
51
 
54
52
Chad Matsalla      bioinformatics1@dieselwurks.com
55
53
Lincoln Stein      lstein@cshl.org
56
54
Jason Stajich      jason@bioperl.org
 
55
Sendu Bala         bix@sendu.me.uk
57
56
 
58
57
=head1 APPENDIX
59
58
 
65
64
# Let the code begin...
66
65
 
67
66
package Bio::Map::CytoMarker;
68
 
use vars qw(@ISA);
69
67
use strict;
70
 
use Bio::Map::Marker;
71
68
use Bio::Map::CytoPosition;
72
 
use Bio::RangeI;
73
69
 
74
 
@ISA = qw(Bio::Map::Marker Bio::RangeI  );
 
70
use base qw(Bio::Map::Marker);
75
71
 
76
72
 
77
73
=head2 Bio::Map::MarkerI methods
81
77
=head2 get_position_object
82
78
 
83
79
 Title   : get_position_class
84
 
 Usage   : my $pos = $marker->get_position_object();
 
80
 Usage   : my $position = $marker->get_position_object();
85
81
 Function: To get an object of the default Position class
86
82
           for this Marker. Subclasses should redefine this method.
87
 
           The Position needs to be L<Bio::Map::PositionI>.
88
 
 Returns : L<Bio::Map::CytoPosition>
89
 
 Args    : none
 
83
           The Position returned needs to be a L<Bio::Map::PositionI> with
 
84
                   -element set to self.
 
85
 Returns : L<Bio::Map::PositionI>
 
86
 Args    : none for an 'empty' PositionI object, optionally
 
87
           Bio::Map::MapI and value string to set the Position's -map and -value
 
88
           attributes.
90
89
 
91
90
=cut
92
91
 
93
92
sub get_position_object {
94
 
   my ($self) = @_;
95
 
   return new Bio::Map::CytoPosition();
 
93
   my ($self, $map, $value) = @_;
 
94
   $map ||= $self->default_map;
 
95
   if ($value) {
 
96
          $self->throw("Value better be scalar, not [$value]") unless ref($value) eq '';
 
97
   }
 
98
   
 
99
   my $pos = new Bio::Map::CytoPosition();
 
100
   $pos->map($map) if $map;
 
101
   $pos->value($value) if $value;
 
102
   $pos->element($self);
 
103
   return $pos;
96
104
}
97
105
 
98
106
 
103
111
chromosomes, through X and end the the q tip of X. See
104
112
L<Bio::Map::CytoPosition::cytorange> for more details.
105
113
 
106
 
The numeric values for cytogenetic positions are ranges of type
107
 
L<Bio::Range>, so MarkerI type of operators (equals, less_than,
108
 
greater_than) are not very meaningful, but they might be of some use
109
 
combined with L<Bio::RangeI> methods (overlaps, contains, equals,
110
 
intersection, union). equals(), present in both interfaces is treated
111
 
as a more precice RangeI method.
112
 
 
113
 
CytoMarker has a method L<get_chr> which might turn out to be useful
114
 
in this context.
115
 
 
116
 
The L<less_than> and L<greater_than> methods are implemented by
117
 
comparing the end values of the range, so you better first check that
118
 
markers do not overlap, or you get an opposite result than expected.
119
 
The numerical values are not metric, so avarages are not meaningful.
120
 
 
121
 
Note: These methods always return a value. A false value (0) might
122
 
mean that you have not set the position! Check those warnings.
123
 
 
124
 
=cut
125
 
 
126
 
=head2 Bio::Map::MarkerI comparison methods
127
 
 
128
 
=cut
129
 
 
130
 
=head2 tuple
131
 
 
132
 
 Title   : tuple
133
 
 Usage   : ($me, $you) = $self->_tuple($compare)
134
 
 Function: Utility method to extract numbers and test for missing values.
135
 
 Returns : two ranges or tuple of -1
136
 
 Args    : Bio::Map::MappableI or Bio::Map::PositionI
137
 
 
138
 
=cut
139
 
 
140
 
=head2 less_than
141
 
 
142
 
 Title   : less_than
143
 
 Usage   : if( $mappable->less_than($m2) ) ...
144
 
 Function: Tests if a position is less than another position
145
 
 Returns : boolean
146
 
 Args    : Bio::Map::MappableI  or Bio::Map::PositionI
147
 
 
148
 
=cut
149
 
 
150
 
 
151
 
sub less_than {
152
 
    my ($self,$compare) = @_;
153
 
 
154
 
    my ($me, $you) = $self->tuple($compare);
155
 
    return 0 if $me == -1 or $you == -1 ;
156
 
 
157
 
    $me  = $me->end;
158
 
    $you  = $you->start;
159
 
 
160
 
    print STDERR "me=$me, you=$you\n" if $self->verbose > 0;
161
 
    return $me < $you;
162
 
}
163
 
 
164
 
=head2 greater_than
165
 
 
166
 
 Title   : greater_than
167
 
 Usage   : if( $mappable->greater_than($m2) ) ...
168
 
 Function: Tests if position is greater than another position
169
 
 Returns : boolean
170
 
 Args    : Bio::Map::MappableI or Bio::Map::PositionI
171
 
 
172
 
=cut
173
 
 
174
 
 
175
 
sub greater_than {
176
 
    my ($self,$compare) = @_;
177
 
 
178
 
    my ($me, $you) = $self->tuple($compare);
179
 
    return 0 if $me == -1 or $you == -1 ;
180
 
 
181
 
    $me  = $me->start;
182
 
    $you  = $you->end;
183
 
    print STDERR "me=$me, you=$you\n" if $self->verbose > 0;
184
 
    return $me > $you;
185
 
}
186
 
 
187
 
=head2 RangeI methods
188
 
 
189
 
=cut
190
 
 
191
 
 
192
 
=head2 equals
193
 
 
194
 
 Title   : equals
195
 
 Usage   : if( $mappable->equals($mapable2)) ...
196
 
 Function: Test if a position is equal to another position
197
 
 Returns : boolean
198
 
 Args    : Bio::Map::MappableI or Bio::Map::PositionI
199
 
 
200
 
=cut
201
 
 
202
 
sub equals {
203
 
    my ($self,$compare) = @_;
204
 
 
205
 
    my ($me, $you) = $self->tuple($compare);
206
 
    return 0 unless $me->isa('Bio::RangeI') and $you->isa('Bio::RangeI');
207
 
 
208
 
    return $me->equals($you);
209
 
}
210
 
 
211
 
=head2 overlaps
212
 
 
213
 
  Title    : overlaps
214
 
  Usage    : if($r1->overlaps($r2)) { do stuff }
215
 
  Function : tests if $r2 overlaps $r1
216
 
  Args     : a range to test for overlap with
217
 
  Returns  : true if the ranges overlap, false otherwise
218
 
  Inherited: Bio::RangeI
219
 
 
220
 
=cut
221
 
 
222
 
sub overlaps {
223
 
    my ($self,$compare) = @_;
224
 
 
225
 
    my ($me, $you) = $self->tuple($compare);
226
 
    return 0 unless $me->isa('Bio::RangeI') and $you->isa('Bio::RangeI');
227
 
 
228
 
    return $me->overlaps($you);
229
 
}
230
 
 
231
 
=head2 contains
232
 
 
233
 
  Title    : contains
234
 
  Usage    : if($r1->contains($r2) { do stuff }
235
 
  Function : tests wether $r1 totaly contains $r2
236
 
  Args     : a range to test for being contained
237
 
  Returns  : true if the argument is totaly contained within this range
238
 
  Inherited: Bio::RangeI
239
 
 
240
 
=cut
241
 
 
242
 
sub contains {
243
 
    my ($self,$compare) = @_;
244
 
 
245
 
    my ($me, $you) = $self->tuple($compare);
246
 
    return 0 unless $me->isa('Bio::RangeI') and $you->isa('Bio::RangeI');
247
 
    print STDERR "me=", $me->start. "-", $me->end, " ",
248
 
    "you=", $you->start. "-", $you->end, "\n"
249
 
        if $self->verbose > 0;
250
 
 
251
 
    return $me->contains($you);
252
 
}
253
 
 
254
 
=head2 intersection
255
 
 
256
 
  Title    : intersection
257
 
  Usage    : ($start, $stop, $strand) = $r1->intersection($r2)
258
 
  Function : gives the range that is contained by both ranges
259
 
  Args     : a range to compare this one to
260
 
  Returns  : nothing if they do not overlap, or the range that they do overlap
261
 
  Inherited: Bio::RangeI::intersection
262
 
 
263
 
=cut
264
 
 
265
 
sub intersection {
266
 
    my ($self,$compare) = @_;
267
 
 
268
 
    my ($me, $you) = $self->tuple($compare);
269
 
    return 0 unless $me->isa('Bio::RangeI') and $you->isa('Bio::RangeI');
270
 
 
271
 
    return $me->intersection($you);
272
 
}
273
 
 
274
 
=head2 union
275
 
 
276
 
  Title    : union
277
 
  Usage    : ($start, $stop, $strand) = $r1->union($r2);
278
 
           : ($start, $stop, $strand) = Bio::Range->union(@ranges);
279
 
  Function : finds the minimal range that contains all of the ranges
280
 
  Args     : a range or list of ranges to find the union of
281
 
  Returns  : the range containing all of the ranges
282
 
  Inherited: Bio::RangeI::union
283
 
 
284
 
=cut
285
 
 
286
 
sub union {
287
 
    my ($self,$compare) = @_;
288
 
 
289
 
    my ($me, $you) = $self->tuple($compare);
290
 
    return 0 unless $me->isa('Bio::RangeI') and $you->isa('Bio::RangeI');
291
 
 
292
 
    return $me->union($you);
293
 
}
294
 
 
 
114
=cut
295
115
 
296
116
=head2 New methods
297
117
 
298
118
=cut
299
119
 
300
 
 
301
120
=head2 get_chr
302
121
 
303
122
 Title   : get_chr
304
123
 Usage   : my $mychr = $marker->get_chr();
305
124
 Function: Read only method for the  chromosome string of the location.
306
 
           A shotrcut to $marker->position->chr().
 
125
           A shortcut to $marker->position->chr().
307
126
 Returns : chromosome value
308
127
 Args    : [optional] new chromosome value
309
128
 
310
129
=cut
311
130
 
312
 
 
313
131
sub get_chr {
314
132
    my ($self) = @_;
315
 
    return undef unless $self->position;
 
133
    return unless $self->position;
316
134
    return $self->position->chr;
317
135
}
318
136