branch-1-6/t/SeqTools/CodonTable.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib '.';
   8         use Bio::Root::Test;
   9
  10         test_begin(-tests => 56);
  11
  12         use_ok('Bio::Tools::CodonTable');
  13         use_ok('Bio::CodonUsage::IO');
  14 }
  15
  16 # create a table object by giving an ID
  17 my $DEBUG = test_debug();
  18 my $myCodonTable = Bio::Tools::CodonTable -> new ( -id => 16);
  19 ok defined $myCodonTable;
  20 isa_ok $myCodonTable, 'Bio::Tools::CodonTable';
  21
  22 # defaults to ID 1 "Standard"
  23 $myCodonTable = Bio::Tools::CodonTable->new();
  24 is $myCodonTable->id(), 1;
  25
  26 # change codon table
  27 $myCodonTable->id(10);
  28 is $myCodonTable->id, 10;
  29 is $myCodonTable->name(), 'Euplotid Nuclear';
  30
  31 # enumerate tables as object method
  32 my $table = $myCodonTable->tables();
  33 cmp_ok (keys %{$table}, '>=', 17); # currently 17 known tables
  34 is $table->{11}, q{"Bacterial"};
  35
  36 # enumerate tables as class method
  37 $table = Bio::Tools::CodonTable->tables;
  38 cmp_ok (values %{$table}, '>=', 17); # currently 17 known tables
  39 is $table->{23}, 'Thraustochytrium Mitochondrial';
  40
  41 # translate codons
  42 $myCodonTable->id(1);
  43
  44 eval {
  45     $myCodonTable->translate();
  46 };
  47 ok ($@ =~ /EX/) ;
  48
  49 is $myCodonTable->translate(''), '';
  50
  51 my @ii  = qw(ACT acu ATN gt ytr sar);
  52 my @res = qw(T   T   X   V  L   Z  );
  53 my $test = 1;
  54 for my $i (0..$#ii) {
  55     if ($res[$i] ne $myCodonTable->translate($ii[$i]) ) {
  56         $test = 0;
  57         print $ii[$i], ": |", $res[$i], "| ne |", $myCodonTable->translate($ii[$i]), "|\n" if( $DEBUG);
  58         last ;
  59     }
  60 }
  61 ok ($test);
  62 is $myCodonTable->translate('ag'), '';
  63 is $myCodonTable->translate('jj'), '';
  64 is $myCodonTable->translate('jjg'), 'X';
  65 is $myCodonTable->translate('gt'), 'V';
  66 is $myCodonTable->translate('g'), '';
  67
  68 # a more comprehensive test on ambiguous codes
  69 my $seq = <<SEQ;
  70 atgaaraayacmacracwackacyacsacvachacdacbacxagragyatmatwatyathcarcayc
  71 cmccrccwcckccyccsccvcchccdccbccxcgmcgrcgwcgkcgycgscgvcghcgdcgbcgxctmctrct
  72 wctkctyctsctvcthctdctbctxgargaygcmgcrgcwgckgcygcsgcvgchgcdgcbgcxggmggrggw
  73 ggkggyggsggvgghggdggbggxgtmgtrgtwgtkgtygtsgtvgthgtdgtbgtxtartaytcmtcrtcwt
  74 cktcytcstcvtchtcdtcbtcxtgyttrttytramgamggmgrracratrayytaytgytrsaasagsartaa;
  75 SEQ
  76     $seq =~ s/\s+//g;
  77 @ii = grep { length == 3 } split /(.{3})/, $seq;
  78 print join (' ', @ii), "\n" if( $DEBUG);
  79 my $prot = <<PROT;
  80 MKNTTTTTTTTTTTRSIIIIQHPPPPPPPPPPPRRRRRRRRRRRLLLLLLLLLLLEDAAAAAAAAAAAGGG
  81 GGGGGGGGVVVVVVVVVVV*YSSSSSSSSSSSCLF*RRRBBBLLLZZZ*
  82 PROT
  83
  84     $prot =~ s/\s//;
  85 @res = split //, $prot;
  86 print join (' ', @res), "\n" if( $DEBUG );
  87 $test = 1;
  88 for my $i (0..$#ii) {
  89     if ($res[$i] ne $myCodonTable->translate($ii[$i]) ) {
  90         $test = 0;
  91         print $ii[$i], ": |", $res[$i], "| ne |",
  92           $myCodonTable->translate($ii[$i]),  "| @ $i\n" if( $DEBUG);
  93         last ;
  94     }
  95 }
  96 ok $test;
  97
  98 # reverse translate amino acids
  99
 100 is $myCodonTable->revtranslate('U'), 0;
 101 is $myCodonTable->revtranslate('O'), 0;
 102 is $myCodonTable->revtranslate('J'), 9;
 103 is $myCodonTable->revtranslate('I'), 3;
 104
 105 @ii = qw(A l ACN Thr sER ter Glx);
 106 @res = (
 107         [qw(gct gcc gca gcg)],
 108         [qw(ggc gga ggg act acc aca acg)],
 109         [qw(tct tcc tca tcg agt agc)],
 110         [qw(act acc aca acg)],
 111         [qw(tct tcc tca tcg agt agc)],
 112         [qw(taa tag tga)],
 113         [qw(gaa gag caa cag)]
 114         );
 115
 116 $test = 1;
 117  TESTING: {
 118      for my $i (0..$#ii) {
 119          my @codonres = $myCodonTable->revtranslate($ii[$i]);
 120          for my $j (0..$#codonres) {
 121              if ($codonres[$j] ne $res[$i][$j]) {
 122                  $test = 0;
 123                  print $ii[$i], ': ', $codonres[$j], " ne ",
 124                  $res[$i][$j], "\n" if( $DEBUG);
 125                  last TESTING;
 126              }
 127          }
 128      }
 129  }
 130 ok $test;
 131
 132 #  boolean tests
 133 $myCodonTable->id(1);
 134
 135 ok $myCodonTable->is_start_codon('ATG');
 136 is $myCodonTable->is_start_codon('GGH'), 0;
 137 ok $myCodonTable->is_start_codon('HTG');
 138 is $myCodonTable->is_start_codon('CCC'), 0;
 139
 140 ok $myCodonTable->is_ter_codon('UAG');
 141 ok $myCodonTable->is_ter_codon('TaG');
 142 ok $myCodonTable->is_ter_codon('TaR');
 143 ok $myCodonTable->is_ter_codon('tRa');
 144 is $myCodonTable->is_ter_codon('ttA'), 0;
 145
 146 ok $myCodonTable->is_unknown_codon('jAG');
 147 ok $myCodonTable->is_unknown_codon('jg');
 148 is $myCodonTable->is_unknown_codon('UAG'), 0;
 149
 150 is $myCodonTable->translate_strict('ATG'), 'M';
 151
 152
 153
 154 #
 155 # adding a custom codon table
 156 #
 157
 158
 159 my @custom_table =
 160     ( 'test1',
 161       'FFLLSSSSYY**CC*WLLLL**PPHHQQR*RRIIIMT*TT*NKKSSRRV*VVAA*ADDEE*GGG'
 162     );
 163
 164 ok my $custct = $myCodonTable->add_table(@custom_table);
 165 is $custct, 24;
 166 is $myCodonTable->translate('atgaaraayacmacracwacka'), 'MKNTTTT';
 167 ok $myCodonTable->id($custct);
 168 is $myCodonTable->translate('atgaaraayacmacracwacka'), 'MKXXTTT';
 169
 170 # test doing this via Bio::PrimarySeq object
 171
 172 use Bio::PrimarySeq;
 173 ok $seq = Bio::PrimarySeq->new(-seq=>'atgaaraayacmacracwacka', -alphabet=>'dna');
 174 is $seq->translate()->seq, 'MKNTTTT';
 175 is $seq->translate(undef, undef, undef, undef, undef, undef, $myCodonTable)->seq, 'MKXXTTT';
 176
 177 # test gapped translated
 178
 179 ok $seq = Bio::PrimarySeq->new(-seq      => 'atg---aar------aay',
 180                                            -alphabet => 'dna');
 181 is $seq->translate->seq, 'M-K--N';
 182
 183 ok $seq = Bio::PrimarySeq->new(-seq =>'ASDFGHKL');
 184 is $myCodonTable->reverse_translate_all($seq), 'GCBWSNGAYTTYGGVCAYAARYTN';
 185 ok $seq = Bio::PrimarySeq->new(-seq => 'ASXFHKL');
 186 is $myCodonTable->reverse_translate_all($seq), 'GCBWSNNNNTTYCAYAARYTN';
 187
 188 #
 189 # test reverse_translate_best(), requires a Bio::CodonUsage::Table object
 190 #
 191
 192 ok $seq = Bio::PrimarySeq->new(-seq =>'ACDEFGHIKLMNPQRSTVWY');
 193 ok my $io = Bio::CodonUsage::IO->new(-file => test_input_file('MmCT'));
 194 ok my $cut = $io->next_data();
 195 is $myCodonTable->reverse_translate_best($seq,$cut), 'GCCTGCGACGAGTTCGGCCACATCAAGCTGATGAACCCCCAGCGCTCCACCGTGTGGTAC';