[Bioperl-guts-l] [16259] bioperl-live/trunk: Added Bio::Location:: SplitLocationI support to subtract().

[Jay Hannah]

Revision: 16259
Author:   jhannah
Date:     2009-10-18 18:25:59 -0400 (Sun, 18 Oct 2009)

Log Message:
-----------
Added Bio::Location::SplitLocationI support to subtract().

Modified Paths:
--------------
    bioperl-live/trunk/Bio/RangeI.pm
    bioperl-live/trunk/t/SeqFeature/RangeI.t

Modified: bioperl-live/trunk/Bio/RangeI.pm
===================================================================
--- bioperl-live/trunk/Bio/RangeI.pm	2009-10-14 03:44:41 UTC (rev 16258)
+++ bioperl-live/trunk/Bio/RangeI.pm	2009-10-18 22:25:59 UTC (rev 16259)
@@ -623,34 +623,52 @@
     $range->throw("Input a Bio::RangeI object") unless
 $range->isa('Bio::RangeI');
 
-    if (!$self->overlaps($range)) {
-        return;
+    my @sub_locations; 
+    if ($self->location->isa('Bio::Location::SplitLocationI') ) {
+       @sub_locations = $self->location->sub_Location;
+    } else {
+       @sub_locations = $self;
     }
 
-    ##Subtracts everything
-    if ($range->contains($self)) {
-        return;   
+    my @outranges;
+    foreach my $sl (@sub_locations) {
+       if (!$sl->overlaps($range)) {
+          push(@outranges, 
+             $self->new('-start' =>$sl->start,
+                        '-end'   =>$sl->end, 
+                        '-strand'=>$sl->strand,
+          ));
+          next;
+       }
+   
+       ##Subtracts everything
+       if ($range->contains($sl)) {
+          next;   
+       }
+   
+       my ($start, $end, $strand) = $sl->intersection($range, $so);
+       ##Subtract intersection from $self range
+   
+       if ($sl->start < $start) {
+          push(@outranges, 
+             $self->new('-start' =>$sl->start,
+                        '-end'   =>$start - 1,
+                        '-strand'=>$sl->strand,
+          ));   
+       }
+       if ($sl->end > $end) {
+          push(@outranges, 
+             $self->new('-start' =>$end + 1,
+                        '-end'   =>$sl->end,
+                        '-strand'=>$sl->strand,
+          ));   
+       }
     }
 
-    my ($start, $end, $strand) = $self->intersection($range, $so);
-    ##Subtract intersection from $self range
-
-    my @outranges = ();
-    if ($self->start < $start) {
-        push(@outranges, 
-		 $self->new('-start'=>$self->start,
-			    '-end'=>$start - 1,
-			    '-strand'=>$self->strand,
-			   ));   
+    if (@outranges) {
+       return \@outranges;
     }
-    if ($self->end > $end) {
-        push(@outranges, 
-		 $self->new('-start'=>$end + 1,
-			    '-end'=>$self->end,
-			    '-strand'=>$self->strand,
-			   ));   
-    }
-    return \@outranges;
+    return;
 }
 
 1;

Modified: bioperl-live/trunk/t/SeqFeature/RangeI.t
===================================================================
--- bioperl-live/trunk/t/SeqFeature/RangeI.t	2009-10-14 03:44:41 UTC (rev 16258)
+++ bioperl-live/trunk/t/SeqFeature/RangeI.t	2009-10-18 22:25:59 UTC (rev 16259)
@@ -7,7 +7,7 @@
     use lib '.';
     use Bio::Root::Test;
     
-    test_begin(-tests => 38);
+    test_begin(-tests => 51);
 	
     use_ok('Bio::SeqFeature::Generic');
 }
@@ -50,6 +50,21 @@
     ok($range->end == 99 || $range->end == 1000);
 }
 
+
+$feature1 =  Bio::SeqFeature::Generic->new( -start => 1, -end =>
+1000, -strand => 1);
+my $feature2 =  Bio::SeqFeature::Generic->new( -start => 100, -end =>
+900, -strand => -1);
+
+my $subtracted = $feature1->subtract($feature2);
+ok(defined($subtracted));
+is(scalar(@$subtracted), 2);
+foreach my $range (@$subtracted) {
+    ok($range->start == 1 || $range->start == 901);
+    ok($range->end == 99 || $range->end == 1000);
+}
+
+
 $subtracted = $feature2->subtract($feature1);
 ok(!defined($subtracted));
 $subtracted = $feature1->subtract($feature2, 'weak');
@@ -65,3 +80,29 @@
 my $subtracted_i = @$subtracted[0];
 is($subtracted_i->start, 1);
 is($subtracted_i->end, 499);
+
+
+# ---------------
+# Added Bio::Location::SplitLocationI support to subtract().  --jhannah 20091018
+$feature1 =  Bio::SeqFeature::Generic->new();
+$feature2 =  Bio::SeqFeature::Generic->new();
+my $loc = Bio::Location::Split->new();
+$loc->add_sub_Location(Bio::Location::Simple->new(-start=>100, -end=>200, -strand=>1));
+$loc->add_sub_Location(Bio::Location::Simple->new(-start=>300, -end=>400, -strand=>1));
+$loc->add_sub_Location(Bio::Location::Simple->new(-start=>500, -end=>600, -strand=>1));
+$feature1->location($loc);
+$loc = Bio::Location::Split->new();
+$loc->add_sub_Location(Bio::Location::Simple->new(-start=>350, -end=>400, -strand=>1));
+$loc->add_sub_Location(Bio::Location::Simple->new(-start=>500, -end=>510, -strand=>1));
+$feature2->location($loc);
+my $subtracted = $feature1->subtract($feature2);
+is(@$subtracted, 3,                              "subtract() of split features");
+is($subtracted->[0]->start, 100,                 "   0 start");
+is($subtracted->[0]->end,   200,                 "   0 end");
+is($subtracted->[1]->start, 300,                 "   1 start");
+is($subtracted->[1]->end,   349,                 "   1 end");
+is($subtracted->[2]->start, 511,                 "   2 start");
+is($subtracted->[2]->end,   600,                 "   2 end");
+# ---------------
+
+