lib/Bio/SeqFeature/Gene/Intron.pm

   1 #
   2 # BioPerl module for Bio::SeqFeature::Gene::Intron
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by David Block <dblock@gene.pbi.nrc.ca>
   7 #
   8 # Copyright David Block
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::SeqFeature::Gene::Intron - An intron feature
  17
  18 =head1 SYNOPSIS
  19
  20 Give standard usage here
  21
  22 =head1 DESCRIPTION
  23
  24 Describe the object here
  25
  26 =head1 FEEDBACK
  27
  28 =head2 Mailing Lists
  29
  30 User feedback is an integral part of the evolution of this and other
  31 Bioperl modules. Send your comments and suggestions preferably to
  32 the Bioperl mailing list.  Your participation is much appreciated.
  33
  34   bioperl-l@bioperl.org                  - General discussion
  35   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  36
  37 =head2 Support
  38
  39 Please direct usage questions or support issues to the mailing list:
  40
  41 I<bioperl-l@bioperl.org>
  42
  43 rather than to the module maintainer directly. Many experienced and
  44 reponsive experts will be able look at the problem and quickly
  45 address it. Please include a thorough description of the problem
  46 with code and data examples if at all possible.
  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 the
  52 web:
  53
  54   https://github.com/bioperl/bioperl-live/issues
  55
  56 =head1 AUTHOR - David Block
  57
  58 Email dblock@gene.pbi.nrc.ca
  59
  60 =head1 APPENDIX
  61
  62 The rest of the documentation details each of the object methods.
  63 Internal methods are usually preceded with a _
  64
  65 =cut
  66
  67
  68 # Let the code begin...
  69
  70
  71 package Bio::SeqFeature::Gene::Intron;
  72 use strict;
  73
  74 use Bio::SeqFeature::Gene::Exon;
  75
  76 use base qw(Bio::SeqFeature::Gene::NC_Feature);
  77
  78 sub new {
  79     my($class,@args) = @_;
  80
  81     # introns are non-coding by default
  82     if(! grep { lc($_) eq '-is_coding'; } @args) {
  83         push(@args, '-is_coding', 0);
  84     }
  85     my $self = $class->SUPER::new(@args);
  86
  87     my ($primary, $prim) =
  88         $self->_rearrange([qw(PRIMARY PRIMARY_TAG)],@args);
  89     $self->primary_tag('intron') unless $primary || $prim;
  90
  91     return $self;
  92 }
  93
  94 =head2 upstream_Exon
  95
  96   Title   : upstream_Exon
  97   Usage   : $intron->upstream_Exon()
  98   Function: exon upstream of the intron
  99   Returns : Bio::EnsEMBL::Exon
 100   Args    :
 101
 102 =cut
 103
 104 sub upstream_Exon {
 105     my( $self, $exon ) = @_;
 106
 107     if ($exon) {
 108         $self->{'_intron_location'} = undef;
 109         $self->throw("'$exon' is not a Bio::SeqFeature::Gene::ExonI")
 110             unless $exon->isa('Bio::SeqFeature::Gene::ExonI');
 111         $self->{'_upstream_exon'} = $exon;
 112     }
 113     return $self->{'_upstream_exon'};
 114 }
 115
 116
 117 =head2 downstream_Exon
 118
 119   Title   : downstream_Exon
 120   Usage   : $intron->downstream_Exon()
 121   Function: exon downstream of the intron
 122   Returns : Bio::EnsEMBL::Exon
 123   Args    :
 124
 125 =cut
 126
 127 sub downstream_Exon {
 128     my( $self, $exon ) = @_;
 129
 130     if ($exon) {
 131         $self->{'_intron_location'} = undef;
 132         $self->throw("'$exon' is not a Bio::SeqFeature::Gene::ExonI")
 133             unless $exon->isa('Bio::SeqFeature::Gene::ExonI');
 134         $self->{'_downstream_exon'} = $exon;
 135     }
 136     return $self->{'_downstream_exon'};
 137 }
 138
 139 =head2 phase
 140
 141   Title   : phase
 142   Usage   : $intron->phase()
 143   Function: returns the phase of the intron(where it interrupts the codon)
 144   Returns : int(0,1,2)
 145   Args    :
 146
 147 =cut
 148
 149 sub phase {
 150   my ($self) = @_;
 151   return $self->downstream_Exon->phase;
 152 }
 153
 154
 155 =head2 acceptor_splice_site
 156
 157   Title   : acceptor_splice_site
 158   Usage   : $intron->acceptor_splice_site(21,3)
 159   Function: returns the sequence corresponding to the
 160             consensus acceptor splice site. If start and
 161             end are provided, it will number of base pairs
 162             left and right of the canonical AG. Here 21 means
 163             21 bp into intron and 3 means 3 bp into the exon.
 164             --Intron--21----|AG|-3-----Exon
 165             Defaults to 21,3
 166
 167   Returns : Bio::Seq
 168   Args    : start and end
 169
 170 =cut
 171
 172 sub acceptor_splice_site {
 173   my ($self,$ss_start,$ss_end) = @_;
 174   $ss_start = 21 unless defined $ss_start;
 175   $ss_end   = 3 unless defined $ss_end;
 176   if($self->strand < 0){
 177     my $tmp= $ss_start;
 178     $ss_start = $ss_end;
 179     $ss_end = $tmp;
 180   }
 181   my $intron_end= $self->location->end;
 182   my $down_exon = $self->downstream_Exon;
 183   my $acceptor;
 184   if($self->strand < 0){
 185       $ss_start= $ss_start >  $down_exon->length ? $down_exon->length: $ss_start;
 186       $ss_end= $ss_end > $self->length-2 ? $self->length-2 : $ss_end;
 187       $acceptor = Bio::SeqFeature::Generic->new(-start=>$self->start - ($ss_start) ,
 188                                                -end=>$self->start + ($ss_end+1),
 189                                                -strand=>$self->strand,
 190                                                -primary_tag=>"donor splice site");
 191   }
 192   else {
 193     $ss_start = $ss_start > $self->length-2 ? $self->length-2 : $ss_start;
 194     $ss_end = $ss_end > $down_exon->length ? $down_exon->length : $ss_end;
 195
 196
 197     $acceptor = Bio::SeqFeature::Generic->new(-start=>$self->end - ($ss_start + 1),
 198                                                -end=>$self->end + $ss_end,
 199                                                -strand=>$self->strand,
 200                                                -primary_tag=>"donor splice site");
 201   }
 202   $acceptor->attach_seq($self->entire_seq);
 203
 204   return $acceptor;
 205
 206 }
 207
 208 =head2 donor_splice_site
 209
 210   Title   : donor_splice_site
 211   Usage   : $intron->donor_splice_site(3,6)
 212   Function: returns the sequence corresponding to the
 213             consensus donor splice site. If start and
 214             end are provided, it will number of base pairs
 215             left and right of the canonical GT. Here 3 means
 216             3 bp into exon and 6 means 6 bp into the intron.
 217             --Exon-3--|GT|-6----Intron-
 218             Defaults to 3,6
 219
 220   Returns : Bio::Seq
 221   Args    : start and end
 222
 223 =cut
 224
 225 sub donor_splice_site {
 226   my ($self,$ss_start,$ss_end) = @_;
 227   $ss_start = 3 unless defined $ss_start;
 228   $ss_end   = 10 unless defined $ss_end;
 229   if($self->strand < 0){
 230     my $tmp= $ss_start;
 231     $ss_start = $ss_end;
 232     $ss_end = $tmp;
 233   }
 234   my $up_exon = $self->upstream_Exon;
 235   my $donor;
 236   if($self->strand < 0){
 237     $ss_end = $ss_end > $up_exon->length ? $up_exon->length : $ss_end;
 238     $ss_start   = $ss_start> $self->length -2 ? $self->length -2 : $ss_start;
 239     $donor = Bio::SeqFeature::Generic->new(-start=>$self->end -  ($ss_start+1),
 240                                             -end  => $self->end + ($ss_end),
 241                                             -strand=>$self->strand,
 242                                             -primary_tag=>"acceptor splice site");
 243   }
 244   else {
 245     $ss_start = $ss_start > $up_exon->length ? $up_exon->length : $ss_start;
 246     $ss_end   = $ss_end > $self->length -2 ? $self->length -2 : $ss_end;
 247     $donor = Bio::SeqFeature::Generic->new(-start=>$self->start - $ss_start,
 248                                            -end  => $self->start +($ss_end+1),
 249                                             -strand=>$self->strand,
 250                                             -primary_tag=>"acceptor splice site");
 251   }
 252   $donor->attach_seq($self->entire_seq);
 253   return $donor;
 254 }
 255
 256 sub location {
 257     my( $self ) = @_;
 258
 259     unless ($self->{'_intron_location'}) {
 260         my $loc = Bio::Location::Simple->new;
 261
 262         my $up_exon = $self->upstream_Exon;
 263         my $down_exon = $self->downstream_Exon;
 264
 265         # Get the PrimarySeqs attached to both and check it is the same sequence
 266         my $up_seq   = $up_exon  ->entire_seq;
 267         my $down_seq = $down_exon->entire_seq;
 268         unless (ref($up_seq) eq ref($down_seq) ) {
 269             $self->throw("upstream and downstream exons are attached to different sequences\n'$up_seq' and '$down_seq'");
 270         }
 271
 272         # Check that the exons are on the same strand.  (Do I need to bother?)
 273         my $up_strand   = $up_exon  ->strand;
 274         my $down_strand = $down_exon->strand;
 275         unless ($up_strand == $down_strand) {
 276             $self->throw("upstream and downstream exons are on different strands "
 277                 . "('$up_strand' and '$down_strand')");
 278         }
 279         $loc->strand($up_strand);
 280
 281         #   $exon_end is the  end  of the exon which is 5' of the intron on the genomic sequence.
 282         # $exon_start is the start of the exon which is 3' of the intron on the genomic sequence.
 283         my( $exon_end, $exon_start );
 284         if ($up_strand == 1) {
 285             $exon_end   = $up_exon  ->end;
 286             $exon_start = $down_exon->start;
 287         } else {
 288             $exon_end   = $down_exon->end;
 289             $exon_start = $up_exon  ->start;
 290         }
 291         unless ($exon_end < $exon_start) {
 292             $self->throw("Intron gap begins after '$exon_end' and ends before '$exon_start'");
 293         }
 294         $loc->start($exon_end   + 1);
 295         $loc->end  ($exon_start - 1);
 296
 297         # Attach the sequence and location objects to the intron
 298         $self->{'_intron_location'} = $loc;
 299
 300     }
 301     return $self->{'_intron_location'};
 302 }
 303 1;