Bio/Map/GeneRelative.pm

   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 <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Sendu Bala <bix@sendu.me.uk>
   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<Bio::Map::Relative>
  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<bioperl-l@bioperl.org>
  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 use strict;
  87
  88 use Scalar::Util qw(looks_like_number);
  89
  90 use base qw(Bio::Map::Relative);
  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     my ($class, @args) = @_;
 121     my $self = $class->SUPER::new(@args);
 122
 123     my ($gene, $transcript, $exon, $intron, $coding) =
 124         $self->_rearrange([qw( GENE TRANSCRIPT EXON INTRON CODING )], @args);
 125
 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");
 129     }
 130     if ($exon && (! ref($exon) || ref($exon) ne 'ARRAY')) {
 131         $self->throw("-exon takes an array ref");
 132     }
 133     if ($intron && (! ref($intron) || ref($intron) ne 'ARRAY')) {
 134         $self->throw("-intron takes an array ref");
 135     }
 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'");
 140         }
 141         $gene = 0;
 142     }
 143
 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;
 149
 150     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     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');
 168
 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?
 172
 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);
 177
 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;
 185
 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;
 191         }
 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");
 199         }
 200     }
 201     else {
 202         return $self->SUPER::absolute_conversion($pos);
 203     }
 204     if (ref($value)) {
 205         # psuedo-recurse
 206         my $rel = $value->relative;
 207         $value = $rel->absolute_conversion($value);
 208     }
 209
 210     if (defined($value)) {
 211         return $value + $raw;
 212     }
 213     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     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;
 251     }
 252     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     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;
 274     }
 275     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     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);
 297         }
 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];
 302     }
 303     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     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);
 326         }
 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];
 331     }
 332     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     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;
 354     }
 355     return defined($self->{_coding}) ? $self->{_coding} : return;
 356 }
 357
 358 1;