File Coverage

Bio/Map/GeneRelative.pm
Criterion Covered Total %
statement 84 100 84.0
branch 56 86 65.1
condition 8 23 34.7
subroutine 9 10 90.0
pod 7 7 100.0
total 164 226 72.5


line stmt bran cond sub pod time code
1             # $Id: GeneRelative.pm,v 1.6 2006/09/20 11:53:29 sendu Exp $
2             #
3             # BioPerl module for Bio::Map::GeneRelative
4             #
5             # Please direct questions and support issues to
6             #
7             # Cared for by Sendu Bala
8             #
9             # Copyright Sendu Bala
10             #
11             # You may distribute this module under the same terms as perl itself
12              
13             # POD documentation - main docs before the code
14              
15             =head1 NAME
16              
17             Bio::Map::GeneRelative - Represents being relative to named sub-regions of a
18             gene.
19              
20             =head1 SYNOPSIS
21              
22             use Bio::Map::GeneRelative;
23              
24             # say that a somthing will have a position relative to the start of the
25             # gene on map
26             my $rel = Bio::Map::GeneRelative->new(-gene => 0);
27              
28             # or that something will be relative to the third transcript of a gene
29             # on a map
30             $rel = Bio::Map::GeneRelative->new(-transcript => 3);
31              
32             # or to the 5th intron of the default transcript
33             $rel = Bio::Map::GeneRelative->new(-intron => [0, 5]);
34              
35             # use the $rel as normal; see L
36              
37             =head1 DESCRIPTION
38              
39             Be able to say that a given position is relative to some standard part of a
40             gene.
41              
42             =head1 FEEDBACK
43              
44             =head2 Mailing Lists
45              
46             User feedback is an integral part of the evolution of this and other
47             Bioperl modules. Send your comments and suggestions preferably to
48             the Bioperl mailing list. Your participation is much appreciated.
49              
50             bioperl-l@bioperl.org - General discussion
51             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
52              
53             =head2 Support
54              
55             Please direct usage questions or support issues to the mailing list:
56              
57             I
58              
59             rather than to the module maintainer directly. Many experienced and
60             reponsive experts will be able look at the problem and quickly
61             address it. Please include a thorough description of the problem
62             with code and data examples if at all possible.
63              
64             =head2 Reporting Bugs
65              
66             Report bugs to the Bioperl bug tracking system to help us keep track
67             of the bugs and their resolution. Bug reports can be submitted via the
68             web:
69              
70             https://github.com/bioperl/bioperl-live/issues
71              
72             =head1 AUTHOR - Sendu Bala
73              
74             Email bix@sendu.me.uk
75              
76             =head1 APPENDIX
77              
78             The rest of the documentation details each of the object methods.
79             Internal methods are usually preceded with a _
80              
81             =cut
82              
83             # Let the code begin...
84              
85             package Bio::Map::GeneRelative;
86 1     1   4 use strict;
  1         1  
  1         28  
87              
88 1     1   3 use Scalar::Util qw(looks_like_number);
  1         1  
  1         64  
89              
90 1     1   4 use base qw(Bio::Map::Relative);
  1         1  
  1         947  
