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 my $TMP, '>', $filename or die "Could not write file '$filename': $!\n";
 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 }