Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Re: Search for identical substrings

by graff (Chancellor)
on Aug 17, 2005 at 23:12 UTC ( [id://484633]=note: print w/replies, xml ) Need Help??


in reply to 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)
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"; }
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.

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

    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"

    ...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.

      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

      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.

        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.

      ... 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.)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://484633]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2024-04-19 07:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found