maint: restructure to use Dist::Zilla
[bioperl-live.git] / lib / Bio / Map / GeneRelative.pm
blob2cab5a9baad62982187cafd67b5be822925a0a2e
1 # $Id: GeneRelative.pm,v 1.6 2006/09/20 11:53:29 sendu Exp $
3 # BioPerl module for Bio::Map::GeneRelative
5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
7 # Cared for by Sendu Bala <bix@sendu.me.uk>
9 # Copyright Sendu Bala
11 # You may distribute this module under the same terms as perl itself
13 # POD documentation - main docs before the code
15 =head1 NAME
17 Bio::Map::GeneRelative - Represents being relative to named sub-regions of a
18 gene.
20 =head1 SYNOPSIS
22 use Bio::Map::GeneRelative;
24 # say that a something will have a position relative to the start of the
25 # gene on map
26 my $rel = Bio::Map::GeneRelative->new(-gene => 0);
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);
32 # or to the 5th intron of the default transcript
33 $rel = Bio::Map::GeneRelative->new(-intron => [0, 5]);
35 # use the $rel as normal; see L<Bio::Map::Relative>
37 =head1 DESCRIPTION
39 Be able to say that a given position is relative to some standard part of a
40 gene.
42 =head1 FEEDBACK
44 =head2 Mailing Lists
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.
50 bioperl-l@bioperl.org - General discussion
51 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
53 =head2 Support
55 Please direct usage questions or support issues to the mailing list:
57 I<bioperl-l@bioperl.org>
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.
64 =head2 Reporting Bugs
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:
70 https://github.com/bioperl/bioperl-live/issues
72 =head1 AUTHOR - Sendu Bala
74 Email bix@sendu.me.uk
76 =head1 APPENDIX
78 The rest of the documentation details each of the object methods.
79 Internal methods are usually preceded with a _
81 =cut
83 # Let the code begin...
85 package Bio::Map::GeneRelative;
86 use strict;
88 use Scalar::Util qw(looks_like_number);
90 use base qw(Bio::Map::Relative);
92 =head2 new
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.
110 -description => string : Free text description of what this relative
111 describes
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.
117 =cut
119 sub new {
120 my ($class, @args) = @_;
121 my $self = $class->SUPER::new(@args);
123 my ($gene, $transcript, $exon, $intron, $coding) =
124 $self->_rearrange([qw( GENE TRANSCRIPT EXON INTRON CODING )], @args);
126 my $set = (defined $gene) + (defined $transcript) + (defined $exon) + (defined $intron) + (defined $coding);
127 if ($set > 1) {
128 $self->throw("-gene, -transcript, -exon, -intron and -coding are mutually exclusive");
130 if ($exon && (! ref($exon) || ref($exon) ne 'ARRAY')) {
131 $self->throw("-exon takes an array ref");
133 if ($intron && (! ref($intron) || ref($intron) ne 'ARRAY')) {
134 $self->throw("-intron takes an array ref");
136 if ($set == 0) {
137 # type could have been set already in the call to SUPER::new
138 if ($self->type) {
139 $self->warn("You set a type of relative not supported by GeneRelative; resetting to type 'gene'");
141 $gene = 0;
144 $self->gene($gene) if defined $gene;
145 $self->transcript($transcript) if defined $transcript;
146 $self->exon(@{$exon}) if defined $exon;
147 $self->intron(@{$intron}) if defined $intron;
148 $self->coding($coding) if defined $coding;
150 return $self;
153 =head2 absolute_conversion
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
162 =cut
164 sub absolute_conversion {
165 my ($self, $pos) = @_;
166 $self->throw("Must supply an object") unless ref($pos);
167 $self->throw("This is [$pos], not a Bio::Map::PositionI") unless $pos->isa('Bio::Map::PositionI');
169 # get the raw start position of our position
170 my $raw = $pos->start($pos->relative);
171 $self->throw("Can't convert co-ordinates when start isn't set") unless defined($raw); #*** needed? return undef?
173 # what are we relative to?
174 my $type = $self->type;
175 my $value = $self->$type;
176 $self->throw("Details not yet set for this Relative, cannot convert") unless defined($value);
178 # get the absolute start of the thing we're relative to
179 if ($type =~ /gene|transcript|exon|intron|coding/) {
180 my $map = $pos->map;
181 my $throw_desc = $type eq 'gene' ? 'gene' : "gene's transcript";
182 $self->throw("Relative to a map's $throw_desc, but the Position has no map") unless $map;
183 $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 my $gene = $map->gene;
186 if ($type eq 'gene') {
187 my $gene_pos = $gene->position($map);
188 my $rel = $gene_pos->relative;
189 my $start = $rel->absolute_conversion($gene_pos);
190 $value += $start;
192 else {
193 my @values = ref($value) ? @{$value} : ($value);
194 my $trans = ref($value) ? $values[1] : $value;
195 my $throw_txt = $trans == 0 ? 'default/active transcript' : "transcript $trans";
196 my $throw_txt2 = ref($value) ? ", or no $type $values[0]" : '';
197 my $method = $type eq 'coding' ? 'coding_position' : "get_${type}_position";
198 $value = $gene->$method($map, @values) || $self->throw("Relative to $throw_txt of the map's gene, but there is no such transcript$throw_txt2");
201 else {
202 return $self->SUPER::absolute_conversion($pos);
204 if (ref($value)) {
205 # pseudo-recurse
206 my $rel = $value->relative;
207 $value = $rel->absolute_conversion($value);
210 if (defined($value)) {
211 return $value + $raw;
213 return;
216 =head2 type
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;
224 Note that type is set by the last method that was set, or during
225 new().
227 Returns : 'gene', 'transcript', 'exon', 'intron' or 'coding'
228 Args : none
230 =cut
232 =head2 gene
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.
243 =cut
245 sub gene {
246 my ($self, $num) = @_;
247 if (defined($num)) {
248 $self->throw("This is [$num], not a number") unless looks_like_number($num);
249 $self->{_use} = 'gene';
250 $self->{_gene} = $num;
252 return defined($self->{_gene}) ? $self->{_gene} : return;
255 =head2 transcript
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.
266 =cut
268 sub transcript {
269 my ($self, $num) = @_;
270 if (defined($num)) {
271 $self->throw("This is [$num], not a number") unless looks_like_number($num);
272 $self->{_use} = 'transcript';
273 $self->{_transcript} = $num;
275 return defined($self->{_transcript}) ? $self->{_transcript} : return;
278 =head2 exon
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).
290 =cut
292 sub exon {
293 my ($self, $num, $t_num) = @_;
294 if (defined($num)) {
295 if (defined($t_num)) {
296 $self->throw("This is [$t_num], not a number") unless looks_like_number($t_num);
298 $t_num ||= 0;
299 $self->throw("This is [$num], not a number") unless looks_like_number($num);
300 $self->{_use} = 'exon';
301 $self->{_exon} = [$num, $t_num];
303 return $self->{_exon} || return;
306 =head2 intron
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).
319 =cut
321 sub intron {
322 my ($self, $num, $t_num) = @_;
323 if (defined($num)) {
324 if (defined($t_num)) {
325 $self->throw("This is [$t_num], not a number") unless looks_like_number($t_num);
327 $t_num ||= 0;
328 $self->throw("This is [$num], not a number") unless looks_like_number($num);
329 $self->{_use} = 'intron';
330 $self->{_intron} = [$num, $t_num];
332 return $self->{_intron} || return;
335 =head2 coding
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())
346 =cut
348 sub coding {
349 my ($self, $num) = @_;
350 if (defined($num)) {
351 $self->throw("This is [$num], not a number") unless looks_like_number($num);
352 $self->{_use} = 'coding';
353 $self->{_coding} = $num;
355 return defined($self->{_coding}) ? $self->{_coding} : return;