← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to t/SeqTools/SeqUtils.t

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

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