Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
There is not a "fast" way to do this, only "faster". See QOTW#E14 for how to do this with one string.

I'm sure there are other ways, such as using XOR, maybe like this:

my $xor = substr($data[$d1],$s1,$L) ^ substr($data[$d2],$s2,$L);
See this for a working program:

Update: The previous code only checked half of the possibilities. I've replaced it with this code:

Update 2: The previous code missed multiple matches in the regex, fixed.

#!/your/perl/here # find the longest common substring (contiguous) in a list of strings # # method: # sort all strings by descending length # search from longest overlap to shortest # (the longest substring is more likely to be in the longest overlap) # use strict; use warnings; use Benchmark; my @timer; push @timer, new Benchmark; # predictable randomness srand(atan2(1,1)*4*1000); my @keys = qw( LENGTH STRING FIRST_INDEX FIRST_OFFSET SECOND_INDEX SEC +OND_OFFSET ); my @chars = qw( A G C T ); my $longest = 0; my @data; foreach my $i (1..300) { my $d; foreach my $j (1..3000) { $d .= $chars[rand(@chars)]; } push @data, $d; $longest = length($d) if ( length($d) > $longest ); } # sort longest to shortest @data = sort { length($b) <=> length ($a) } @data; my %LCS; @LCS{@keys} = (0,'',-1,-1,-1,-1); my $L = $longest; L: while ( $L > $LCS{LENGTH} ) { push @timer, new Benchmark; @timer = time_delta("\nL:$L", @timer); D1: for my $d1 ( 0..$#data-1 ) { # all entries are sorted by descending length # if this entry is too short, all the rest are as well # go to the next "length" my $d1L = length( $data[$d1] ); next L unless ( $d1L >= $L ); D2: for my $d2 ( $d1+1..$#data ) { # all entries are sorted by descending length # if this entry is too short, all the rest are as well # go to the next D1 (which may be long enough) my $d2L = length( $data[$d2] ); next D1 unless ( $d2L >= $L ); # consider overlaps of length $L # these are starting index numbers # overlaps are either at index 0, # or the last $L characters my @s1 = (0, $d1L - $L ); my @s2 = ($d2L - $L, 0 ); S: for my $s ( 0,1 ) { my $xor = substr($data[$d1],$s1[$s],$L) ^ substr($data +[$d2],$s2[$s],$L); my $offset = 0; while ( $xor =~ /([^\0]*)(\0{$LCS{LENGTH},})/gsm ) { my ($first, $second) = ($1, $2); $offset += length($first); my $long = length($second); if ( $long > $LCS{'LENGTH'} ) { @LCS{@keys} = ($long, substr($data[$d1],$s1[$s]+$offs +et,$long), # string $d1,$s1[$s]+$offset, $d2,$s2[$s]+$offset); print "\nLCS: <$LCS{STRING}> $long\n"; } $offset += length($second); } } } } $L--; } print "Longest: <$LCS{STRING}> ($LCS{LENGTH})\n"; print "Item $LCS{FIRST_INDEX}, offset $LCS{FIRST_OFFSET}\n"; print "Item $LCS{SECOND_INDEX}, offset $LCS{SECOND_OFFSET}\n"; push @timer, new Benchmark; @timer = time_delta("total", @timer); exit; ########################################### # nice benchmark timestamp printer sub time_delta { my $msg = shift; my @t = @_; my $total_time = timestr(timediff(@t[-1,0])); my $delta_time = timestr(timediff(@t[-1,-2])); print "$msg\nd:$delta_time\nt:$total_time\n"; return @t[0,-1]; }
Update 2 (continued: Comparing with some of the other entries, this performs moderately. On large input sets it's an order of magnitude slower than Grandfather's. It's weakness is that, once the LCS is found, it has to prove it's the longest by continuing to search.

-QM
--
Quantum Mechanics: The dreams stuff is made of


In reply to Re: Search for identical substrings by QM
in thread Search for identical substrings by bioMan

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2024-03-29 05:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found