← Back to branch summary

~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to t/psm.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/psm.t
1
 
# -*-Perl-*-
2
 
#Some simple tests for meme and transfac parsers
3
 
 
4
 
use strict;
5
 
 
6
 
BEGIN {
7
 
    # to handle systems with no installed Test module
8
 
    # we include the t dir (where a copy of Test.pm is located)
9
 
    # as a fallback
10
 
    eval { require Test; };
11
 
    if( $@ ) {
12
 
        use lib 't';
13
 
    }
14
 
    use Test;
15
 
 
16
 
    plan tests => 63;
17
 
}
18
 
 
19
 
use Bio::Matrix::PSM::IO;
20
 
 
21
 
 
22
 
my $mmt= "chr04q        170164  170208  strong  -       0       Motif 3 occurrance in chr04q
23
 
chr04q  215755  215799  strong  +       0       Motif 4 occurrance in chr04q
24
 
chr04q  532530  532574  strong  +       2       Motif 2 occurrance in chr04q
25
 
chr04q  539492  539536  strong  -       1       Motif 1 occurrance in chr04q
26
 
chr04q  586113  586157  strong  +       2       Motif 2 occurrance in chr04q
27
 
chr04q  698245  698289  strong  -       0       Motif 4 occurrance in chr04q
28
 
chr04q  804412  804456  strong  -       0       Motif 3 occurrance in chr04q
29
 
chr04q  858870  858914  strong  -       2       Motif 3 occurrance in chr04q
30
 
chr04q  861561  861605  strong  -       2       Motif 3 occurrance in chr04q
31
 
chr04q  916898  916942  strong  -       1       Motif 1 occurrance in chr04q
32
 
chr04q  1146916 1146960 strong  -       0       Motif 1 occurrance in chr04q
33
 
chr04q  1315772 1315816 strong  +       1       Motif 1 occurrance in chr04q
34
 
chr04q  1636119 1636163 strong  +       2       Motif 3 occurrance in chr04q
35
 
chr04q  1636200 1636244 strong  +       2       Motif 1 occurrance in chr04q
36
 
chr04q  1636437 1636481 strong  +       2       Motif 4 occurrance in chr04q
37
 
chr04q  1637361 1637405 strong  +       2       Motif 2 occurrance in chr04q
38
 
chr04q  1652447 1652491 strong  +       1       Motif 4 occurrance in chr04q";
39
 
my @mmt=split(/\n/,$mmt);
40
 
 
41
 
ok(1);
42
 
 
43
 
#Let's try meme here
44
 
my $psmIO =  new Bio::Matrix::PSM::IO(-format=>'meme', 
45
 
             -file=>Bio::Root::IO->catfile(qw(t data meme.dat)));
46
 
ok $psmIO;
47
 
 
48
 
my @inputfile=grep(/datafile/i,$psmIO->unstructured);
49
 
ok @inputfile;
50
 
 
51
 
my $release=$psmIO->release;
52
 
ok $release;
53
 
 
54
 
my @ids=$psmIO->hid;
55
 
ok @ids,4;
56
 
 
57
 
my %weights=$psmIO->weight;
58
 
ok %weights;
59
 
 
60
 
my %seq = $psmIO->seq;
61
 
ok %seq,'0';#Meme doesn't have seq
62
 
 
63
 
ok $psmIO->version,'3.0';
64
 
 
65
 
my $psm = $psmIO->next_psm;
66
 
ok $psm;
67
 
 
68
 
#Lets try to compress and uncompress the log odds and the frequencies, see if there is no
69
 
#considerable loss of data.
70
 
my $fA=$psm->get_compressed_freq('A');
71
 
my @check=Bio::Matrix::PSM::SiteMatrix::_uncompress_string($fA,1,1);
72
 
my @A=$psm->get_array('A');
73
 
my ($var,$max) = (0,0);
74
 
for (my $i = 0; $i<@check;$i++) {
75
 
  my $diff=abs(abs($check[$i])-abs($A[$i]));
76
 
  $var += $diff;
77
 
  $max=$diff if ($diff>$max);
78
 
}
79
 
my $avg=$var/@check;
80
 
ok $avg<0.01; #Loss of data under 1 percent
81
 
#print $avg,"\n";
82
 
ok $psm->sequence_match_weight('CAGAAAAATAAAATGGCCACCACCC'),2015;
83
 
 
84
 
my $lA=$psm->get_compressed_logs('A');
85
 
@check=Bio::Matrix::PSM::SiteMatrix::_uncompress_string($lA,1000,2);
86
 
@A=$psm->get_logs_array('A');
87
 
($var,$max) = (0,0);
88
 
for (my $i = 0;$i<@check;$i++) {
89
 
  my $diff=abs(abs($check[$i])-abs($A[$i]));
90
 
  $var += $diff;
91
 
  $max=$diff if ($diff>$max);
92
 
}
93
 
$avg=$var/@check;
94
 
ok $avg<10; #Loss of data under 1 percent
95
 
 
96
 
