t/CodonTable.t

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