t/SeqTools/CodonTable.t

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