Checking really fast if one of many strings exists in one of many other strings, in Perl

Question

Let's say I have a set of 100,000 strings, each one around 20-50 bytes on average.

Then let's say I have another set of 100,000,000 strings, each one also around 20-50 bytes on average.

I'd like to go through all 100,000,000 strings from the second set and check if any one of the strings from the first set exist in any one string from the second set.

Example: string from first set: "abc", string from second set: "123abc123" = match!

I've tried using Perl's index(), but it's not fast enough. Is there a better way to do this type of matching?

Answer 1

Here is an idea: you could partition the dictionary into lists of words that have the same 2 or 3 letter prefix. You would then iterate on the large set and for each position in each string, extract the prefix and try and match the strings that have this prefix.

You would use hashtable to store the lists with O(1) lookup time.

If some words in the dictionary are shorter than the prefix length, you would have to special case short words.

Making prefixes longer will make the hashtable larger but the lists shorter, improving the test time.

I have no clue if this can be implemented efficiently in Perl.

Answer 2

You may want to have a look at https://github.com/leendo/hello-world . Its parallel processing makes it really fast. Either just type in all search terms individually or as || conjunctions, or (better) adapt it to run the second set programatically in one go.

Answer 3

You should use a regex alternation, like:

my @string = qw/abc def ghi/;
my $matcher = qr/@{[join '|', map quotemeta, sort @string]}/;

This should be faster than using index. But it can be made faster yet:

Up to a certain limit, depending on both the length and number of the strings, perl will build a trie for efficient matching; see e.g. https://perlmonks.org/?node_id=670558. You will want to experiment with how many strings you can include in a single regex to generate an array of regexes. Then combine those separate regexes into a single one (untested):

my @search_strings = ...;
my @matchers;
my $string_limit = 3000; # a guess on my part
my @strings = sort @search_strings;
while (my @subset = splice @strings, 0, $string_limit) {
    push @matchers, qr/^.*?@{[join '|', map quotemeta, sort @subset]}/s;
}
my $matcher = '(?:' . join('|', map "(??{\$matchers[$_]})", 0..$#matchers) . ')';
$matcher = do { use re 'eval'; qr/$matcher/ };
/$matcher/ and print "line $. matched: $_" while <>;

The (??{...}) construct is needed to join the separate regexes; without it, the subregexes are all just interpolated and the joined regex compiled all together, removing the trie optimization. Each subregex starts with ^.*? so it searches the entire string; without that, the joined regex would have to invoke each subregex separately for each position in the string.

Using contrived data, I'm seeing about 3000 strings searched per second with this approach in a not very fast vm. Using the naive regex is less than 50 strings per second. Using grep, as suggested in a comment by Shawn, is faster (about 4200 strings per second for me) but gives you less control if you want to do things like identify which strings matched or at what positions.

Answer 4

I found Algorithm::AhoCorasik::XS on CPAN, which implements the classic, very efficient multiple string search Aho-Corasick algorithm (Same one used by grep -F), and it seems to be reasonably fast (About half the speed of an equivalent grep invocation):

Example script:

#!/usr/bin/env perl
use warnings;
use strict;
use autodie;
use feature qw/say/;
use Algorithm::AhoCorasick::XS;

open my $set1, "<", "set1.txt";
my @needles = <$set1>;
chomp @needles;
my $search = Algorithm::AhoCorasick::XS->new(\@needles);

open my $set2, "<", "set2.txt";
while (<$set2>) {
    chomp;
    say if defined $search->first_match($_);
}

and using it (With randomly-generated test files):

$ wc -l set1.txt set2.txt
  10000 set1.txt
500000 set2.txt
510000 total
$ time perl test.pl | wc -l
458414

real    0m0.403s
user    0m0.359s
sys     0m0.031s
$ time grep -Ff set1.txt set2.txt | wc -l
458414

real    0m0.199s
user    0m0.188s
sys     0m0.031s

Answer 5

The task is quite simple and perhaps used on everyday basis around the globe.

Please see following code snippet for one of many possible implementations

use strict;
use warnings;
use feature 'say';

use Getopt::Long qw(GetOptions);
use Pod::Usage;

my %opt;
my $re;

GetOptions(
            'sample|s=s'    => \$opt{sample},
            'debug|d'       => \$opt{debug},
            'help|h'        => \$opt{help},
            'man|m'         => \$opt{man}
    ) or pod2usage(2);

pod2usage(1) if $opt{help};
pod2usage(-verbose => 2) if $opt{man};

pod2usage("$0: No files given.")  if ((@ARGV == 0) && (-t STDIN));

$re = read_re($opt{sample});

say "DEBUG: search pattern is ($re)" if $opt{debug};

find_in_file($re);

sub find_in_file {
    my $search = shift;

    while( <> ) {
        chomp;
        next unless /$search/;
        say;
    }
}

sub read_re {
    my $filename = shift;

    open my $fh, '<', $filename
        or die "Couldn't open $filename";

    my @data = <$fh>;

    close $fh;

    chomp @data;

    my $re = join('|', @data);

    return $re;
}

__END__

=head1 NAME

file_in_file.pl - search strings of one file in other 

=head1 SYNOPSIS

yt_video_list.pl [options] -s sample.txt dbfile.txt

 Options:
    -s,--sample search pattern file
    -d,--debug  debug flag
    -h,--help   brief help message
    -m,--man    full documentation

=head1 OPTIONS

=over 4

=item B<-s,--sample>

Search pattern file

=item B<-d,--debug>

Print debug information.

=item B<-h,--help>

Print a brief help message and exits.

=item B<-m,--man>

Prints the manual page and exits.

=back

B<This program> seaches patterns from B<sample> file in B<dbfile>

=cut