← Back to branch summary

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

« back to all changes in this revision

Viewing changes to t/SeqFeature/Collection.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/SeqFeature/Collection.t
 
1
# -*-Perl-*- Test Harness script for Bioperl
 
2
# $Id$
 
3
 
 
4
use strict;
 
5
 
 
6
BEGIN { 
 
7
    use lib '.';
 
8
    use Bio::Root::Test;
 
9
    
 
10
    test_begin(
 
11
        -tests => 24,
 
12
        -requires_module => 'DB_File'
 
13
    );
 
14
 
 
15
    use_ok('Bio::SeqFeature::Collection');
 
16
    use_ok('Bio::Location::Simple');
 
17
    use_ok('Bio::Tools::GFF');
 
18
    use_ok('Bio::SeqIO');
 
19
}
 
20
 
 
21
my $verbose = test_debug();
 
22
 
 
23
#First of all we need to create an flat db
 
24
my $simple = Bio::SeqIO->new(
 
25
    -format => 'genbank',
 
26
    -file   =>  test_input_file('AB077698.gb')
 
27
);
 
28
 
 
29
my @features;
 
30
my $seq = $simple->next_seq();
 
31
@features = $seq->top_SeqFeatures();
 
32
is(scalar @features, 11);
 
33
 
 
34
ok my $col = Bio::SeqFeature::Collection->new(-verbose => $verbose);
 
35
 
 
36
is($col->add_features( \@features), 11);
 
37
my @feat = $col->features_in_range(
 
38
    -range => (
 
39
        Bio::Location::Simple->new(
 
40
            -start  => 100,
 
41
            -end    => 300,
 
42
            -strand => 1,
 
43
        )
 
44
    ),
 
45
    -contain => 0,
 
46
);
 
47
is(scalar @feat, 5);
 
48
if( $verbose ) {    
 
49
    for my $f ( @feat ) {
 
50
        print "location: ", $f->location->to_FTstring(), "\n";
 
51
    }
 
52
}
 
53
 
 
54
is(scalar $col->features_in_range(
 
55
    -range => (
 
56
        Bio::Location::Simple->new(
 
57
            -start => 100,
 
58
            -end   => 300,
 
59
            -strand => -1,
 
60
        )
 
61
    ),
 
62
    -strandmatch => 'ignore',
 
63
    -contain => 1,
 
64
), 2);
 
65
 
 
66
@feat = $col->features_in_range(
 
67
    -start => 79,
 
68
    -end   => 1145,
 
69
    -strand => 1,
 
70
    -strandmatch => 'strong',
 
71
    -contain => 1
 
72
);
 
73
is(scalar @feat, 5);
 
74
if( $verbose ) {    
 
75
    for my $f ( sort { $a->start <=> $b->start} @feat ) {
 
76
        print $f->primary_tag, " ", $f->location->to_FTstring(), "\n";
 
77
    }
 
78
}
 
79
 
 
80
is($feat[0]->primary_tag, 'CDS');
 
81
ok($feat[0]->has_tag('gene'));
 
82
 
 
83
$verbose = 0;
 
84
# specify input via -fh or -file
 
85
my $gffio = Bio::Tools::GFF->new(
 
86
    -file => test_input_file('myco_sites.gff'), 
 
87
    -gff_version => 2,
 
88
);
 
89
@features = ();
 
90
# loop over the input stream
 
91
while(my $feature = $gffio->next_feature()) {
 
92
    # do something with feature
 
93
    push @features, $feature;
 
94
}
 
95
$gffio->close();
 
96
 
 
97
is(scalar @features, 412);
 
98
$col = Bio::SeqFeature::Collection->new(
 
99
    -verbose => $verbose,
 
100
    -usefile => 1,
 
101
);
 
102
 
 
103
ok($col);
 
104
 
 
105
is($col->add_features( \@features), 412);
 
106
 
 
107
my $r = Bio::Location::Simple->new(
 
108
    -start => 67700,
 
109
    -end   => 150000,
 
110
    -strand => 1,
 
111
);
 
