All that is needed is a test in each loop to quit when the partial match attempt is less than whatever minimum you want to specify. Rather than duplicate the test in both loops, I've amalgamated them into a single loop which allows for a single test, with the nice side-effect of being 25% more efficient than the original above.
I've also added some explanitary comments and (I think) improved the variable names. Let me know if anything is unclear.
I've posted the output of a run with the minimum match set to 3, to test the breakpoint, but set it to whatever value makes sense for your purposes.
#! perl -slw
use strict;
use constant MINMATCH => 3;
## returns a list of 3 integers.
## offset into the haystack
## offset into the needle ( can be negative, subtract from length(need
+le) )
## length of match.
sub search {
my( $haystack, $needle, $pos ) = @_;
my( @start, @end );
my $l = length $needle;
## A full match found
return( $pos-1, 0, $l ) if $pos = 1+index $haystack, $needle;
## iterate, and attempt matches at both ends
for( 1 .. $l-1 ) {
my $r = $l - $_; ## reverse offset
last if $r < MINMATCH; ## quit if we've reached the minimum ma
+tch length
## try a partial match at the beginning
substr( $haystack, $_-$l ) eq substr( $needle, 0, $l-$_ )
and @start = ( length( $haystack )-( $l-$_), -$_, $l-$_ )
+;
## try a partial match at the end
substr( $haystack, 0, $r ) eq substr( $needle, -$r )
and @end = ( 0, $_, $r );
## Quit if we got either.
last if @start or @end;
}
return unless @start or @end; ## No match
return @start unless @end; ## No partial at the end, st
+art is best
return @end unless @start; ## No partial at the start,
+end is best
return $start[2] >= $end[2] ? @start : @end; ## Got both, longest
+(or start if equal) is best
}
our @haystacks = (
'TTGTCAGCGAAAAAAATTAAAGCGCAAGATTGTTGGTTTTTGCGTGATGGTGACCGGGCAGCCTA
+AAGGCTATCCTTAACCAGGGAGCTGATT',
'GAATGTTTTAGCAATCTCTTTCTGTCATGAATCCATGGCAGTGACCATACTAATGGTGACTGCCA
+TTGATGGAGGGAGACACAGTGCACTGGCAAACTCACAC',
'TAATCAAAACCAATAAACACGAAATAATCCCCATGCCGGTGAAGAAGGGGCGTGACTTTAGCGAA
+ATGTTGCCGTCGCGACAACCGGAATATGAAAGCAAAGCGCAGCGTCTGAATAACGTTTATGCTGAAAGC
+GGATGAATAAGGAGATGCG',
);
our @needles = (
'GCGAAAAAAATTAAAGCGCAAGATTGTTGGTTTTTGCGTGATGGTGAC',
'CATTACATTGCTGGATAAGAATGTTTTAGCAATCTCTTTCTGTCATGA',
'CGCGACAACCGGAATATGAAAGCAAAGCGCAGCGTCTGAATAACGTTT',
);
$, = ' ';
for my $needle ( @needles ) {
for my $haystack ( @haystacks ) {
my( $hOffset, $nOffset, $l ) = search $haystack, $needle;
if( defined $hOffset ) {
print "$hOffset, $nOffset, $l";
printf "%s%s\n%s%s\n\n",
' 'x$nOffset, $haystack,
' 'x$hOffset, $needle;
}
else {
print "No match found in '$haystack'\n for '$needle'\n";
}
}
}
__END__
C:\test>579215-2
6, 0, 48
TTGTCAGCGAAAAAAATTAAAGCGCAAGATTGTTGGTTTTTGCGTGATGGTGACCGGGCAGCCTAAAGGC
+TATCCTTAACCAGGGAGCTGATT
GCGAAAAAAATTAAAGCGCAAGATTGTTGGTTTTTGCGTGATGGTGAC
No match found in 'GAATGTTTTAGCAATCTCTTTCTGTCATGAATCCATGGCAGTGACCATACT
+AATGGTGACTGCCATTGATGGAGGGAGACACAGTGCACTGGCAAACTCACAC'
for 'GCGAAAAAAATTAAAGCGCAAGATTGTTGGTTTTTGCGTGATGGTGAC'
150, -45, 3
TAATCAAAACCAATAAACACGAAATAATCCCCATGCCGGTGAAGAAGGGGCGTGACTTTAGCGAAATGTT
+GCCGTCGCGACAACCGGAATATGAAAGCAAAGCGCAGCGTCTGAATAACGTTTATGCTGAAAGCGGATG
+AATAAGGAGATGCG
+
+ GCGAAAAAAATTAAAGCGCAAGATTGTTGGTTTTTGCGTGATGGTGAC
No match found in 'TTGTCAGCGAAAAAAATTAAAGCGCAAGATTGTTGGTTTTTGCGTGATGGT
+GACCGGGCAGCCTAAAGGCTATCCTTAACCAGGGAGCTGATT'
for 'CATTACATTGCTGGATAAGAATGTTTTAGCAATCTCTTTCTGTCATGA'
0, 18, 30
GAATGTTTTAGCAATCTCTTTCTGTCATGAATCCATGGCAGTGACCATACTA
+ATGGTGACTGCCATTGATGGAGGGAGACACAGTGCACTGGCAAACTCACAC
CATTACATTGCTGGATAAGAATGTTTTAGCAATCTCTTTCTGTCATGA
No match found in 'TAATCAAAACCAATAAACACGAAATAATCCCCATGCCGGTGAAGAAGGGGC
+GTGACTTTAGCGAAATGTTGCCGTCGCGACAACCGGAATATGAAAGCAAAGCGCAGCGTCTGAATAACG
+TTTATGCTGAAAGCGGATGAATAAGGAGATGCG'
for 'CATTACATTGCTGGATAAGAATGTTTTAGCAATCTCTTTCTGTCATGA'
No match found in 'TTGTCAGCGAAAAAAATTAAAGCGCAAGATTGTTGGTTTTTGCGTGATGGT
+GACCGGGCAGCCTAAAGGCTATCCTTAACCAGGGAGCTGATT'
for 'CGCGACAACCGGAATATGAAAGCAAAGCGCAGCGTCTGAATAACGTTT'
No match found in 'GAATGTTTTAGCAATCTCTTTCTGTCATGAATCCATGGCAGTGACCATACT
+AATGGTGACTGCCATTGATGGAGGGAGACACAGTGCACTGGCAAACTCACAC'
for 'CGCGACAACCGGAATATGAAAGCAAAGCGCAGCGTCTGAATAACGTTT'
75, 0, 48
TAATCAAAACCAATAAACACGAAATAATCCCCATGCCGGTGAAGAAGGGGCGTGACTTTAGCGAAATGTT
+GCCGTCGCGACAACCGGAATATGAAAGCAAAGCGCAGCGTCTGAATAACGTTTATGCTGAAAGCGGATG
+AATAAGGAGATGCG
+ CGCGACAACCGGAATATGAAAGCAAAGCGCAGCGTCTGAATAACGTTT
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
|