Perl, problems scrubbing a file with regex effeciently - regex

Question

First I will explain the problem my program attempts to solve. I have two input files, one contains lines of "good" numbers:
100000
100001
100002
100003
100004
The other file is a file of "raw" numbers that I want to check each line of and see if the line contains one of the "good" numbers above followed by 4 more numbers, the additional 4 numbers can be anything. so if the file containing the raw numbers is :
8881000001234
1000014321
999991000021234567
00234100001
1000041234
100002123
1000029876
after scrubbing with regex the matched numbers would be
1000001234
1000014321
1000021234
1000041234
1000029876
The way I have done this so far is to store the "good" numbers in an array then slurped the "raw" numbers into a scalar
my $FH
my#good_nums
open $FH, '<', 'good_numbers' or die $!;
while(<$FH>) { chomp; push #good_nums, $_; }
close $FH;
open $FH, '<', 'raw_numbers' or die $!;
my $raw_nums = do { local $/; <$FH> };
close $FH;
then with those I can do this :
my #matches;
foreach my $num (#good_nums) {
push #matches, $raw_nums =~ /$num\d{4}/g;
}
So #matches contains the correct matches and this has been working well.
But now I have developed the need to also capture the lines from "raw" numbers that did not match. I can capture the non matching lines by putting the "raw" numbers into an array (instead of slurping them) and join the #good_nums array into a regex :
my $QRnums = '(?:' . (join '|', #good_nums) . ')';
$QRnums = qr/$QRnums/;
my #raw_nums;
open my $FH, '<', 'raw_numbers' or die $!;
while(<$FH>) { chomp; push #raw_nums, $_; }
my #matches;
my #junk;
for (#raw_nums) {
if ($_ =~ /($QRnums\d{4})/g) {
push #matches, $1;
} else {
push #junk, $_;
}
}
This is working but when I increase the number of lines in each file to 150,000 or more, the latter solution takes 4 or 5 times longer than the former solution. I know there must be another Perl solution that can solve my problem efficiently but I am at a loss. I am not very good with intermediate Perl and beyond.. Is there a better way to do this or can my first solution be rewritten so that I can obtain the non matches in an array too? Apart from needing to solve the problem explained in the opening of my post, I am open to anything.

Answer 1

Only cache your regex one time, and then compare using $_ =~ $QRnums.
Additionally, there's no need to slurp your other file, just do line-by-line process instead.
my $QRnums = '(?:' . (join '|', #good_nums) . ')';
$QRnums = qr/($QRnums\d{4})/;
my #matches;
my #junk;
open my $FH, '<', 'raw_numbers' or die $!;
while (<$FH>) {
chomp;
if ($_ =~ $QRnums) {
push #matches, $1;
} else {
push #junk, $_;
}
}
Also, if your regex should be bounded to the start of the string ^, then I would suggest that you add that: $QRnums = qr/^($QRnums\d{4})/;
Addendum
From perlop - Regexp Quote-Like Operators
Since Perl may compile the pattern at the moment of execution of the qr() operator, using qr() may have speed advantages in some situations, notably if the result of qr() is used standalone:
and later:
Precompilation of the pattern into an internal representation at the moment of qr() avoids a need to recompile the pattern every time a match /$pat/ is attempted. (Perl has many other internal optimizations, but none would be triggered in the above example if we did not use qr() operator.)
Basically, because your #good_nums list was potentially very large, it made sense to cache that if we could so that it the regex test only needed to be compiled once.