Roy's patches for Bio::SeqUtils, addresses bug #3339

bioperl · Apr 10, 2012 · 703fd75 · 703fd75
1 parent 89b2b65
commit 703fd75
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 8 deletions.
diff --git a/Bio/SeqUtils.pm b/Bio/SeqUtils.pm
@@ -1,4 +1,3 @@
-#
 # BioPerl module for Bio::SeqUtils
 #
 # Please direct questions and support issues to <bioperl-l@bioperl.org>
@@ -1271,8 +1270,10 @@ sub _coord_adjust {
         my @coords=($_->start, $_->end);
         my $strand=$_->strand;
 	my $type=$_->location_type;
-        map s/(-?\d+)/if ($add+$1<1) {'<1'} elsif (defined $length and $add+$1>$length) {">$length"} else {$add+$1}/ge, @coords;
-
+        map s/[<>]?(-?\d+)/if ($add+$1<1) {'<1'} elsif (defined $length and $add+$1>$length) {">$length"} else {$add+$1}/ge, @coords;
+        push @coords, $_->start_pos_type, $_->end_pos_type;
+        $coords[2]='BEFORE' if substr($coords[0],0,1) eq '<';
+        $coords[3]='AFTER' if substr($coords[1],0,1) eq '>';
         push @loc, $self->_location_objects_from_coordinate_list(
           [\@coords], $strand, $type
         );
@@ -1363,8 +1364,14 @@ sub _feature_revcom {
 	my $newstart=$self->_coord_revcom($_->end,
 					  $_->end_pos_type,
 					  $length);
+        my $newstart_type=$_->end_pos_type;
+        $newstart_type='BEFORE' if $_->end_pos_type eq 'AFTER';
+        $newstart_type='AFTER' if $_->end_pos_type eq 'BEFORE';
+        my $newend_type=$_->start_pos_type;
+        $newend_type='BEFORE' if $_->start_pos_type eq 'AFTER';
+        $newend_type='AFTER' if $_->start_pos_type eq 'BEFORE';
         push @loc, $self->_location_objects_from_coordinate_list(
-          [[$newstart, $newend]], $strand, $type
+          [[$newstart, $newend, $newstart_type, $newend_type]], $strand, $type
         );
     }
     my $newfeat=Bio::SeqFeature::Generic->new(-primary=>$feat->primary_tag);
@@ -1387,11 +1394,12 @@ sub _feature_revcom {
 sub _coord_revcom {
     my ($self, $coord, $type, $length)=@_;
     if ($type eq 'BETWEEN' or $type eq 'WITHIN') {
-	$coord=~s/(\d+)(.*)(\d+)/$length+1-$3.$2.$length+1-$1/ge;
+	$coord=~s/(\d+)(\D*)(\d+)/$length+1-$3.$2.$length+1-$1/ge;
     } else {
 	$coord=~s/(\d+)/$length+1-$1/ge;
-	$coord='>'.$coord if $type eq 'BEFORE';
-	$coord='<'.$coord if $type eq 'AFTER';
+        $coord=~tr/<>/></;
+	$coord='>'.$coord if $type eq 'BEFORE' and substr($coord,0,1) ne '>';
+	$coord='<'.$coord if $type eq 'AFTER' and substr($coord,0,1) ne '<';
     }
     return $coord;
 }

diff --git a/t/SeqTools/SeqUtils.t b/t/SeqTools/SeqUtils.t
@@ -8,7 +8,7 @@ BEGIN {
 #    use List::MoreUtils qw(uniq);
     use Bio::Root::Test;
 
-    test_begin(-tests => 125);
+    test_begin(-tests => 128);
 
     use_ok('Bio::PrimarySeq');
     use_ok('Bio::SeqUtils');
@@ -260,14 +260,22 @@ $ft3 = Bio::SeqFeature::Generic->new( -start => 5,
                                       -tag     => {note => ['note3a','note3b'], 
                                                    comment => 'c1'},
                                     );
+
+my $ft4 = Bio::SeqFeature::Generic->new(-primary => 'CDS');
+$ft4->location(Bio::Location::Fuzzy->new(-start=>'<1',
+					 -end=>5,
+					 -strand=>-1));
+
 $seq2->add_SeqFeature($ft2);
 $seq2->add_SeqFeature($ft3);
+$seq2->add_SeqFeature($ft4);
 
 my $trunc=Bio::SeqUtils->trunc_with_features($seq2, 2, 7);
 is $trunc->seq, 'gttaaa';
 my @feat=$trunc->get_SeqFeatures;
 is $feat[0]->location->to_FTstring, '<1..3';
 is $feat[1]->location->to_FTstring, 'complement(4..>6)';
+is $feat[2]->location->to_FTstring, 'complement(<1..4)';
 is_deeply([uniq_sort(map{$_->get_all_tags}$trunc->get_SeqFeatures)], [sort qw(note comment)], 'trunc_with_features - has expected tags');
 is_deeply([sort map{$_->get_tagset_values('note')}$trunc->get_SeqFeatures], [sort qw(note2 note3a note3b)], 'trunc_with_features - has expected tag values');
 
@@ -281,6 +289,10 @@ my ($rf2) = $revcom->get_SeqFeatures('source');
 is $rf2->primary_tag, $ft2->primary_tag, 'primary_tag matches original feature...';
 is $rf2->location->to_FTstring, 'complement(5..8)', 'but tagged sf is now revcom';
 
+my ($rf3) = $revcom->get_SeqFeatures('CDS');
+is $rf3->primary_tag, $ft4->primary_tag, 'primary_tag matches original feature...';
+is $rf3->location->to_FTstring, '4..>8', 'but tagged sf is now revcom';
+
 is_deeply([uniq_sort(map{$_->get_all_tags}$revcom->get_SeqFeatures)], [sort qw(note comment)], 'revcom_with_features - has expected tags');
 is_deeply([sort map{$_->get_tagset_values('note')}$revcom->get_SeqFeatures], [sort qw(note2 note3a note3b)], 'revcom_with_features - has expected tag values');
 # check circularity