t/SeqUtils.t

   1 # -*-Perl-*-
   2 ## Bioperl Test Harness Script for Modules
   3 ##$Id$
   4
   5 use strict;
   6
   7 BEGIN {
   8     # to handle systems with no installed Test module
   9     # we include the t dir (where a copy of Test.pm is located)
  10     # as a fallback
  11     eval { require Test; };
  12     if( $@ ) {
  13         use lib 't';
  14     }
  15     use Test;
  16     plan tests => 37;
  17 }
  18
  19 use Bio::PrimarySeq;
  20 use Bio::SeqUtils;
  21 use Bio::LiveSeq::Mutation;
  22 ok 1;
  23
  24 my ($seq, $util, $ascii, $ascii_aa, $ascii3);
  25
  26 # Entire alphabet now IUPAC-endorsed and used in GenBank (Oct 2006)
  27 $ascii =    'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  28 $ascii_aa = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  29
  30 $ascii3 =
  31     'AlaAsxCysAspGluPheGlyHisIleXleLysLeuMetAsnPylProGlnArgSerThrSecValTrpXaaTyrGlx';
  32
  33 $seq = Bio::PrimarySeq->new('-seq'=> $ascii,
  34                             '-alphabet'=>'protein',
  35                                '-id'=>'test');
  36
  37 # one letter amino acid code to three letter code
  38 ok $util = new Bio::SeqUtils;
  39 ok $util->seq3($seq), $ascii3;
  40
  41 #using anonymous hash
  42 ok (Bio::SeqUtils->seq3($seq), $ascii3);
  43 ok (Bio::SeqUtils->seq3($seq, undef, ','),
  44     'Ala,Asx,Cys,Asp,Glu,Phe,Gly,His,Ile,Xle,Lys,'.
  45     'Leu,Met,Asn,Pyl,Pro,Gln,Arg,Ser,Thr,Sec,Val,Trp,Xaa,Tyr,Glx');
  46
  47 $seq->seq('asd-KJJK-');
  48 ok (Bio::SeqUtils->seq3($seq, '-', ':'),
  49     'Ala:Ser:Asp:Ter:Lys:Xle:Xle:Lys:Ter');
  50
  51 # three letter amino acid code to one letter code
  52 ok (Bio::SeqUtils->seq3in($seq, 'AlaPYHCysAspGlu')),
  53 ok  $seq->seq, 'AXCDE';
  54 ok (Bio::SeqUtils->seq3in($seq, $ascii3)->seq, $ascii_aa);
  55 #ok ();
  56
  57 #
  58 # Tests for multiframe translations
  59 #
  60
  61 $seq = Bio::PrimarySeq->new('-seq'=> 'agctgctgatcggattgtgatggctggatggcttgggatgctgg',
  62                             '-alphabet'=>'dna',
  63                             '-id'=>'test2');
  64
  65 my @a = $util->translate_3frames($seq);
  66 ok scalar @a, 3;
  67 #foreach $a (@a) {
  68 #    print 'ID: ', $a->id, ' ', $a->seq, "\n";
  69 #}
  70
  71 @a = $util->translate_6frames($seq);
  72 ok scalar @a, 6;
  73 #foreach $a (@a) {
  74 #    print 'ID: ', $a->id, ' ', $a->seq, "\n";
  75 #}
  76
  77 #
  78 # test for valid AA return
  79 #
  80
  81 my @valid_aa = sort Bio::SeqUtils->valid_aa;
  82 ok(@valid_aa, 27);
  83 ok ($valid_aa[1], 'A');
  84
  85 @valid_aa = sort Bio::SeqUtils->valid_aa(1);
  86 ok(@valid_aa, 27);
  87 ok ($valid_aa[1], 'Arg');
  88
  89 my %valid_aa = Bio::SeqUtils->valid_aa(2);
  90 ok keys %valid_aa, 54;
  91 ok($valid_aa{'C'}, 'Cys');
  92 ok( $valid_aa{'Cys'}, 'C');
  93
  94
  95 #
  96 # Mutate
  97 #
  98
  99 my $string1 = 'aggt';
 100 $seq = Bio::PrimarySeq->new('-seq'=> 'aggt',
 101                             '-alphabet'=>'dna',
 102                             '-id'=>'test3');
 103
 104 # point
 105 Bio::SeqUtils->mutate($seq,
 106                       Bio::LiveSeq::Mutation->new(-seq => 'c',
 107                                                   -pos => 3
 108                                                  )
 109                      );
 110 ok $seq->seq, 'agct';
 111
 112 # insertion and deletion
 113 my @mutations = (
 114                  Bio::LiveSeq::Mutation->new(-seq => 'tt',
 115                                              -pos => 2,
 116                                              -len => 0
 117                                             ),
 118                  Bio::LiveSeq::Mutation->new(-pos => 2,
 119                                              -len => 2
 120                                             )
 121 );
 122
 123 Bio::SeqUtils->mutate($seq, @mutations);
 124 ok $seq->seq, 'agct';
 125
 126 # insertion to the end of the sequence
 127 Bio::SeqUtils->mutate($seq,
 128                       Bio::LiveSeq::Mutation->new(-seq => 'aa',
 129                                                   -pos => 5,
 130                                                   -len => 0
 131                                                  )
 132                      );
 133 ok $seq->seq, 'agctaa';
 134
 135
 136
 137 #
 138 # testing Bio::SeqUtils->cat
 139 #
 140
 141 use Bio::Annotation::SimpleValue;
 142 use Bio::Seq::RichSeq;;
 143
 144
 145 # PrimarySeqs
 146
 147 my $primseq1 = new Bio::PrimarySeq(-id => 1, -seq => 'acgt', -description => 'master');
 148 my $primseq2 = new Bio::PrimarySeq(-id => 2, -seq => 'tgca');
 149
 150 Bio::SeqUtils->cat($primseq1, $primseq2);
 151 ok $primseq1->seq, 'acgttgca';
 152 ok $primseq1->description, 'master';
 153
 154 #should work for Bio::LocatableSeq
 155 #should work for Bio::Seq::MetaI Seqs?
 156
 157
 158 # Bio::SeqI
 159
 160 my $seq1 = new Bio::Seq(-id => 1, -seq => 'aaaa', -description => 'first');
 161 my $seq2 = new Bio::Seq(-id => 2, -seq => 'tttt', -description => 'second');
 162 my $seq3 = new Bio::Seq(-id => 3, -seq => 'cccc', -description => 'third');
 163
 164
 165 #  annotations
 166 my $ac2 = new Bio::Annotation::Collection;
 167 my $simple1 = Bio::Annotation::SimpleValue->new(
 168                                                 -tagname => 'colour',
 169                                                 -value   => 'blue'
 170                                                ), ;
 171 my $simple2 = Bio::Annotation::SimpleValue->new(
 172                                                 -tagname => 'colour',
 173                                                 -value   => 'black'
 174                                                ), ;
 175 $ac2->add_Annotation('simple',$simple1);
 176 $ac2->add_Annotation('simple',$simple2);
 177 $seq2->annotation($ac2);
 178
 179 my $ac3 = new Bio::Annotation::Collection;
 180 my $simple3 = Bio::Annotation::SimpleValue->new(
 181                                                 -tagname => 'colour',
 182                                                 -value   => 'red'
 183                                                  ), ;
 184 $ac3->add_Annotation('simple',$simple3);
 185 $seq3->annotation($ac3);
 186
 187
 188 ok (Bio::SeqUtils->cat($seq1, $seq2, $seq3));
 189 ok $seq1->seq, 'aaaattttcccc';
 190 ok scalar $seq1->get_Annotations, 3;
 191
 192
 193 # seq features
 194 use Bio::SeqFeature::Generic;
 195
 196 my $ft2 = new Bio::SeqFeature::Generic ( -start => 1,
 197                                       -end => 4,
 198                                       -strand => 1,
 199                                       -primary => 'source',
 200                                        );
 201
 202
 203 my $ft3 = new Bio::SeqFeature::Generic ( -start => 3,
 204                                       -end => 3,
 205                                       -strand => 1,
 206                                       -primary => 'hotspot',
 207                                        );
 208
 209 $seq2->add_SeqFeature($ft2);
 210 $seq2->add_SeqFeature($ft3);
 211
 212
 213 ok (Bio::SeqUtils->cat($seq1, $seq2));
 214 ok $seq1->seq, 'aaaattttcccctttt';
 215 ok scalar $seq1->get_Annotations, 5;
 216
 217
 218 my $protseq = new Bio::PrimarySeq(-id => 2, -seq => 'MVTF'); # protein seq
 219
 220 eval {
 221     Bio::SeqUtils->cat($seq1, $protseq);
 222 };
 223 ok 1 if $@; # did throw
 224
 225 #use Data::Dumper; print Dumper $seq1;
 226
 227
 228
 229
 230
 231
 232 #
 233 # evolve()
 234 #
 235
 236 $seq = Bio::PrimarySeq->new('-seq'=> 'aaaaaaaaaa',
 237                             '-id'=>'test');
 238
 239
 240
 241 $util = new Bio::SeqUtils(-verbose => 0);
 242 ok my $newseq = $util->evolve($seq, 60, 4);
 243
 244 #  annotations
 245
 246 $seq2 = new Bio::Seq(-id => 2, -seq => 'ggttaaaa', -description => 'second');
 247 $ac3 = new Bio::Annotation::Collection;
 248 $simple3 = Bio::Annotation::SimpleValue->new(
 249                                                 -tagname => 'colour',
 250                                                 -value   => 'red'
 251                                                  ), ;
 252 $ac3->add_Annotation('simple',$simple3);
 253 $seq2->annotation($ac3);
 254 $ft2 = new Bio::SeqFeature::Generic ( -start => 1,
 255                                       -end => 4,
 256                                       -strand => 1,
 257                                       -primary => 'source',
 258                                        );
 259
 260
 261 $ft3 = new Bio::SeqFeature::Generic ( -start => 5,
 262                                       -end => 8,
 263                                       -strand => -1,
 264                                       -primary => 'hotspot',
 265                                        );
 266 $seq2->add_SeqFeature($ft2);
 267 $seq2->add_SeqFeature($ft3);
 268
 269 my $trunc=Bio::SeqUtils->trunc_with_features($seq2, 2, 7);
 270 ok $trunc->seq, 'gttaaa';
 271 my @feat=$trunc->get_SeqFeatures;
 272 ok $feat[0]->location->to_FTstring, '<1..3';
 273 ok $feat[1]->location->to_FTstring, 'complement(4..>6)';
 274
 275 my $revcom=Bio::SeqUtils->revcom_with_features($seq2);
 276 ok $revcom->seq, 'ttttaacc';
 277 my @revfeat=$revcom->get_SeqFeatures;
 278 ok $revfeat[0]->location->to_FTstring, 'complement(5..8)';
 279 ok $revfeat[1]->location->to_FTstring, '1..4';