t/SeqFeatCollection.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib 't/lib';
   8     use BioperlTest;
   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 my $filename = test_output_file();
 122 my $newcollection = Bio::SeqFeature::Collection->new(-verbose => $verbose,
 123                                                     -keep    => 1,
 124                                                     -file    => $filename);
 125 $newcollection->add_features(\@feat);
 126 is($newcollection->feature_count, 54);
 127 undef $newcollection;
 128 ok(-s $filename);
 129 $newcollection = Bio::SeqFeature::Collection->new(-verbose => $verbose,
 130                                                  -file    => $filename);
 131 is($newcollection->feature_count, 54);
 132 undef $newcollection;
 133 ok( ! -e $filename);
 134 # without -keep => 1, $filename was deleted as expected.
 135 # to stop BioperlTest complaining that the temp file was already deleted,
 136 # we'll just create it again
 137 open(TMP, ">", $filename);
 138 print TMP "temp\n";
 139 close(TMP);
 140
 141 if( $verbose ) {
 142     my @fts =  sort { $a->start <=> $b->start}
 143     grep { $r->overlaps($_,'ignore') } @features;
 144
 145     if( $verbose ) {
 146         foreach my $f ( @fts ) {
 147             print $f->primary_tag, "    ", $f->location->to_FTstring(), "\n";
 148         }
 149         print "\n";
 150     }
 151
 152     my %G = map { ($_,1) } @feat;
 153     my $c = 0;
 154     foreach my $A ( @fts ) {
 155         if( ! $G{$A} ) {
 156             print "missing ", $A->primary_tag, " ", $A->location->to_FTstring(), "\n";
 157         } else {
 158             $c++;
 159         }
 160     }
 161     print "Number of features correctly retrieved $c\n";
 162     foreach my $f ( sort { $a->start <=> $b->start} @feat ) {
 163         print $f->primary_tag, "    ", $f->location->to_FTstring(), "\n";
 164     }
 165 }
 166
 167 sub fy_shuffle {
 168     my $array = shift;
 169     my $i;
 170     for( $i = @$array; $i--; ) {
 171         my $j = int rand($i+1);
 172         next if $i==$j;
 173         @$array[$i,$j] = @$array[$j,$i];
 174     }
 175 }