my $matrix=$psm->matrix;
97
 
ok $matrix;
98
 
my $psm2=$psm;
99
 
$psm2->matrix($matrix);
100
 
ok $psm,$psm2;
101
 
 
102
 
my %psm_header=$psm->header;
103
 
ok $psm_header{IC},38.1;
104
 
ok $psm_header{sites},4;
105
 
ok $psm_header{width},25;
106
 
ok $psm_header{e_val},'1.2e-002';
107
 
 
108
 
 
109
 
#Quick check if returned object works
110
 
my $IUPAC=$psm->IUPAC;
111
 
ok $IUPAC,'CMKWMAAAKWVAWTYCMCASCHCCM';
112
 
ok $IUPAC,$psm2->IUPAC;
113
 
ok $IUPAC,$matrix->IUPAC;
114
 
 
115
 
my $instances=$psm->instances;
116
 
ok $instances;
117
 
 
118
 
foreach my $instance (@{$instances}) {
119
 
  my $id=$instance->primary_id;
120
 
  ok $instance->strand,1;
121
 
  last if (ok $id);
122
 
}
123
 
 
124
 
ok $psm->header('e_val');
125
 
#Meme parser should be OK if tests passed
126
 
 
127
 
 
128
 
#Now we are going to try transfac
129
 
 
130
 
$psmIO =  new Bio::Matrix::PSM::IO(-format=>'transfac', 
131
 
          -file=> Bio::Root::IO->catfile(qw(t data transfac.dat)));
132
 
ok $psmIO;
133
 
 
134
 
my $version=$psmIO->version;
135
 
ok !$version;
136
 
 
137
 
ok $psmIO->release, '6.4--2002-12-02';
138
 
 
139
 
$psm     = $psmIO->next_psm;
140
 
ok $psm;
141
 
 
142
 
# Lets try to compress and uncompress the the frequencies, see if
143
 
# there is no considerable loss of data.
144
 
$fA=$psm->get_compressed_freq('A');
145
 
@check=Bio::Matrix::PSM::SiteMatrix::_uncompress_string($fA,1,1);
146
 
@A=$psm->get_array('A');
147
 
($var,$max) = (0,0);
148
 
for (my $i = 0; $i<@check;$i++) {
149
 
  my $diff=abs(abs($check[$i])-abs($A[$i]));
150
 
  $var += $diff;
151
 
  $max=$diff if ($diff>$max);
152
 
}
153
 
$avg=$var/@check;
154
 
ok $avg<0.01; #Loss of data under 1 percent
155
 
 
156
 
%weights = $psmIO->weight;
157
 
ok !$weights{''};
158
 
 
159
 
%seq     = $psmIO->seq;
160
 
ok scalar keys %seq, 0;
161
 
 
162
 
#Quick check if returned object works
163
 
$IUPAC   = $psm->IUPAC;
164
 
ok $IUPAC,'VVDCAKSTGBYD';
165
 
 
166
 
#Now we are going to try mast
167
 
$psmIO =  new Bio::Matrix::PSM::IO(-format=>'mast', 
168
 
          -file=>Bio::Root::IO->catfile(qw(t data mast.dat)));
169
 
ok $psmIO;
170
 
 
171
 
@inputfile = grep(/datafile/i,$psmIO->unstructured);
172
 
ok !@inputfile;
173
 
 
174
 
ok( $psmIO->release, '2002/04/02 0:11:59');
175
 
 
176
 
@ids     = $psmIO->hid;
177
 
ok @ids,4;
178
 
 
179
 
%weights = $psmIO->weight;
180
 
ok !%weights; #Mast doesn't have weights
181
 
 
182
 
ok %seq    = $psmIO->seq;
183
 
 
184
 
foreach my $id ($psmIO->hid) {
185
 
    ok $seq{$id};
186
 
}
187
 
ok $psm=$psmIO->next_psm;
188
 
 
189
 
my %instances=$psmIO->instances;
190
 
ok %instances;
191
 
 
192
 
ok $psmIO->version, '3.0';
193
 
 
194
 
my $mmastIO=new Bio::Matrix::PSM::IO(-format=>'mast',-file=>Bio::Root::IO->catfile(qw(t data mixedmast.dat)));
195
 
 
196
 
$psm = $mmastIO->next_psm; 
197
 
my $lastinstances = $psm->instances();
198
 
my $i=0;
199
 
foreach my $hit (@$lastinstances) {
200
 
    $hit -> end ( $hit-> start () + length ($hit->seq) - 1 ) ; # fix an old bug in InstanceSite.pm
201
 
    my $d=join("\t",$hit->{accession_number},$hit -> start () , $hit-> end (),$hit -> score (),
202
 
    $hit -> strand == 1 ? '+' : '-' , $hit -> frame,  $hit -> desc ( ));
203
 
    ok $d,$mmt[$i];
204
 
    $i++;
205
 
    last if ($hit -> start == 1652447);
206
 
}
207
 
 
208