← Back to branch summary

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

« back to all changes in this revision

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