← Back to branch summary

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

« back to all changes in this revision

Viewing changes to t/Seq/PrimaryQual.t

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
http://bugs.debian.org/722910
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/Seq/PrimaryQual.t
7
7
    use lib '.';
8
8
    use Bio::Root::Test;
9
9
    
10
 
    test_begin(-tests => 35);
11
 
        
 
10
    test_begin(-tests => 70);
 
11
 
12
12
    use_ok('Bio::SeqIO');
13
13
    use_ok('Bio::Seq::Quality');
14
14
    use_ok('Bio::Seq::PrimaryQual');
22
22
 
23
23
my $string_quals = "10 20 30 40 50 40 30 20 10";
24
24
print("Quals are $string_quals\n") if($DEBUG);
25
 
my $qualobj = Bio::Seq::PrimaryQual->new(
26
 
                                          '-qual' => $string_quals,
27
 
                                          '-id'  => 'QualityFragment-12',
28
 
                                          '-accession_number' => 'X78121',
29
 
                                          );
30
 
ok($qualobj);
31
 
is($qualobj->display_id, 'QualityFragment-12');
32
 
is($qualobj->accession_number, 'X78121');
33
 
 
34
 
my @q2 = split/ /,$string_quals;
35
 
$qualobj = Bio::Seq::PrimaryQual->new
36
 
    ( '-qual'             => \@q2,
37
 
      '-primary_id'          => 'chads primary_id',
38
 
      '-desc'                   => 'chads desc',
39
 
      '-accession_number' => 'chads accession_number',
40
 
      '-id'                        => 'chads id',
41
 
                '-header'           => 'chads header'
42
 
      );
43
 
 
44
 
is($qualobj->primary_id, 'chads primary_id');
45
 
my $rqual = $qualobj->qual();
46
 
is(ref($rqual),"ARRAY");
 
25
ok my $qualobj = Bio::Seq::PrimaryQual->new(
 
26
    -qual             => $string_quals,
 
27
    -id               => 'QualityFragment-12',
 
28
    -accession_number => 'X78121',
 
29
);
 
30
is $qualobj->display_id, 'QualityFragment-12';
 
31
is $qualobj->accession_number, 'X78121';
 
32
 
 
33
my @q2 = split / /, $string_quals;
 
34
$qualobj = Bio::Seq::PrimaryQual->new(
 
35
    -qual             => \@q2,
 
36
    -primary_id       => 'chads primary_id',
 
37
    -desc             => 'chads desc',
 
38
    -accession_number => 'chads accession_number',
 
39
    -id               => 'chads id',
 
40
    -header           => 'chads header'
 
41
);
 
42
 
 
43
is $qualobj->primary_id, 'chads primary_id';
 
44
isa_ok $qualobj->qual(), 'ARRAY';
47
45
 
48
46
my $newqualstring = "50 90 1000 20 12 0 0";
49
47
 
50
 
$qualobj->qual($newqualstring);
51
 
my $retrieved_quality = $qualobj->qual();
52
 
my $retrieved_quality_string = join(' ', @$retrieved_quality);
53
 
is($retrieved_quality_string,$newqualstring);
54
 
 
55
 
my @newqualarray = split/ /,$newqualstring;
56
 
$qualobj->qual(\@newqualarray);
57
 
$retrieved_quality = $qualobj->qual();
58
 
$retrieved_quality_string = join(' ',@$retrieved_quality);
59
 
is($retrieved_quality_string,$newqualstring);
60
 
 
61
 
eval {
62
 
    $qualobj->qual("chad");
63
 
};
64
 
like($@, qr/not look healthy/);
65
 
 
66
 
eval { $qualobj->qual(""); };
67
 
ok(!$@);
68
 
 
69
 
eval { $qualobj->qual(" 4"); };
70
 
ok(!$@);
71
 
 
72
 
$qualobj->qual("4 10");
73
 
 
74
 
is($qualobj->length(),2 );
 
48
ok $qualobj->qual($newqualstring);
 
49
is join(' ', @{$qualobj->qual()}), $newqualstring;
 
50
 
 
51
my @newqualarray = split / /,$newqualstring;
 
52
ok $qualobj->qual(\@newqualarray);
 
53
is join(' ', @{$qualobj->qual()}), $newqualstring;
 
54
 
 
55
is $qualobj->validate_qual($string_quals ), 1;
 
56
is $qualobj->validate_qual(""            ), 1;
 