91              
92             =head2 new
93              
94             Title : new
95             Usage : my $relative = Bio::Map::Relative->new();
96             Function: Build a new Bio::Map::Relative object.
97             Returns : Bio::Map::Relative object
98             Args : -gene => int : coordinates are relative to the int'th base
99             downstream of the Position's map's gene
100             [default is gene => 0, ie. relative to the
101             start of the gene],
102             -transcript => int : or relative to the start of the int'th
103             transcript of the Position's map's gene,
104             -exon => [i, n] : or relative to the start of the n'th
105             transcript's i'th exon,
106             -intron => [i, n] : or intron,
107             -coding => int : or the start of the int'th transcript's coding
108             region.
109              
110             -description => string : Free text description of what this relative
111             describes
112              
113             (To say a Position is relative to something and upstream of it,
114             the Position's start() co-ordinate should be set negative)
115             In all cases, a transcript number of 0 means the active transcript.
116              
117             =cut
118              
119             sub new {
120 743     743 1 1252 my ($class, @args) = @_;
121 743         1269 my $self = $class->SUPER::new(@args);
122            
123 743         1480 my ($gene, $transcript, $exon, $intron, $coding) =
124             $self->_rearrange([qw( GENE TRANSCRIPT EXON INTRON CODING )], @args);
125            
126 743         1148 my $set = (defined $gene) + (defined $transcript) + (defined $exon) + (defined $intron) + (defined $coding);
127 743 50       1128 if ($set > 1) {
128 0         0 $self->throw("-gene, -transcript, -exon, -intron and -coding are mutually exclusive");
129             }
130 743 50 33     916 if ($exon && (! ref($exon) || ref($exon) ne 'ARRAY')) {
      66        
131 0         0 $self->throw("-exon takes an array ref");
132             }
133 743 0 0     795 if ($intron && (! ref($intron) || ref($intron) ne 'ARRAY')) {
      33        
134 0         0 $self->throw("-intron takes an array ref");
135             }
136 743 100       905 if ($set == 0) {
137             # type could have been set already in the call to SUPER::new
138 1 50       4 if ($self->type) {
139 0         0 $self->warn("You set a type of relative not supported by GeneRelative; resetting to type 'gene'");
140             }
141 1         1 $gene = 0;
142             }
143            
144 743 100       1064 $self->gene($gene) if defined $gene;
145 743 100       1176 $self->transcript($transcript) if defined $transcript;
146 743 100       878 $self->exon(@{$exon}) if defined $exon;
  2         6  
147 743 50       820 $self->intron(@{$intron}) if defined $intron;
  0         0  
148 743 100       863 $self->coding($coding) if defined $coding;
149            
150 743         2406 return $self;
151             }
152              
153             =head2 absolute_conversion
154              
155             Title : absolute_conversion
156             Usage : my $absolute_coord = $relative->absolute_conversion($pos);
157             Function: Convert the start co-ordinate of the supplied position into a number
158             relative to the start of its map.
159             Returns : scalar number
160             Args : Bio::Map::PositionI object
161              
162             =cut
163              
164             sub absolute_conversion {
165 408     408 1 357 my ($self, $pos) = @_;
166 408 50       557 $self->throw("Must supply an object") unless ref($pos);
167 408 50       807 $self->throw("This is [$pos], not a Bio::Map::PositionI") unless $pos->isa('Bio::Map::PositionI');
168            
169             # get the raw start position of our position
170 408         515 my $raw = $pos->start($pos->relative);
171 408 50       500 $self->throw("Can't convert co-ordinates when start isn't set") unless defined($raw); #*** needed? return undef?
172            
173             # what are we relative to?
174 408         554 my $type = $self->type;
175 408         541 my $value = $self->$type;
176 408 50       533 $self->throw("Details not yet set for this Relative, cannot convert") unless defined($value);
177            
178             # get the absolute start of the thing we're relative to
179 408 50       1359 if ($type =~ /gene|transcript|exon|intron|coding/) {
180 408         697 my $map = $pos->map;
181 408 100       578 my $throw_desc = $type eq 'gene' ? 'gene' : "gene's transcript";
182 408 50       542 $self->throw("Relative to a map's $throw_desc, but the Position has no map") unless $map;
183 408 50       812 $self->throw("Relative to a map's $throw_desc, but the Position's map isn't a Bio::Map::GeneMap") unless $map->isa('Bio::Map::GeneMap');
184 408         682 my $gene = $map->gene;
185            
186 408 100       501 if ($type eq 'gene') {
187 292         494 my $gene_pos = $gene->position($map);
188 292         559 my $rel = $gene_pos->relative;
189 292         478 my $start = $rel->absolute_conversion($gene_pos);
190 292         612 $value += $start;
191             }
192             else {
193 116 100       175 my @values = ref($value) ? @{$value} : ($value);
  20         26  
194 116 100       129 my $trans = ref($value) ? $values[1] : $value;
195 116 100       144 my $throw_txt = $trans == 0 ? 'default/active transcript' : "transcript $trans";
196 116 100       142 my $throw_txt2 = ref($value) ? ", or no $type $values[0]" : '';
197 116 100       183 my $method = $type eq 'coding' ? 'coding_position' : "get_${type}_position";
198 116   33     267 $value = $gene->$method($map, @values) || $self->throw("Relative to $throw_txt of the map's gene, but there is no such transcript$throw_txt2");
199             }
200             }
201             else {
202 0         0 return $self->SUPER::absolute_conversion($pos);
203             }
204 408 100       584 if (ref($value)) {
205             # psuedo-recurse
206 116         166 my $rel = $value->relative;
207 116         187 $value = $rel->absolute_conversion($value);
208             }
209            
210 408 50       500 if (defined($value)) {
211 408         718 return $value + $raw;
212             }
213 0         0 return;
214             }
215              
216             =head2 type
217              
218             Title : type
219             Usage : my $type = $relative->type();
220             Function: Get the type of thing we are relative to. The types correspond
221             to a method name, so the value of what we are relative to can
222             subsequently be found by $value = $relative->$type;
223              
224             Note that type is set by the last method that was set, or during
225             new().
226              
227             Returns : 'gene', 'transcript', 'exon', 'intron' or 'coding'
228             Args : none
229              
230             =cut
231              
232             =head2 gene
233              
234             Title : gene
235             Usage : my $int = $relative->gene();
236             $relative->gene($int);
237             Function: Get/set the distance from the start of the gene that the Position's
238             co-ordiantes are relative to.
239             Returns : int
240             Args : none to get, OR
241             int to set; a value of 0 means relative to the start of the gene.
242              
243             =cut
244              
245             sub gene {
246 1187     1187 1 892 my ($self, $num) = @_;
247 1187 100       1358 if (defined($num)) {
248 351 50       596 $self->throw("This is [$num], not a number") unless looks_like_number($num);
249 351         324 $self->{_use} = 'gene';
250 351         301 $self->{_gene} = $num;
251             }
252 1187 50       2088 return defined($self->{_gene}) ? $self->{_gene} : return;
253             }
254              
255             =head2 transcript
256              
257             Title : transcript
258             Usage : my $int = $relative->transcript();
259             $relative->transcript($int);
260             Function: Get/set which transcript of the Position's map's gene the Position's
261             co-ordinates are relative to.
262             Returns : int
263             Args : none to get, OR
264             int to set; a value of 0 means the active (default) transcript.
265              
266             =cut
267              
268             sub transcript {
269 782     782 1 559 my ($self, $num) = @_;
270 782 100       866 if (defined($num)) {
271 397 50       774 $self->throw("This is [$num], not a number") unless looks_like_number($num);
272 397         387 $self->{_use} = 'transcript';
273 397         373 $self->{_transcript} = $num;
274             }
275 782 50       1481 return defined($self->{_transcript}) ? $self->{_transcript} : return;
276             }
277              
278             =head2 exon
279              
280             Title : exon
281             Usage : my ($exon_number, $transcript_number) = @{$relative->exon()};
282             $relative->exon($exon_number, $transcript_number);
283             Function: Get/set which exon of which transcript of the Position's map's gene
284             the Position's co-ordinates are relative to.
285             Returns : reference to list with two ints, exon number and transcript number
286             Args : none to get, OR
287             int (exon number) AND int (transcript number) to set. The second int
288             is optional and defaults to 0 (meaning default/active transcript).
289              
290             =cut
291              
292             sub exon {
293 62     62 1 50 my ($self, $num, $t_num) = @_;
294 62 100       74 if (defined($num)) {
295 2 100       4 if (defined($t_num)) {
296 1 50       5 $self->throw("This is [$t_num], not a number") unless looks_like_number($t_num);
297             }
298 2   100     7 $t_num ||= 0;
299 2 50       5 $self->throw("This is [$num], not a number") unless looks_like_number($num);
300 2         4 $self->{_use} = 'exon';
301 2         4 $self->{_exon} = [$num, $t_num];
302             }
303 62   50     145 return $self->{_exon} || return;
304             }
305              
306             =head2 intron
307              
308             Title : intron
309             Usage : my ($intron_number, $transcript_number) = @{$relative->intron()};
310             $relative->intron($intron_number, $transcript_number);
311             Function: Get/set which intron of which transcript of the Position's map's gene
312             the Position's co-ordinates are relative to.
313             Returns : reference to list with two ints, intron number and transcript number
314             Args : none to get, OR
315             int (intron number) AND int (transcript number) to set. The second
316             int is optional and defaults to 0 (meaning default/active
317             transcript).
318              
319             =cut
320              
321             sub intron {
322 0     0 1 0 my ($self, $num, $t_num) = @_;
323 0 0       0 if (defined($num)) {
324 0 0       0 if (defined($t_num)) {
325 0 0       0 $self->throw("This is [$t_num], not a number") unless looks_like_number($t_num);
326             }
327 0   0     0 $t_num ||= 0;
328 0 0       0 $self->throw("This is [$num], not a number") unless looks_like_number($num);
329 0         0 $self->{_use} = 'intron';
330 0         0 $self->{_intron} = [$num, $t_num];
331             }
332 0   0     0 return $self->{_intron} || return;
333             }
334              
335             =head2 coding
336              
337             Title : coding
338             Usage : my $transcript_number = $relative->coding;
339             $relative->coding($transcript_number);
340             Function: Get/set which transcript's coding region of the Position's map's gene
341             the Position's co-ordinates are relative to.
342             Returns : int
343             Args : none to get, OR
344             int to set (the transcript number, see transcript())
345              
346             =cut
347              
348             sub coding {
349 34     34 1 29 my ($self, $num) = @_;
350 34 100       44 if (defined($num)) {
351 1 50       4 $self->throw("This is [$num], not a number") unless looks_like_number($num);
352 1         3 $self->{_use} = 'coding';
353 1         2 $self->{_coding} = $num;
354             }
355 34 50       79 return defined($self->{_coding}) ? $self->{_coding} : return;
356             }
357              
358             1;