t/SeqFeature/Collection.t

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