← Back to branch summary

~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to Bio/Tools/CodonTable.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Tools/CodonTable.pm
1
 
# $Id: CodonTable.pm,v 1.37.2.1 2006/10/02 23:10:31 sendu Exp $
 
1
# $Id: CodonTable.pm 15074 2008-12-03 04:57:49Z bosborne $
2
2
#
3
3
# bioperl module for Bio::Tools::CodonTable
4
4
#
12
12
 
13
13
=head1 NAME
14
14
 
15
 
Bio::Tools::CodonTable - Bioperl codon table object
 
15
Bio::Tools::CodonTable - Codon table object
16
16
 
17
17
=head1 SYNOPSIS
18
18
 
19
19
  # This is a read-only class for all known codon tables.  The IDs are
20
20
  # the ones used by nucleotide sequence databases.  All common IUPAC
21
 
  # ambiguity codes for DNA, RNA and animo acids are recognized.
 
21
  # ambiguity codes for DNA, RNA and amino acids are recognized.
22
22
 
23
 
  # to use
24
23
  use Bio::Tools::CodonTable;
25
24
 
26
25
  # defaults to ID 1 "Standard"
57
56
  my $seqobj    = Bio::PrimarySeq->new(-seq => 'FHGERHEL');
58
57
  my $iupac_str = $myCodonTable->reverse_translate_all($seqobj);
59
58
 
60
 
  #boolean tests
 
59
  # boolean tests
61
60
  print "Is a start\n"       if $myCodonTable->is_start_codon('ATG');
62
 
  print "Is a termianator\n" if $myCodonTable->is_ter_codon('tar');
 
61
  print "Is a terminator\n" if $myCodonTable->is_ter_codon('tar');
63
62
  print "Is a unknown\n"     if $myCodonTable->is_unknown_codon('JTG');
64
63
 
65
64
=head1 DESCRIPTION
108
107
          M           Met            Methionine
109
108
          F           Phe            Phenylalanine
110
109
          P           Pro            Proline
111
 
                  O           Pyl            Pyrrolysine (22nd amino acid)
112
 
                  U           Sec            Selenocysteine (21st amino acid)
 
110
          O           Pyl            Pyrrolysine (22nd amino acid)
 
111
          U           Sec            Selenocysteine (21st amino acid)
113
112
          S           Ser            Serine
114
113
          T           Thr            Threonine
115
114
          W           Trp            Tryptophan
117
116
          V           Val            Valine
118
117
          B           Asx            Aspartic acid or Asparagine
119
118
          Z           Glx            Glutamine or Glutamic acid
120
 
                  J           Xle            Isoleucine or Valine (mass spec ambiguity)
 
119
          J           Xle            Isoleucine or Valine (mass spec ambiguity)
121
120
          X           Xaa            Any or unknown amino acid
122
121
 
123
122
 
172
171
# Let the code begin...
173
172
 
174
173
package Bio::Tools::CodonTable;
175
 
use vars qw(@NAMES @TABLES @STARTS $TRCOL $CODONS %IUPAC_DNA        $CODONGAP $GAP
176
 
            %IUPAC_AA %THREELETTERSYMBOLS $VALID_PROTEIN $TERMINATOR);
 
174
use vars qw(@NAMES @TABLES @STARTS $TRCOL $CODONS %IUPAC_DNA $CODONGAP $GAP
 
175
                                %IUPAC_AA %THREELETTERSYMBOLS $VALID_PROTEIN $TERMINATOR);
177
176
use strict;
178
177
 
179
178
# Object preamble - inherits from Bio::Root::Root
298
297
 
299
298
 Title   : id
300
299
 Usage   : $obj->id(3); $id_integer = $obj->id();
301
 
 Function:
302
 
 
303
 
           Sets or returns the id of the translation table.  IDs are
 
300
 Function: Sets or returns the id of the translation table.  IDs are
304
301
           integers from 1 to 15, excluding 7 and 8 which have been
305
302
           removed as redundant. If an invalid ID is given the method
306
303
           returns 0, false.
307
 
 
308
 
 
309
304
 Example :
310
305
 Returns : value of id, a scalar, 0 if not a valid
311
306
 Args    : newvalue (optional)
365
360
  }
366
361
  return \%tables;
367
362
}
368
 
                
 
363
 
369
364
=head2 translate
370
365
 
371
366
 Title   : translate
537
532
=cut
538
533
 
