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 => 81);
  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');
 164 is $myCodonTable->is_start_codon('GGH'), 0;
 165 ok $myCodonTable->is_start_codon('HTG');
 166 is $myCodonTable->is_start_codon('CCC'), 0;
 167
 168 ok $myCodonTable->is_ter_codon('UAG');
 169 ok $myCodonTable->is_ter_codon('TaG');
 170 ok $myCodonTable->is_ter_codon('TaR');
 171 ok $myCodonTable->is_ter_codon('tRa');
 172 is $myCodonTable->is_ter_codon('ttA'), 0;
 173
 174 ok $myCodonTable->is_unknown_codon('jAG');
 175 ok $myCodonTable->is_unknown_codon('jg');
 176 is $myCodonTable->is_unknown_codon('UAG'), 0;
 177
 178 is $myCodonTable->translate_strict('ATG'), 'M';
 179
 180 #
 181 # adding a custom codon table
 182 #
 183
 184 my @custom_table =
 185     ( 'test1',
 186       'FFLLSSSSYY**CC*WLLLL**PPHHQQR*RRIIIMT*TT*NKKSSRRV*VVAA*ADDEE*GGG'
 187     );
 188
 189 ok my $custct = $myCodonTable->add_table(@custom_table);
 190 is $custct, 26;
 191 is $myCodonTable->translate('atgaaraayacmacracwacka'), 'MKNTTTT';
 192 ok $myCodonTable->id($custct);
 193 is $myCodonTable->translate('atgaaraayacmacracwacka'), 'MKXXTTT';
 194
 195 # test doing this via Bio::PrimarySeq object
 196
 197 use Bio::PrimarySeq;
 198 ok $seq = Bio::PrimarySeq->new(-seq=>'atgaaraayacmacracwacka', -alphabet=>'dna');
 199 is $seq->translate()->seq, 'MKNTTTT';
 200 is $seq->translate(undef, undef, undef, undef, undef, undef, $myCodonTable)->seq, 'MKXXTTT';
 201
 202 # test gapped translated
 203
 204 ok $seq = Bio::PrimarySeq->new(-seq      => 'atg---aar------aay',
 205                                -alphabet => 'dna');
 206 is $seq->translate->seq, 'M-K--N';
 207
 208 ok $seq = Bio::PrimarySeq->new(-seq =>'ASDFGHKL');
 209 is $myCodonTable->reverse_translate_all($seq), 'GCBWSNGAYTTYGGVCAYAARYTN';
 210 ok $seq = Bio::PrimarySeq->new(-seq => 'ASXFHKL');
 211 is $myCodonTable->reverse_translate_all($seq), 'GCBWSNNNNTTYCAYAARYTN';
 212
 213 #
 214 # test reverse_translate_best(), requires a Bio::CodonUsage::Table object
 215 #
 216
 217 ok $seq = Bio::PrimarySeq->new(-seq =>'ACDEFGHIKLMNPQRSTVWYX');
 218 ok my $io = Bio::CodonUsage::IO->new(-file => test_input_file('MmCT'));
 219 ok my $cut = $io->next_data();
 220 is $myCodonTable->reverse_translate_best($seq,$cut), 'GCCTGCGACGAGTTCGGCCACATCAAGCTGATGAACCCCCAGCGCTCCACCGTGTGGTACNNN';
 221 is $myCodonTable->reverse_translate_all($seq, $cut, 15), 'GCNTGYGAYGARTTYGGVCAYATYAARCTSATGAAYCCNCARMGVWSYACHGTSTGGTAYNNN';
 222
 223 #
 224 # test 'Strict' table, requires a Bio::CodonUsage::Table object
 225 #
 226
 227 $myCodonTable = Bio::Tools::CodonTable->new(); # Default Standard table
 228
 229 #  boolean tests
 230 is $myCodonTable->is_start_codon('ATG'), 1;
 231 is $myCodonTable->is_start_codon('GTG'), 0;
 232 is $myCodonTable->is_start_codon('TTG'), 1;
 233 is $myCodonTable->is_start_codon('CTG'), 1;
 234 is $myCodonTable->is_start_codon('CCC'), 0;
 235
 236 $myCodonTable->id(0); # Special 'Strict' table (ATG-only start)
 237
 238 is $myCodonTable->is_start_codon('ATG'), 1;
 239 is $myCodonTable->is_start_codon('GTG'), 0;
 240 is $myCodonTable->is_start_codon('TTG'), 0;
 241 is $myCodonTable->is_start_codon('CTG'), 0;
 242 is $myCodonTable->is_start_codon('CCC'), 0;
 243
 244 # Pterobranchia Mitochondrial codon table
 245 $myCodonTable->id(24);
 246 is $myCodonTable->is_start_codon('GTG'), 1;
 247 is $myCodonTable->is_start_codon('CTG'), 1;
 248 is $myCodonTable->translate_strict('TGA'), 'W';
 249
 250 # Candidate Division SR1 and Gracilibacteria codon table
 251 $myCodonTable->id(25);
 252 is $myCodonTable->is_start_codon('GTG'), 1;
 253 is $myCodonTable->is_start_codon('CTG'), 0;
 254 is $myCodonTable->translate_strict('TGA'), 'G';