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 => 61);
  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 # Automatically completing translation of incomplete codons is no longer default
  50 # behavior b/c of inconsistent behavior compared with Bio::PrimarySeq::translate
  51 # and unexpected side effects (e.g. what if the last few bases isn't supposed to
  52 # be translated). To re-establish this, pass a second argument to the method.
  53
  54 is $myCodonTable->translate(''), '';
  55
  56 my @ii  = qw(ACT acu ATN gt ytr sar);
  57 my @res = qw(T   T   X   V  L   Z  );
  58 my $test = 1;
  59 for my $i (0..$#ii) {
  60     if ($res[$i] ne $myCodonTable->translate($ii[$i], 1) ) {
  61         $test = 0;
  62         print $ii[$i], ": |", $res[$i], "| ne |",
  63         $myCodonTable->translate($ii[$i], 1), "|\n" if( $DEBUG);
  64         last ;
  65     }
  66 }
  67 ok ($test);
  68 is $myCodonTable->translate('ag'), '';
  69 is $myCodonTable->translate('ag',1), '';
  70
  71 is $myCodonTable->translate('jj'), '';
  72 is $myCodonTable->translate('jj',1), '';
  73
  74 is $myCodonTable->translate('jjg'), 'X';
  75 is $myCodonTable->translate('jjg',1), 'X';
  76
  77 is $myCodonTable->translate('gt'), '';
  78 is $myCodonTable->translate('gt',1), 'V';
  79
  80 is $myCodonTable->translate('g'), '';
  81 is $myCodonTable->translate('g',1), '';
  82
  83 # a more comprehensive test on ambiguous codes
  84 my $seq = <<SEQ;
  85 atgaaraayacmacracwackacyacsacvachacdacbacxagragyatmatwatyathcarcayc
  86 cmccrccwcckccyccsccvcchccdccbccxcgmcgrcgwcgkcgycgscgvcghcgdcgbcgxctmctrct
  87 wctkctyctsctvcthctdctbctxgargaygcmgcrgcwgckgcygcsgcvgchgcdgcbgcxggmggrggw
  88 ggkggyggsggvgghggdggbggxgtmgtrgtwgtkgtygtsgtvgthgtdgtbgtxtartaytcmtcrtcwt
  89 cktcytcstcvtchtcdtcbtcxtgyttrttytramgamggmgrracratrayytaytgytrsaasagsartaa;
  90 SEQ
  91     $seq =~ s/\s+//g;
  92 @ii = grep { length == 3 } split /(.{3})/, $seq;
  93 print join (' ', @ii), "\n" if( $DEBUG);
  94 my $prot = <<PROT;
  95 MKNTTTTTTTTTTTRSIIIIQHPPPPPPPPPPPRRRRRRRRRRRLLLLLLLLLLLEDAAAAAAAAAAAGGG
  96 GGGGGGGGVVVVVVVVVVV*YSSSSSSSSSSSCLF*RRRBBBLLLZZZ*
  97 PROT
  98
  99     $prot =~ s/\s//;
 100 @res = split //, $prot;
 101 print join (' ', @res), "\n" if( $DEBUG );
 102 $test = 1;
 103 for my $i (0..$#ii) {
 104     if ($res[$i] ne $myCodonTable->translate($ii[$i]) ) {
 105         $test = 0;
 106         print $ii[$i], ": |", $res[$i], "| ne |",
 107           $myCodonTable->translate($ii[$i]),  "| @ $i\n" if( $DEBUG);
 108         last ;
 109     }
 110 }
 111 ok $test;
 112
 113 # reverse translate amino acids
 114
 115 is $myCodonTable->revtranslate('U'), 0;
 116 is $myCodonTable->revtranslate('O'), 0;
 117 is $myCodonTable->revtranslate('J'), 9;
 118 is $myCodonTable->revtranslate('I'), 3;
 119
 120 @ii = qw(A l ACN Thr sER ter Glx);
 121 @res = (
 122         [qw(gct gcc gca gcg)],
 123         [qw(ggc gga ggg act acc aca acg)],
 124         [qw(tct tcc tca tcg agt agc)],
 125         [qw(act acc aca acg)],
 126         [qw(tct tcc tca tcg agt agc)],
 127         [qw(taa tag tga)],
 128         [qw(gaa gag caa cag)]
 129         );
 130
 131 $test = 1;
 132  TESTING: {
 133      for my $i (0..$#ii) {
 134          my @codonres = $myCodonTable->revtranslate($ii[$i]);
 135          for my $j (0..$#codonres) {
 136              if ($codonres[$j] ne $res[$i][$j]) {
 137                  $test = 0;
 138                  print $ii[$i], ': ', $codonres[$j], " ne ",
 139                  $res[$i][$j], "\n" if( $DEBUG);
 140                  last TESTING;
 141              }
 142          }
 143      }
 144  }
 145 ok $test;
 146
 147 #  boolean tests
 148 $myCodonTable->id(1);
 149
 150 ok $myCodonTable->is_start_codon('ATG');
 151 is $myCodonTable->is_start_codon('GGH'), 0;
 152 ok $myCodonTable->is_start_codon('HTG');
 153 is $myCodonTable->is_start_codon('CCC'), 0;
 154
 155 ok $myCodonTable->is_ter_codon('UAG');
 156 ok $myCodonTable->is_ter_codon('TaG');
 157 ok $myCodonTable->is_ter_codon('TaR');
 158 ok $myCodonTable->is_ter_codon('tRa');
 159 is $myCodonTable->is_ter_codon('ttA'), 0;
 160
 161 ok $myCodonTable->is_unknown_codon('jAG');
 162 ok $myCodonTable->is_unknown_codon('jg');
 163 is $myCodonTable->is_unknown_codon('UAG'), 0;
 164
 165 is $myCodonTable->translate_strict('ATG'), 'M';
 166
 167
 168
 169 #
 170 # adding a custom codon table
 171 #
 172
 173
 174 my @custom_table =
 175     ( 'test1',
 176       'FFLLSSSSYY**CC*WLLLL**PPHHQQR*RRIIIMT*TT*NKKSSRRV*VVAA*ADDEE*GGG'
 177     );
 178
 179 ok my $custct = $myCodonTable->add_table(@custom_table);
 180 is $custct, 24;
 181 is $myCodonTable->translate('atgaaraayacmacracwacka'), 'MKNTTTT';
 182 ok $myCodonTable->id($custct);
 183 is $myCodonTable->translate('atgaaraayacmacracwacka'), 'MKXXTTT';
 184
 185 # test doing this via Bio::PrimarySeq object
 186
 187 use Bio::PrimarySeq;
 188 ok $seq = Bio::PrimarySeq->new(-seq=>'atgaaraayacmacracwacka', -alphabet=>'dna');
 189 is $seq->translate()->seq, 'MKNTTTT';
 190 is $seq->translate(undef, undef, undef, undef, undef, undef, $myCodonTable)->seq, 'MKXXTTT';
 191
 192 # test gapped translated
 193
 194 ok $seq = Bio::PrimarySeq->new(-seq      => 'atg---aar------aay',
 195                                            -alphabet => 'dna');
 196 is $seq->translate->seq, 'M-K--N';
 197
 198 ok $seq = Bio::PrimarySeq->new(-seq =>'ASDFGHKL');
 199 is $myCodonTable->reverse_translate_all($seq), 'GCBWSNGAYTTYGGVCAYAARYTN';
 200 ok $seq = Bio::PrimarySeq->new(-seq => 'ASXFHKL');
 201 is $myCodonTable->reverse_translate_all($seq), 'GCBWSNNNNTTYCAYAARYTN';
 202
 203 #
 204 # test reverse_translate_best(), requires a Bio::CodonUsage::Table object
 205 #
 206
 207 ok $seq = Bio::PrimarySeq->new(-seq =>'ACDEFGHIKLMNPQRSTVWY');
 208 ok my $io = Bio::CodonUsage::IO->new(-file => test_input_file('MmCT'));
 209 ok my $cut = $io->next_data();
 210 is $myCodonTable->reverse_translate_best($seq,$cut), 'GCCTGCGACGAGTTCGGCCACATCAAGCTGATGAACCCCCAGCGCTCCACCGTGTGGTAC';