539
534
sub revtranslate {
540
 
    my ($self, $value, $coding) = @_;
541
 
    my ($id) = $self->{'id'};
542
 
    my (@aas,  $p);
543
 
    my (@codons) = ();
 
535
        my ($self, $value, $coding) = @_;
 
536
        my ($id) = $self->{'id'};
 
537
        my (@aas,  $p);
 
538
        my (@codons) = ();
544
539
 
545
 
    if (length($value) == 3 ) {
546
 
        $value = lc $value;
547
 
        $value = ucfirst $value;
548
 
        $value = $THREELETTERSYMBOLS{$value};
549
 
    }
550
 
    if ( defined $value and $value =~ /$VALID_PROTEIN/ 
551
 
         and length($value) == 1 ) {
552
 
        $value = uc $value;
553
 
        @aas = @{$IUPAC_AA{$value}};    
554
 
        foreach my $aa (@aas) {
555
 
            #print $aa, " -2\n";
556
 
            $aa = '\*' if $aa eq '*';
557
 
            while ($TABLES[$id-1] =~ m/$aa/g) {
558
 
                $p = pos $TABLES[$id-1];
559
 
                push (@codons, $TRCOL->{--$p});
 
540
        if (length($value) == 3 ) {
 
541
                $value = lc $value;
 
542
                $value = ucfirst $value;
 
543
                $value = $THREELETTERSYMBOLS{$value};
 
544
        }
 
545
        if ( defined $value and $value =~ /$VALID_PROTEIN/ 
 
546
                  and length($value) == 1 ) {
 
547
                $value = uc $value;
 
548
                @aas = @{$IUPAC_AA{$value}};    
 
549
                foreach my $aa (@aas) {
 
550
                        #print $aa, " -2\n";
 
551
                        $aa = '\*' if $aa eq '*';
 
552
              while ($TABLES[$id-1] =~ m/$aa/g) {
 
553
                      $p = pos $TABLES[$id-1];
 
554
                      push (@codons, $TRCOL->{--$p});
 
555
              }
560
556
            }
561
 
        }
562
 
    }
563
 
 
564
 
    if ($coding and uc ($coding) eq 'RNA') {
565
 
        for my $i (0..$#codons)  {
566
 
            $codons[$i] =~ tr/t/u/;
567
 
        }
568
 
    }
569
 
 
570
 
    return @codons;
 
557
    }
 
558
 
 
559
   if ($coding and uc ($coding) eq 'RNA') {
 
560
           for my $i (0..$#codons)  {
 
561
              $codons[$i] =~ tr/t/u/;
 
562
           }
 
563
   }
 
564
    
 
565
   return @codons;
571
566
}
 
567
 
572
568
=head2 reverse_translate_all
573
569
 
574
570
 Title   : reverse_translate_all
583
579
 Args    : a Bio::PrimarySeqI compatible object (mandatory)
584
580
           a Bio::CodonUsage::Table object and a threshold if only
585
581
             codons with a relative frequency above the threshold are
586
 
             to be considered. 
587
 
 
588
 
 
 
582
             to be considered.
589
583
=cut
590
584
 
591
585
sub reverse_translate_all {
592
586
        
593
587
        my ($self, $obj, $cut, $threshold) = @_;
594
588
 
595
 
    ## check args are OK
 
589
        ## check args are OK
596
590
 
597
591
        if (!$obj || !$obj->isa('Bio::PrimarySeqI')){
598
592
                $self->throw(" I need a Bio::PrimarySeqI object, not a [".
637
631
 
638
632
}
639
633
 
 
634
=head2 reverse_translate_best
 
635
 
 
636
 Title   : reverse_translate_best
 
637
 Usage   : my $str = $cttable->reverse_translate_best($seq_object,$cutable);
 
638
 Function: Reverse translates a protein sequence into plain nucleotide
 
639
           sequence (GATC), uses the most common codon for each amino acid
 
640
 Returns : A string
 
641
 Args    : A Bio::PrimarySeqI compatible object and a Bio::CodonUsage::Table object
 
642
 
 
643
=cut
 
644
 
 
645
sub reverse_translate_best {
 
646
 
 
647
        my ($self, $obj, $cut) = @_;
 
648
 
 
649
        if (!$obj || !$obj->isa('Bio::PrimarySeqI')){
 
650
                $self->throw(" I need a Bio::PrimarySeqI object, not a [".
 
651
                                                 ref($obj) . "]");
 
652
        }
 
653
        if ($obj->alphabet ne 'protein')        {
 
654
                $self->throw("Cannot reverse translate, need an amino acid sequence .".
 
655
                                                 "This sequence is of type [" . $obj->alphabet ."]");
 
656
        }
 
657
        if ( !$cut | !$cut->isa('Bio::CodonUsage::Table'))      {
 
658
                $self->throw("I need a Bio::CodonUsage::Table object, not a [".
 
659
                                                 ref($cut). "].");
 
660
        }
 
661
 
 
662
        my $str = '';
 
663
        my @seq = split '', $obj->seq;
 
664
 
 
665
        my $cod_ref = $cut->most_common_codons();
 
666
 
 
667
        for my $aa ( @seq ) {
 
668
                if ($aa =~ /x/i) {
 
669
                        $str .= 'NNN';
 
670
                        next;
 
671
                }
 
672
                if ( defined $cod_ref->{$aa} ) {
 
673
                        $str .= $cod_ref->{$aa};
 
674
                } else {
 
675
                        $self->throw("Input sequence contains invalid character: $aa");                 
 
676
                }
 
677
        }
 
678
   $str;
 
679
}
 
680
 
640
681
=head2 is_start_codon
641
682
 
642
683
 Title   : is_start_codon
647
688
 Returns : boolean
648
689
 Args    : codon
649
690
 
650
 
 
651
691
=cut
652
692
 
653
693
sub is_start_codon{
682
722
 Returns : boolean
683
723
 Args    : codon
684
724
 
685
 
 
686
725
=cut
687
726
 
688
727
sub is_ter_codon{