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 => 84);
  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 # invalid table should produce a warn and set default table (1)
  27 my $stderr = '';
  28 {
  29     # capture stderr output
  30     local *STDERR;
  31     open STDERR, '>', \$stderr;
  32     $myCodonTable->id(99);
  33 }
  34 like $stderr, qr/Not a valid codon table ID/;
  35 is $myCodonTable->id, 1;
  36
  37 # change codon table
  38 $myCodonTable->id(10);
  39 is $myCodonTable->id, 10;
  40 is $myCodonTable->name(), 'Euplotid Nuclear';
  41
  42 # enumerate tables as object method
  43 my $table = $myCodonTable->tables();
  44 cmp_ok (keys %{$table}, '>=', 19); # currently 19 known tables
  45 is $table->{11}, 'Bacterial, Archaeal and Plant Plastid';
  46
  47 # enumerate tables as class method
  48 $table = Bio::Tools::CodonTable->tables;
  49 cmp_ok (values %{$table}, '>=', 19); # currently 19 known tables
  50 is $table->{23}, 'Thraustochytrium Mitochondrial';
  51
  52 # translate codons
  53 $myCodonTable->id(1);
  54
  55 eval {
  56     $myCodonTable->translate();
  57 };
  58 ok ($@ =~ /EX/) ;
  59
  60 # Automatically completing translation of incomplete codons is no longer default
  61 # behavior b/c of inconsistent behavior compared with Bio::PrimarySeq::translate
  62 # and unexpected side effects (e.g. what if the last few bases isn't supposed to
  63 # be translated). To re-establish this, pass a second argument to the method.
  64
  65 is $myCodonTable->translate(''), '';
  66
  67 my @ii  = qw(ACT acu ATN gt ytr sar);
  68 my @res = qw(T   T   X   V  L   Z  );
  69 my $test = 1;
  70 for my $i (0..$#ii) {
  71     if ($res[$i] ne $myCodonTable->translate($ii[$i], 1) ) {
  72         $test = 0;
  73         print $ii[$i], ": |", $res[$i], "| ne |",
  74         $myCodonTable->translate($ii[$i], 1), "|\n" if( $DEBUG);
  75         last ;
  76     }
  77 }
  78 ok ($test);
  79 is $myCodonTable->translate('ag'), '';
  80 is $myCodonTable->translate('ag',1), '';
  81
  82 is $myCodonTable->translate('jj'), '';
  83 is $myCodonTable->translate('jj',1), '';
  84
  85 is $myCodonTable->translate('jjg'), 'X';
  86 is $myCodonTable->translate('jjg',1), 'X';
  87
  88 is $myCodonTable->translate('gt'), '';
  89 is $myCodonTable->translate('gt',1), 'V';
  90
  91 is $myCodonTable->translate('g'), '';
  92 is $myCodonTable->translate('g',1), '';
  93
  94 # a more comprehensive test on ambiguous codes
  95 my $seq = <<SEQ;
  96 atgaaraayacmacracwackacyacsacvachacdacbacxagragyatmatwatyathcarcayc
  97 cmccrccwcckccyccsccvcchccdccbccxcgmcgrcgwcgkcgycgscgvcghcgdcgbcgxctmctrct
  98 wctkctyctsctvcthctdctbctxgargaygcmgcrgcwgckgcygcsgcvgchgcdgcbgcxggmggrggw
  99 ggkggyggsggvgghggdggbggxgtmgtrgtwgtkgtygtsgtvgthgtdgtbgtxtartaytcmtcrtcwt
 100 cktcytcstcvtchtcdtcbtcxtgyttrttytramgamggmgrracratrayytaytgytrsaasagsartaa;
 101 SEQ
 102     $seq =~ s/\s+//g;
 103 @ii = grep { length == 3 } split /(.{3})/, $seq;
 104 print join (' ', @ii), "\n" if( $DEBUG);
 105 my $prot = <<PROT;
 106 MKNTTTTTTTTTTTRSIIIIQHPPPPPPPPPPPRRRRRRRRRRRLLLLLLLLLLLEDAAAAAAAAAAAGGG
 107 GGGGGGGGVVVVVVVVVVV*YSSSSSSSSSSSCLF*RRRBBBLLLZZZ*
 108 PROT
 109     $prot =~ s/\s//;
 110 @res = split //, $prot;
 111 print join (' ', @res), "\n" if( $DEBUG );
 112
 113 $test = 1;
 114 for my $i (0..$#ii) {
 115     if ($res[$i] ne $myCodonTable->translate($ii[$i]) ) {
 116         $test = 0;
 117         print $ii[$i], ": |", $res[$i], "| ne |",
 118         $myCodonTable->translate($ii[$i]),  "| @ $i\n" if( $DEBUG);
 119         last ;
 120     }
 121 }
 122 ok $test;
 123
 124 # reverse translate amino acids
 125
 126 is $myCodonTable->revtranslate('U'), 0;
 127 is $myCodonTable->revtranslate('O'), 0;
 128 is $myCodonTable->revtranslate('J'), 9;
 129 is $myCodonTable->revtranslate('I'), 3;
 130 my @RNA_codons = $myCodonTable->revtranslate('M', 'RNA');
 131 is $RNA_codons[0], 'aug'; # test RNA output
 132
 133 @ii = qw(A l ACN Thr sER ter Glx);
 134 @res = (
 135     [qw(gct gcc gca gcg)],
 136     [qw(ggc gga ggg act acc aca acg)],
 137     [qw(tct tcc tca tcg agt agc)],
 138     [qw(act acc aca acg)],
 139     [qw(tct tcc tca tcg agt agc)],
 140     [qw(taa tag tga)],
 141     [qw(gaa gag caa cag)]
 142     );
 143
 144 $test = 1;
 145  TESTING: {
 146      for my $i (0..$#ii) {
 147          my @codonres = $myCodonTable->revtranslate($ii[$i]);
 148          for my $j (0..$#codonres) {
 149              if ($codonres[$j] ne $res[$i][$j]) {
 150                  $test = 0;
 151                  print $ii[$i], ': ', $codonres[$j], " ne ",
 152                  $res[$i][$j], "\n" if( $DEBUG);
 153                  last TESTING;
 154              }
 155          }
 156      }
 157  }
 158 ok $test;
 159
 160 # boolean tests
 161 $myCodonTable->id(1); # Standard table
 162
 163 ok $myCodonTable->is_start_codon('ATG'), 'is_start_codon, ATG';
 164 is $myCodonTable->is_start_codon('GGH'), 0, 'is_start_codon, GGH';
 165 ok $myCodonTable->is_start_codon('HTG'), 'is_start_codon, HTG';
 166 is $myCodonTable->is_start_codon('CCC'), 0, 'is_start_codon, CCC';
 167
 168 ok $myCodonTable->is_ter_codon('UAG'), 'is_ter_codon, U should map to T, UAG';
 169 ok $myCodonTable->is_ter_codon('TaG'), 'is_ter_codon,TaG';
 170 ok $myCodonTable->is_ter_codon('TaR'), 'is_ter_codon,TaR';
 171 ok $myCodonTable->is_ter_codon('tRa'), 'is_ter_codon,tRa';
 172 is $myCodonTable->is_ter_codon('ttA'), 0, 'is_ter_codon,ttA';
 173
 174 # Ambiguous codons should fail
 175 is $myCodonTable->is_ter_codon('NNN'), 0, 'is_ter_codon, ambiguous codons should fail, NNN';
 176 is $myCodonTable->is_ter_codon('TAN'), 0, 'is_ter_codon, ambiguous codons should fail, TAN';
 177 is $myCodonTable->is_ter_codon('CC'), 0, 'is_ter_codon, incomplete codons should fail, CC';
 178
 179 ok $myCodonTable->is_unknown_codon('jAG');
 180 ok $myCodonTable->is_unknown_codon('jg');
 181 is $myCodonTable->is_unknown_codon('UAG'), 0;
 182
 183 is $myCodonTable->translate_strict('ATG'), 'M';
 184
 185 #
 186 # adding a custom codon table
 187 #
 188
 189 my @custom_table =
 190     ( 'test1',
 191       'FFLLSSSSYY**CC*WLLLL**PPHHQQR*RRIIIMT*TT*NKKSSRRV*VVAA*ADDEE*GGG'
 192     );
 193
 194 ok my $custct = $myCodonTable->add_table(@custom_table);
 195 is $custct, 26;
 196 is $myCodonTable->translate('atgaaraayacmacracwacka'), 'MKNTTTT';
 197 ok $myCodonTable->id($custct);
 198 is $myCodonTable->translate('atgaaraayacmacracwacka'), 'MKXXTTT';
 199
 200 # test doing this via Bio::PrimarySeq object
 201
 202 use Bio::PrimarySeq;
 203 ok $seq = Bio::PrimarySeq->new(-seq=>'atgaaraayacmacracwacka', -alphabet=>'dna');
 204 is $seq->translate()->seq, 'MKNTTTT';
 205 is $seq->translate(undef, undef, undef, undef, undef, undef, $myCodonTable)->seq, 'MKXXTTT';
 206
 207 # test gapped translated
 208
 209 ok $seq = Bio::PrimarySeq->new(-seq      => 'atg---aar------aay',
 210                                -alphabet => 'dna');
 211 is $seq->translate->seq, 'M-K--N';
 212
 213 ok $seq = Bio::PrimarySeq->new(-seq =>'ASDFGHKL');
 214 is $myCodonTable->reverse_translate_all($seq), 'GCBWSNGAYTTYGGVCAYAARYTN';
 215 ok $seq = Bio::PrimarySeq->new(-seq => 'ASXFHKL');
 216 is $myCodonTable->reverse_translate_all($seq), 'GCBWSNNNNTTYCAYAARYTN';
 217
 218 #
 219 # test reverse_translate_best(), requires a Bio::CodonUsage::Table object
 220 #
 221
 222 ok $seq = Bio::PrimarySeq->new(-seq =>'ACDEFGHIKLMNPQRSTVWYX');
 223 ok my $io = Bio::CodonUsage::IO->new(-file => test_input_file('MmCT'));
 224 ok my $cut = $io->next_data();
 225 is $myCodonTable->reverse_translate_best($seq,$cut), 'GCCTGCGACGAGTTCGGCCACATCAAGCTGATGAACCCCCAGCGCTCCACCGTGTGGTACNNN';
 226 is $myCodonTable->reverse_translate_all($seq, $cut, 15), 'GCNTGYGAYGARTTYGGVCAYATYAARCTSATGAAYCCNCARMGVWSYACHGTSTGGTAYNNN';
 227
 228 #
 229 # test 'Strict' table, requires a Bio::CodonUsage::Table object
 230 #
 231
 232 $myCodonTable = Bio::Tools::CodonTable->new(); # Default Standard table
 233
 234 #  boolean tests
 235 is $myCodonTable->is_start_codon('ATG'), 1;
 236 is $myCodonTable->is_start_codon('GTG'), 0;
 237 is $myCodonTable->is_start_codon('TTG'), 1;
 238 is $myCodonTable->is_start_codon('CTG'), 1;
 239 is $myCodonTable->is_start_codon('CCC'), 0;
 240
 241 $myCodonTable->id(0); # Special 'Strict' table (ATG-only start)
 242
 243 is $myCodonTable->is_start_codon('ATG'), 1;
 244 is $myCodonTable->is_start_codon('GTG'), 0;
 245 is $myCodonTable->is_start_codon('TTG'), 0;
 246 is $myCodonTable->is_start_codon('CTG'), 0;
 247 is $myCodonTable->is_start_codon('CCC'), 0;
 248
 249 # Pterobranchia Mitochondrial codon table
 250 $myCodonTable->id(24);
 251 is $myCodonTable->is_start_codon('GTG'), 1;
 252 is $myCodonTable->is_start_codon('CTG'), 1;
 253 is $myCodonTable->translate_strict('TGA'), 'W';
 254
 255 # Candidate Division SR1 and Gracilibacteria codon table
 256 $myCodonTable->id(25);
 257 is $myCodonTable->is_start_codon('GTG'), 1;
 258 is $myCodonTable->is_start_codon('CTG'), 0;
 259 is $myCodonTable->translate_strict('TGA'), 'G';