Re: Search for identical substrings

(Hope no one minds me making a second reply -- updating gets tiresome after a while...)

Well, a lot really hinges on what you mean, exactly, when you say:

...search for the longest matching substrings between the members of the array...

If what you mean is something like this:

$string[0] = "abc  fghijklmn ";
$string[1] = " b d fgh jklmno";
# correct answer  is: "jklmn", 5 chars long;
# (next longest common substring is " fgh",
#  but you're not interested in that)
[download]

then Algorithm::Diff can be used to arrive at that answer for each pair-wise string comarison as follows:

#!/usr/bin/perl

use strict;
use Algorithm::Diff qw/traverse_sequences/;

my @strings = <>;
chomp @strings;

my ( $longestMatch, $currentMatch );
my ( @seq1, @seq2 );

for my $i ( 0 .. $#strings-1 ) {
    @seq1 = split //, $strings[$i];
    for my $j ( $i+1 .. $#strings ) {
        @seq2 = split //, $strings[$j];
        $longestMatch = $currentMatch = "";
        traverse_sequences( \@seq1, \@seq2,
                          { MATCH => \&add2match,
                            DISCARD_A => \&end_match,
                            DISCARD_B => \&end_match }
                          );

### update: add a direct call to "end_match()" here,
### in case traverse was still matching at end-of-string:
        end_match( 'EOS' );

        print "LCS for $i :: $j = |$longestMatch|\n";
    }
}

sub add2match {
    my ( $ptrA, $ptrB ) = @_;
    $currentMatch .= $seq1[$ptrA];
#    warn "match at i=$ptrA, j=$ptrB : =$seq1[$ptrA]= ; cm=$currentMat
+ch=\n";
}

sub end_match {
    $longestMatch = $currentMatch
        if ( length( $longestMatch ) < length( $currentMatch ));
    $currentMatch = "";
#    warn "match ended at @_ : lm=$longestMatch=\n";
}
[download]

If you take out the comment marks on the "warn" statements in the two callbacks, you'll be able to watch what's going on. With those commented out, a file of 382 lines (between 2 and 73 characters per line, about 73K pair-wise comparisons) was finished in about 6 minutes.

I expect there are cleaner ways to do it (e.g. that don't involve global-scope variables), but this was fairly quick and easy (fun, even) for a first-time A::D user.

Comment on Re: Search for identical substrings Select or Download Code

Replies are listed 'Best First'.
Re^2: Search for identical substrings by bioMan (Beadle) on Aug 18, 2005 at 22:03 UTC
If I'm reading the information right for Algorithm::Diff it will not return what I want. LCS appears to use a "distance" measure. That is it determines the distance over which two strings have the most information in common. This is done by computing hits and misses. The maximum hit count will give the longest distance over which the two strings share commonality. Usually these types of algorithms have a penalty for misses. Nonetheless as I understand LCS, if we are using the strings "banana is split" and "bananas split" we can line up the strings a couple of ways. `banana is split bananas split banana--s # 7 characters in common and two misses "-" or banana is split bananas split ana--s split # 10 characters in common and two misses` [download] Allowing the strings to flex by putting holes in the strings we get... `banana is split banana..s split # 13 characters in common and two "holes"` [download] ...by putting two holes between "a" and "s" in "bananas" So "bananas split" (removing the holes from "banana..s split") would be the result of LCS, but I want "s split" with a hit count of 7, no misses and no holes.	[reply] [d/l] [select]
Re^3: Search for identical substrings by BrowserUk (Patriarch) on Aug 19, 2005 at 00:54 UTC
The problem is that the "LCS" in Algorithm::Diff is Longest Common Sub-Sequence, but for your requirements you need Longest Common String. The difference being the latter is contiguous, whilst the former is not (need not be). You're after this? `P:\test>lcs "banana is split" "banana..s split" banana is split banana..s split s split` [download] I'm still verifying my algorithm is correct, but so far it appears to be about 10x quicker than the XS version of LCSS despite being pure perl. 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". The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.	[reply] [d/l]
Re^4: Search for identical substrings by bioMan (Beadle) on Aug 19, 2005 at 16:50 UTC
You are correct I want the string "s split". Per GrandFather's request I'll try to put some real data into my scratchpad later today.	[reply]
Re^3: Search for identical substrings by graff (Chancellor) on Aug 19, 2005 at 00:09 UTC
... but I want "s split" with a hit count of 7, no misses and no holes. Based on that, I checked that example against my script, and found that I needed to call "end_match()" after "travers_sequence()" was done, in case a match exends to the end of both strings. With that update, the script does what you want in this case. (But for the other sample data you posted above, I think it doesn't come up with the best answer in some cases, and I don't understand why, as yet.)	[reply]