t/SeqFeature/Location.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 => 109);
  11
  12     use_ok('Bio::Location::Simple');
  13     use_ok('Bio::Location::Split');
  14     use_ok('Bio::Location::Fuzzy');
  15     use_ok('Bio::SeqFeature::Generic');
  16     use_ok('Bio::SeqFeature::SimilarityPair');
  17     use_ok('Bio::SeqFeature::FeaturePair');
  18     use_ok('Bio::SeqFeature::Lite');
  19 }
  20
  21 my $simple = Bio::Location::Simple->new('-start' => 10, '-end' => 20,
  22                                        '-strand' => 1, -seq_id => 'my1');
  23 isa_ok($simple, 'Bio::LocationI');
  24 isa_ok($simple, 'Bio::RangeI');
  25
  26 is($simple->start, 10, 'Bio::Location::Simple tests');
  27 is($simple->end, 20);
  28 is($simple->seq_id, 'my1');
  29
  30 my ($loc) = $simple->each_Location();
  31 ok($loc);
  32 is("$loc", "$simple");
  33
  34 my $generic = Bio::SeqFeature::Generic->new('-start' => 5, '-end' => 30,
  35                                            '-strand' => 1);
  36
  37 isa_ok($generic,'Bio::SeqFeatureI', 'Bio::SeqFeature::Generic' );
  38 isa_ok($generic,'Bio::RangeI');
  39 is($generic->start, 5);
  40 is($generic->end, 30);
  41
  42 my $lite_pos  = Bio::SeqFeature::Lite->new(-start => 1000, -stop => 2000, -strand => '+');
  43 my $lite_neg  = Bio::SeqFeature::Lite->new(-start => 1000, -end  => 2000, -strand => '-');
  44 my $lite_none = Bio::SeqFeature::Lite->new(-start => 1000, -stop => 2000, -strand => '.');
  45 is($lite_pos->strand,  1);
  46 is($lite_neg->strand, -1);
  47 is($lite_neg->end,  2000);
  48 is($lite_neg->stop, 2000);
  49 is($lite_none->strand, 0);
  50
  51 my $similarity = Bio::SeqFeature::SimilarityPair->new();
  52
  53 my $feat1 = Bio::SeqFeature::Generic->new('-start' => 30, '-end' => 43,
  54                                          '-strand' => -1);
  55 my $feat2 = Bio::SeqFeature::Generic->new('-start' => 80, '-end' => 90,
  56                                          '-strand' => -1);
  57
  58 my $featpair = Bio::SeqFeature::FeaturePair->new('-feature1' => $feat1,
  59                                                 '-feature2' => $feat2 );
  60
  61 my $feat3 = Bio::SeqFeature::Generic->new('-start' => 35, '-end' => 50,
  62                                          '-strand' => -1);
  63
  64 is($featpair->start, 30,'Bio::SeqFeature::FeaturePair tests');
  65 is($featpair->end,  43);
  66
  67 is($featpair->length, 14);
  68
  69 ok($featpair->overlaps($feat3));
  70 ok($generic->overlaps($simple), 'Bio::SeqFeature::Generic tests');
  71 ok($generic->contains($simple));
  72
  73 # fuzzy location tests
  74 my $fuzzy = Bio::Location::Fuzzy->new('-start'  =>'<10',
  75                                      '-end'    => 20,
  76                                      -strand   =>1,
  77                                      -seq_id   =>'my2');
  78
  79 is($fuzzy->strand, 1, 'Bio::Location::Fuzzy tests');
  80 is($fuzzy->start, 10);
  81 is($fuzzy->end,20);
  82 ok(!defined $fuzzy->min_start);
  83 is($fuzzy->max_start, 10);
  84 is($fuzzy->min_end, 20);
  85 is($fuzzy->max_end, 20);
  86 is($fuzzy->location_type, 'EXACT');
  87 is($fuzzy->start_pos_type, 'BEFORE');
  88 is($fuzzy->end_pos_type, 'EXACT');
  89 is($fuzzy->seq_id, 'my2');
  90 is($fuzzy->seq_id('my3'), 'my3');
  91
  92 ($loc) = $fuzzy->each_Location();
  93 ok($loc);
  94 is("$loc", "$fuzzy");
  95
  96 # split location tests
  97 my $splitlocation = Bio::Location::Split->new();
  98 my $f = Bio::Location::Simple->new(-start  => 13,
  99                                   -end    => 30,
 100                                   -strand => 1);
 101 $splitlocation->add_sub_Location($f);
 102 is($f->start, 13, 'Bio::Location::Split tests');
 103 is($f->min_start, 13);
 104 is($f->max_start,13);
 105
 106
 107 $f = Bio::Location::Simple->new(-start  =>30,
 108                                -end    =>90,
 109                                -strand =>1);
 110 $splitlocation->add_sub_Location($f);
 111
 112 $f = Bio::Location::Simple->new(-start  =>11,
 113                                -end    =>22,
 114                                -strand =>1);
 115 $splitlocation->add_sub_Location($f);
 116
 117 $f = Bio::Location::Simple->new(-start  =>19,
 118                                -end    =>20,
 119                                -strand =>1);
 120
 121 $splitlocation->add_sub_Location($f);
 122
 123 $f = Bio::Location::Fuzzy->new(-start  =>"<50",
 124                               -end    =>61,
 125                               -strand =>1);
 126 is($f->start, 50);
 127 ok(! defined $f->min_start);
 128 is($f->max_start, 50);
 129
 130 is(scalar($splitlocation->each_Location()), 4);
 131
 132 $splitlocation->add_sub_Location($f);
 133
 134 # For unsorted split locations like this:
 135 # ('join(13..30,30..90,11..22,19..20,<50..61)'),
 136 # BioPerl will assume Start and End belongs to the
 137 # first and last segments respectively, because sorting
 138 # would break real cases like circular cut by origin features
 139 is($splitlocation->end, 61);
 140 is($splitlocation->start, 13);
 141 is($splitlocation->sub_Location(),5);
 142 # Minimum Start and Maximum End in unsorted sublocations can be
 143 # achieved by asking explicitly sub_Location to sort the segments
 144 my @increase_sort_sublocs = $splitlocation->sub_Location(1);  # Forward sort by Start
 145 my @decrease_sort_sublocs = $splitlocation->sub_Location(-1); # Reverse sort by End
 146 is($increase_sort_sublocs[0]->min_start, 11);
 147 is($decrease_sort_sublocs[0]->max_end,   90);
 148
 149 is($fuzzy->to_FTstring(), '<10..20');
 150 $fuzzy->strand(-1);
 151 is($fuzzy->to_FTstring(), 'complement(<10..20)');
 152 is($simple->to_FTstring(), '10..20');
 153 $simple->strand(-1);
 154 is($simple->to_FTstring(), 'complement(10..20)');
 155 is( $splitlocation->to_FTstring(),
 156     'join(13..30,30..90,11..22,19..20,<50..61)');
 157
 158 # test for bug #1074
 159 $f = Bio::Location::Simple->new(-start  => 5,
 160                                -end    => 12,
 161                                -strand => -1);
 162 $splitlocation->add_sub_Location($f);
 163 is( $splitlocation->to_FTstring(),
 164     'join(13..30,30..90,11..22,19..20,<50..61,complement(5..12))',
 165         'Bugfix 1074');
 166 $splitlocation->strand(-1);
 167 is( $splitlocation->to_FTstring(),
 168     'complement(join(13..30,30..90,11..22,19..20,<50..61,5..12))');
 169
 170 $f = Bio::Location::Fuzzy->new(-start => '45.60',
 171                               -end   => '75^80');
 172
 173 is($f->to_FTstring(), '(45.60)..(75^80)');
 174 $f->start('20>');
 175 is($f->to_FTstring(), '>20..(75^80)');
 176
 177 # test that even when end < start that length is always positive
 178
 179 $f = Bio::Location::Simple->new(-verbose => -1,
 180                                -start   => 100,
 181                                -end     => 20,
 182                                -strand  => 1);
 183
 184 is($f->length, 81, 'Positive length');
 185 is($f->strand,-1);
 186
 187 # test that can call seq_id() on a split location;
 188 $splitlocation = Bio::Location::Split->new(-seq_id => 'mysplit1');
 189 is($splitlocation->seq_id,'mysplit1', 'seq_id() on Bio::Location::Split');
 190 is($splitlocation->seq_id('mysplit2'),'mysplit2');
 191
 192
 193 # Test Bio::Location::Exact
 194
 195 ok(my $exact = Bio::Location::Simple->new(-start    => 10,
 196                                          -end      => 20,
 197                                          -strand   => 1,
 198                                          -seq_id   => 'my1'));
 199 isa_ok($exact, 'Bio::LocationI');
 200 isa_ok($exact, 'Bio::RangeI');
 201
 202 is( $exact->start, 10, 'Bio::Location::Simple EXACT');
 203 is( $exact->end, 20);
 204 is( $exact->seq_id, 'my1');
 205 is( $exact->length, 11);
 206 is( $exact->location_type, 'EXACT');
 207
 208 ok ($exact = Bio::Location::Simple->new(-start         => 10,
 209                                       -end           => 11,
 210                                       -location_type => 'IN-BETWEEN',
 211                                       -strand        => 1,
 212                                       -seq_id        => 'my2'));
 213
 214 is($exact->start, 10, 'Bio::Location::Simple IN-BETWEEN');
 215 is($exact->end, 11);
 216 is($exact->seq_id, 'my2');
 217 is($exact->length, 0);
 218 is($exact->location_type, 'IN-BETWEEN');
 219
 220 eval {
 221     $exact = Bio::Location::Simple->new(-start         => 10,
 222                                        -end           => 12,
 223                                        -location_type => 'IN-BETWEEN');
 224 };
 225 ok( $@, 'Testing error handling' );
 226
 227 # testing error when assigning 10^11 simple location into fuzzy
 228 eval {
 229     ok $fuzzy = Bio::Location::Fuzzy->new(-start         => 10,
 230                                          -end           => 11,
 231                                          -location_type => '^',
 232                                          -strand        => 1,
 233                                          -seq_id        => 'my2');
 234 };
 235 ok( $@ );
 236
 237 $fuzzy = Bio::Location::Fuzzy->new(-location_type => '^',
 238                                   -strand        => 1,
 239                                   -seq_id        => 'my2');
 240
 241 $fuzzy->start(10);
 242 eval { $fuzzy->end(11) };
 243 ok($@);
 244
 245 $fuzzy = Bio::Location::Fuzzy->new(-location_type => '^',
 246                                   -strand        => 1,
 247                                   -seq_id        =>'my2');
 248
 249 $fuzzy->end(11);
 250 eval {
 251     $fuzzy->start(10);
 252 };
 253 ok($@);
 254
 255 # testing coodinate policy modules
 256
 257 use_ok('Bio::Location::WidestCoordPolicy');
 258 use_ok('Bio::Location::NarrowestCoordPolicy');
 259 use_ok('Bio::Location::AvWithinCoordPolicy');
 260
 261 $f = Bio::Location::Fuzzy->new(-start => '40.60',
 262                               -end   => '80.100');
 263 is $f->start, 40, 'Default coodinate policy';
 264 is $f->end, 100;
 265 is $f->length, 61;
 266 is $f->to_FTstring, '(40.60)..(80.100)';
 267 isa_ok($f->coordinate_policy, 'Bio::Location::WidestCoordPolicy');
 268
 269 # this gives an odd location string; is it legal?
 270 $f->coordinate_policy(Bio::Location::NarrowestCoordPolicy->new());
 271 is $f->start, 60, 'Narrowest coodinate policy';
 272 is $f->end, 80;
 273 is $f->length, 21;
 274 is $f->to_FTstring, '(60.60)..(80.80)';
 275 isa_ok($f->coordinate_policy, 'Bio::Location::NarrowestCoordPolicy');
 276
 277 # this gives an odd location string
 278 $f->coordinate_policy(Bio::Location::AvWithinCoordPolicy->new());
 279 is $f->start, 50, 'Average coodinate policy';
 280 is $f->end, 90;
 281 is $f->length, 41;
 282 is $f->to_FTstring, '(50.60)..(80.90)';
 283 isa_ok($f->coordinate_policy, 'Bio::Location::AvWithinCoordPolicy');
 284
 285 # to complete the circle
 286 $f->coordinate_policy(Bio::Location::WidestCoordPolicy->new());
 287 is $f->start, 40, 'Widest coodinate policy';
 288 is $f->end, 100;
 289 is $f->length, 61;
 290 is $f->to_FTstring, '(40.60)..(80.100)';
 291 isa_ok($f->coordinate_policy, 'Bio::Location::WidestCoordPolicy');