在数组中查找具有更好时间复杂度的子字符串（最好是在perl中）

Question

I am having an array of random alphabetical strings; the length of the array is 290K+.

Now I want to check if any of the string in the array is a sub-string of any other string present in the array.

My code

for my $z (0..$seq_len-1)
{
my $seq1 = $seq[$z];

for my $y (0..$seq_len-1)
{
    my $seq2 = $seq[$y];

    if($z != $y)
    {
#           my $anything = '.*';
#           my $pattern = $anything.$seq2.$anything;
        if($seq1 =~ m/$seq2/)
        {
            push @::uniq, $identifiers[$z];
            push @::duplicate, $identifiers[$y];
        }
    }
}
}

The code works fine but can there be a better approach to accomplish this task?

Edit

Thanks for pointing out unnecessary usage in regexp; removed that but still not much of difference.

Thanks in advance

Answer 1

You can use a suffix tree .

Populate the tree with all strings, and then iterate the collection, and check if any string is a prefix of some suffix in the array, which is not the initial string already.
The idea, if you find a suffix - which a string s is a prefix of - it is a substring of some other string (and it is easy to find which in this DS).

This solution is pretty efficient in terms of asymptotical complexity, but requires a more complex DS for you to use.

This solution runs in O(n*|S|) - where |S| is the length of a string, which is much more efficient than your O(n^2*R(|S|)) - where R(|S|) is your regex complexity.

Answer 2

For starters:

• You're being inefficient with your pattern. The .* wrapping is entirely irrelevant. /.*pattern.*/ will match the same things at /pattern/ .
• You're making pointless comparisons - you don't need to compare bidirectionally at all, because when one string is longer than the other - it cannot be a sub string. So you can shorten your 'for' loops, so the inner ( $y ) loop starts at $z and just ensure you test the shorter for being a substring of the longer.
• You might find compiling some regular expressions to match each element (and reusing) will improve it - otherwise you're 'restarting' the regular expression engine each time. (see - http://perldoc.perl.org/perlop.html#Regexp-Quote-Like-Operators )
• You should also be able to chain matches - A is a substring of AB . Which means you don't need to individually test that ABC , ABCD etc. match both - if they match the longer one, they match the shorter.

Whether these are worth doing depends rather on the size of your lists.

Answer 3

The following reduces the work from N ² regexp matches to N of them. The regexp is matched against a much longer string than before, but the savings should still be quite noticeable.

my $encoded_seqs = "\0" . join("\0", @seqs) . "\0";
for my $seq (@seqs) {
   if (
      $encoded_seqs =~ /\0 (?: \Q$seq\E [^\0]+ | [^\0]+ \Q$seq\E [^\0]* )/x
   ) {
      print("$seq is contained by another.\n");
   } else {
      print("$seq is isn't contained by another.\n");
   }
}

To find one of the matches:

my $encoded_seqs = "\0" . join("\0", @seqs) . "\0";
for my $seq (@seqs) {
   if (
      my ($match) =
         $encoded_seqs =~ /\0 ( \Q$seq\E [^\0]+ | [^\0]+ \Q$seq\E [^\0]* )/x
   ) {
      print("$seq is contained by $match, and possibly others.\n");
   } else {
      print("$seq is isn't contained by another.\n");
   }
}

To find all of the matches:

my $encoded_seqs = "\0" . join("\0", @seqs) . "\0";
for my $seq (@seqs) {
   if (
      my @matches =
         $encoded_seqs =~ /\0 ( \Q$seq\E [^\0]+ | [^\0]+ \Q$seq\E [^\0]* )/xg
   ) {
      print("$seq is contained by @matches\n");
   } else {
      print("$seq is isn't contained by another.\n");
   }
}

Possibly a little bit faster:

$encoded_seqs =~ /\0 ( (?>[^\0]*) \Q$seq\E (?>[^\0]*) ) (?<! \0 \Q$seq\E )/xg

All of the above assume that NUL can't be in any of the sequences. If the sequences can contain any character, you can use the following instead:

# Hides "~" in a lossless way.
my @decode = qw( ! ~ );
my %encode = map { $decode[$_] => $decode[0].$_ } 0..$#decode;
sub encode(_) { return $_[0] =~ s/([!~])/$encode{$encode{$1}/gr }
sub decode(_) { return $_[0] =~ s/!(.)/$decode[$1]/sgr }

my $encoded_seqs = '~' . join('~', map encode, @seqs) . '~';
for my $seq (@seqs) {
   my $encoded_seq = encode($seq);

   # Use ~ instead of \0.
   # Use $encoded_seq instead of $seq.
   # Use decode() on the values in $match and @matches.
}

Answer 4

You are adding complexity and runtime here:

    my $anything = '.*';
    my $pattern = $anything.$seq2.$anything;
    if($seq1 =~ m/$pattern/)

The .* before and after $seq2 serve no purpose, because /foo/ is functionally identical to /.*foo.*/ .