57
is $qualobj->validate_qual("0"           ), 1;
 
58
is $qualobj->validate_qual(undef         ), 1;
 
59
is $qualobj->validate_qual("   "         ), 1;
 
60
is $qualobj->validate_qual("10 20 30 30" ), 1;
 
61
is $qualobj->validate_qual(" 20  9 5   " ), 1;
 
62
is $qualobj->validate_qual("+1 9.3 50e-1"), 1;
 
63
is $qualobj->validate_qual(" 4"          ), 1;
 
64
is $qualobj->validate_qual("chad"        ), 0;
 
65
is $qualobj->validate_qual("10 one"      ), 0;
 
66
 
 
67
ok $qualobj->qual("10 20 30 30");
 
68
ok $qualobj->qual("+1 9.3 50e-1");
 
69
throws_ok { $qualobj->qual("chad"); } qr/.+/;
 
70
throws_ok { $qualobj->validate_qual("chad", 1) } qr/.+/;
 
71
 
 
72
ok $qualobj->qual("4 10");
 
73
is $qualobj->length(), 2;
75
74
 
76
75
$qualobj->qual("10 20 30 40 50 40 30 20 10");
77
 
my @subquals = @{$qualobj->subqual(3,6);};
78
 
is(@subquals, 4);
79
 
     # chad, note to self, evaluate border conditions
80
 
is ("30 20 10", join(' ',@{$qualobj->subqual(7,9)}));
81
 
 
82
 
 
83
 
my @false_comparator = qw(30 40 70 40);
84
 
my @true_comparator = qw(30 40 50 40);
85
 
ok(!&compare_arrays(\@subquals,\@true_comparator));
86
 
 
87
 
eval { $qualobj->subqual(-1,6); };
88
 
like($@, qr/EX/ );
89
 
eval { $qualobj->subqual(1,6); };
90
 
ok(!$@);
91
 
eval { $qualobj->subqual(1,9); };
92
 
ok(!$@);
93
 
eval { $qualobj->subqual(9,1); };
94
 
like($@, qr/EX/ );
95
 
 
96
 
 
97
 
is($qualobj->display_id(), "chads id");
98
 
$qualobj->display_id("chads new display_id");
99
 
is($qualobj->display_id(), "chads new display_id");
100
 
 
101
 
is($qualobj->accession_number(), "chads accession_number");
102
 
$qualobj->accession_number("chads new accession_number");
103
 
is($qualobj->accession_number(), "chads new accession_number");
104
 
is($qualobj->primary_id(), "chads primary_id");
105
 
$qualobj->primary_id("chads new primary_id");
106
 
is($qualobj->primary_id(), "chads new primary_id");
107
 
 
108
 
is($qualobj->desc(), "chads desc");
109
 
$qualobj->desc("chads new desc");
110
 
is($qualobj->desc(), "chads new desc");
111
 
is($qualobj->display_id(), "chads new display_id");
112
 
$qualobj->display_id("chads new id");
113
 
is($qualobj->display_id(), "chads new id");
114
 
 
115
 
is($qualobj->header(), "chads header");
116
 
 
117
 
my $in_qual  = Bio::SeqIO->new(-file => test_input_file('qualfile.qual') ,
118
 
                               '-format' => 'qual',
119
 
                               '-verbose' => $verbose);
120
 
ok($in_qual);
121
 
my $pq = $in_qual->next_seq();
122
 
is($pq->qual()->[99], '39'); # spot check boundary
123
 
is($pq->qual()->[100], '39'); # spot check boundary
124
 
 
125
 
my $out_qual = Bio::SeqIO->new('-file'    => ">".test_output_file(),
126
 
                               '-format'  => 'qual',
127
 
                               '-verbose' => $verbose);
128
 
$out_qual->write_seq(-source    =>      $pq);
129
 
 
130
 
my $swq545 = Bio::Seq::Quality->new (   -seq    =>      "ATA",
131
 
                                        -qual   =>      $pq
132
 
                                    );
133
 
$out_qual->write_seq(-source    =>      $swq545);
134
 
 
135
 
$in_qual = Bio::SeqIO->new('-file' => test_input_file('qualfile.qual') , 
136
 
                           '-format' => 'qual',
137
 
                           '-verbose' => $verbose);
138
 
 
139
 
my $out_qual2 = Bio::SeqIO->new('-file' => ">".test_output_file(),
140
 
                                '-format'  => 'qual',
141
 
                                '-verbose' => $verbose);
 