112
 
 
113
@feat = $col->features_in_range(
 
114
    -range => $r,
 
115
    -strandmatch => 'ignore',
 
116
    -contain => 0,
 
117
);
 
118
 
 
119
is(scalar @feat, 56);
 
120
is($col->feature_count, 412);
 
121
my $count = $col->feature_count;
 
122
$col->remove_features( [$features[58], $features[60]]);
 
123
 
 
124
is( $col->feature_count, 410);
 
125
@feat = $col->features_in_range(
 
126
    -range => $r,
 
127
    -strandmatch => 'ignore',
 
128
    -contain => 0,
 
129
);
 
130
is( scalar @feat, 54);
 
131
# add the removed features back in in order to get the collection back to size 
 
132
 
 
133
$col->add_features([$features[58], $features[60]]);
 
134
 
 
135
# let's randomize so we aren't removing and adding in the same order
 
136
# and hopefully randomly deal with a bin's expiration
 
137
fy_shuffle(\@features);
 
138
 
 
139
for my $f ( @features ) {
 
140
    $count--, next unless defined $f;
 
141
    $col->remove_features([$f]);
 
142
#    ok( $col->feature_count, --$count);
 
143
}
 
144
is($col->feature_count, 0);
 
145
 
 
146
# explicitly destroy old instances above (should clear out any open filehandles
 
147
# w/o -keep flag set)
 
148
undef $col; 
 
149
 
 
150
my $filename = test_output_file();
 
151
my $newcollection = Bio::SeqFeature::Collection->new(
 
152
    -verbose => $verbose,
 
153
    -keep    => 1,
 
154
    -file    => $filename,
 
155
);
 
156
$newcollection->add_features(\@feat);
 
157
is($newcollection->feature_count, 54);
 
158
undef $newcollection;
 
159
ok(-s $filename);
 
160
$newcollection = Bio::SeqFeature::Collection->new(
 
161
    -verbose => $verbose,
 
162
    -file    => $filename,
 
163
);
 
164
is($newcollection->feature_count, 54);
 
165
undef $newcollection;
 
166
ok( ! -e $filename);
 
167
# without -keep => 1, $filename was deleted as expected.
 
168
# to stop Bio::Root::Test complaining that the temp file was already deleted,
 
169
# we'll just create it again
 
170
open(TMP, ">", $filename);
 
171
print TMP "temp\n";
 
172
close(TMP);
 
173
 
 
174
if( $verbose ) {
 
175
    my @fts =  sort { $a->start <=> $b->start}  
 
176
    grep { $r->overlaps($_,'ignore') } @features;
 
177
    
 
178
    if( $verbose ) {
 
179
        for my $f ( @fts ) {
 
180
            print $f->primary_tag, "    ", $f->location->to_FTstring(), "\n";
 
181
        }
 
182
        print "\n";
 
183
    }
 
184
 
 
185
    my %G = map { ($_,1) } @feat; 
 
186
    my $c = 0;
 
187
    for my $A ( @fts ) {
 
188
        if( ! $G{$A} ) {
 
189
            print "missing ", $A->primary_tag, " ", $A->location->to_FTstring(), "\n";
 
190
        } else { 
 
191
            $c++;
 
192
        }
 
193
    }
 
194
    print "Number of features correctly retrieved $c\n";
 
195
    for my $f ( sort { $a->start <=> $b->start} @feat ) {
 
196
        print $f->primary_tag, "    ", $f->location->to_FTstring(), "\n";
 
197
    }
 
198
}
 
199
 
 
200
sub fy_shuffle { 
 
201
    my $array = shift;
 
202
    my $i;
 
203
    for( $i = @$array; $i--; ) { 
 
204
        my $j = int rand($i+1);
 
205
        next if $i==$j;
 
206
        @$array[$i,$j] = @$array[$j,$i];
 
207
    }
 
208
}