in reply to LCS efficiency problem
The version below includes its own small test set, but also accepts two or more file names as command line args, and spits out the single (first) LCS string found for each pairing of input files. It will report an "LCS" of a single "word" whenever that happens to be the longest common string, and it will report "NO_MATCH" when two inputs have nothing at all in common.
Note that the "lcs_arrays" sub assumes that its inputs have already been arranged into arrays according to whatever tokenization strategy is appropriate to a given task. (This means you could use it for character-based comparisons as well as word-based, but there are already other modules available for doing that sort of work.) I think separating the tokenization from the LCS algorithm is a useful thing.#!/usr/bin/perl use strict; use warnings; sub lcs_arrays { my ( $a1, $a2 ) = @_; my @matches = (); my $longest = 0; for my $b1 ( 0 .. $#$a1 ) { for my $b2 ( 0 .. $#$a2 ) { if ( $$a1[$b1] eq $$a2[$b2] ) { my @match = ( $$a1[$b1] ); my $e1 = $b1+1; my $e2 = $b2+1; while ( $e1 < @$a1 and $e2 < @$a2 ) { last if ( $$a1[$e1] ne $$a2[$e2] ); push @match, $$a1[$e1]; $e1++; $e2++; } if ( @match > $longest ) { push @matches, \@match; $longest = @match; } } } } return $matches[$#matches]; # array ref -> longest matching list } my @t = ( "now is the time for all good men to come to the aid of", "now is the winter of our discontent made glorious", "the time for all good parties now is the winter", "we expect good men to come to the aid of good parties", "I KNOW THIS SENTENCE WILL NOT MATCH", ); if ( @ARGV > 1 and -f $ARGV[0] ) { local $/; @t = (); for my $f ( @ARGV ) { open( I, $f ); push @t, <>; close I; } } for my $i ( 0 .. $#t-1 ) { for my $j ( $i+1 .. $#t ) { my @a = split " ", $t[$i]; my @b = split " ", $t[$j]; my $r = lcs_arrays( \@a, \@b ); if ( defined $r ) { print "$i-$j: @$r\n"; } else { print "$i=$j: NO_MATCHES\n"; } } }
In this example, the "main" part of my test script simply splits on whitespace, but you might want to do that part differently, e.g. removing punctuation characters (brackets, commas, periods, quotes, etc) from the left and right edges of each word, folding case, and/or other stuff like that.
UPDATE: Why aren't you using the "LCS" function of Algorithm::Diff? It works on arrays, just like the toy function I've posted here, so it's just a matter of how you populate the arrays. Of course, having just played with that a bit, I see now that I might be confused about the "proper" definition of the term "longest common substring". Given two input lists:
Algorithm::Diff::LCS will return "two three five six seven", whereas my toy function above will return just "two three five". I presume you know what you mean by "LCS", but you should be careful of what other people might mean by it (esp. if they, like me, might be confused about what the "proper" definition should be).list1: one two three five six seven list2: two three five eight five six seven
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: LCS efficiency problem
by ikegami (Patriarch) on Jun 07, 2008 at 09:01 UTC | |
|
Re^2: LCS efficiency problem
by BrowserUk (Patriarch) on Jun 07, 2008 at 01:01 UTC | |
|
Re^2: LCS efficiency problem
by ikegami (Patriarch) on Jun 07, 2008 at 06:10 UTC |