76
ok my @subquals = @{$qualobj->subqual(3,6);};
 
77
is @subquals, 4;
 
78
is "30 20 10", join(' ',@{$qualobj->subqual(7,9)});
 
79
 
 
80
throws_ok { $qualobj->subqual(-1,6); } qr/EX/;
 
81
ok $qualobj->subqual(1,6);
 
82
ok $qualobj->subqual(1,9);
 
83
throws_ok { $qualobj->subqual(9,1); } qr/EX/;
 
84
 
 
85
 
 
86
is $qualobj->display_id(), "chads id";
 
87
is $qualobj->display_id("chads new display_id"), "chads new display_id";
 
88
is $qualobj->display_id(), "chads new display_id";
 
89
 
 
90
is $qualobj->accession_number(), "chads accession_number";
 
91
is $qualobj->accession_number("chads new accession_number"), "chads new accession_number";
 
92
is $qualobj->accession_number(), "chads new accession_number";
 
93
is $qualobj->primary_id(), "chads primary_id";
 
94
is $qualobj->primary_id("chads new primary_id"), "chads new primary_id";
 
95
is $qualobj->primary_id(), "chads new primary_id";
 
96
 
 
97
is $qualobj->desc(), "chads desc";
 
98
is $qualobj->desc("chads new desc"), "chads new desc";
 
99
is $qualobj->desc(), "chads new desc";
 
100
is $qualobj->display_id(), "chads new display_id";
 
101
is $qualobj->display_id("chads new id"), ("chads new id");
 
102
is $qualobj->display_id(), "chads new id";
 
103
 
 
104
is $qualobj->header(), "chads header";
 
105
 
 
106
ok my $in_qual  = Bio::SeqIO->new(
 
107
    -file    => test_input_file('qualfile.qual'),
 
108
    -format  => 'qual',
 
109
    -verbose => $verbose,
 
110
);
 
111
ok my $pq = $in_qual->next_seq();
 
112
is $pq->qual()->[99] , '39'; # spot check boundary
 
113
is $pq->qual()->[100], '39'; # spot check boundary
 
114
 
 
115
ok my $out_qual = Bio::SeqIO->new(
 
116
    -file    => ">".test_output_file(),
 
117
    -format  => 'qual',
 
118
    -verbose => $verbose,
 
119
);
 
120
ok $out_qual->write_seq(-source => $pq);
 
121
 
 
122
ok my $swq545 = Bio::Seq::Quality->new (
 
123
    -seq  => "ATA",
 
124
    -qual => $pq
 
125
);
 
126
ok $out_qual->write_seq(-source => $swq545);
 
127
 
 
128
ok $in_qual = Bio::SeqIO->new(
 
129
    -file    => test_input_file('qualfile.qual'),
 
130
    -format  => 'qual',
 
131
    -verbose => $verbose,
 
132
);
 
133
 
 
134
ok my $out_qual2 = Bio::SeqIO->new(
 
135
    -file    => ">".test_output_file(),
 
136
    -format  => 'qual',
 
137
    -verbose => $verbose,
 
138
);
142
139
 
143
140
while ( my $batch_qual = $in_qual->next_seq() ) {
144
 
        $out_qual2->write_seq(-source   =>      $batch_qual);
145
 
}
146
 
 
147
 
sub display {
148
 
    if($DEBUG ) {
149
 
        my @quals;
150
 
        print("I saw these in qualfile.qual:\n") ;
151
 
        while ( my $qual = $in_qual->next_seq() ) {
152
 
            # ::dumpValue($qual);
153
 
            print($qual->display_id()."\n");
154
 
            @quals = @{$qual->qual()};
155
 
            print("(".scalar(@quals).") quality values.\n");
156
 
        }
157
 
    }
158
 
}
159
 
 
160
 
# dumpValue($qualobj);
161
 
 
162
 
sub compare_arrays {
163
 
        my ($a1,$a2) = @_;
164
 
        return 1 if (scalar(@{$a1}) != scalar(@{$a2}));
165
 
        my ($v1,$v2,$diff,$curr);
166
 
        for ($curr=0;$curr<scalar(@{$a1});$curr++){
167
 
                return 1 if ($a1->[$curr] ne $a2->[$curr]);
168
 
        }
169
 
        return 0;
170
 
}
 
141
    ok $out_qual2->write_seq(-source => $batch_qual);
 
142
}
 
143