use warnings; use strict; use Time::HiRes; if (@ARGV == 0) { print "Finds longest matching substring between any pair of test strings\n"; print "in the given file. Pairs of lines are expected with the first of a\n"; print "pair being the string name and the second the test string."; exit (1); } my $minmatch = 4; my $startTime = [Time::HiRes::gettimeofday ()]; my @strings; while (<>) { chomp(my $label = $_); chomp(my $string = <>); # Compute all substrings push @strings, map [substr($string, $_), $label, $_], 0..(length($string) - $minmatch); } print "Loaded. Sorting...\n"; @strings = sort {$a->[0] cmp $b->[0]} @strings; print "Sorted. Finding matches...\n"; # Now walk through the list. The best match for each string will be the # previous or next element in the list that is not from the original substring, # so for each entry, just look for the next one. See how many initial letters # match and track the best matches my @matchdata = (0); # (length, index1-into-strings, index2-into-strings) for my $i1 (0..($#strings - 1)) { my $i2 = $i1 + 1; ++$i2 while $i2 <= $#strings and $strings[$i2][1] eq $strings[$i1][1]; next if $i2 > $#strings; my ($common) = map length, ($strings[$i1][0] ^ $strings[$i2][0]) =~ /^(\0*)/; if ($common > $matchdata[0]) { @matchdata = ($common, [$i1, $i2]); } elsif ($common == $matchdata[0]) { push @matchdata, [$i1, $i2]; } } print "Best match: $matchdata[0] chars\n"; for my $i (@matchdata[1..$#matchdata]) { print "$strings[$i->[0]][1] starting at $strings[$i->[0]][2]" . " and $strings[$i->[1]][1] starting at $strings[$i->[1]][2]\n"; } print "Completed in " . Time::HiRes::tv_interval ($startTime) . "\n"; #### use warnings; use strict; my ($howmany, $howlong) = (20, 1000); # Generate $howmany strings of $howlong characters for my $s (1..$howmany) { print "'String $s'\n"; my $str = ''; $str .= (qw(A C G T))[rand 4] for 1..$howlong; print "$str\n"; }