[英]Optimize Perl Script to Correlate Records Between Two Files
open( FH, 'MAH' ) or die "$!";
while ( $lines = <FH> ) {
$SSA = substr( $lines, 194, 9 );
open( FH1, 'MAH2' ) or die "$!";
while ( $array1 = <FH1> ) {
@fieldnames = split( /\|/, $array1 );
$SSA1 = $fieldnames[1];
$report4 = $fieldnames[0];
if ( $SSA =~ /$SSA1/ ) {
$report5= $report4;
}
}
}
我正在尝试从 MAH 文件中提取“SSA”值并在 MAH2 文件中搜索该值。 如果找到,则返回“report4”值。 我能够得到 output 但需要很多时间来处理。 有什么办法可以优化代码,让它快速完成吗?
我的每个文件都有 300,000 条记录,文件大小为 15 MB。 目前需要5个小时来处理
建立一个查找表。
my $foo_qfn = 'MAH';
my $bar_qfn = 'MAH2';
my %foos;
{
open(my $fh, '<', $foo_qfn)
or die("Can't open \"$foo_qfn\": $!\n");
while ( my $foo_line = <$fh> ) {
my $ssa = substr($foo_line, 194, 9);
$foos{$ssa} = $foo_line;
}
}
{
open(my $fh, '<', $bar_qfn)
or die("Can't open \"$bar_qfn\": $!\n");
while ( my $bar_line = <$fh> ) {
chomp($bar_line);
my ($report4, $ssa) = split(/\|/, $bar_line);
my $foo_line = $foos{$ssa};
...
}
}
您的原始代码花费的时间与 foos 的数量乘以 bar 的数量 (O(N*M)) 成间接比例。
这将花费时间与 foos 的数量和 bar 的数量中的最大值 (O(N+M)) 成间接比例。
换句话说,这应该快 100,000 倍以上。 我们说的是几秒钟,而不是几小时。
如果您的任务只是通过 SSA 字段查找 file2 中与 file1 中的记录相对应的记录,那么还有另一种方法可以比经典查找 hash 表方法更快、更简单。
您可以使用从 file1 中的记录构造的正则表达式一次性解析、匹配和从 file2 中提取。 是的,Perl 可以处理具有 300,000 个交替的正则表达式:。)这仅在 Perl 的正则表达式引擎可以构造交替树的情况下才合理。 (5:10+ 你可以在此之前使用 Regexp:.Assemble。)
## YOUR CODE ##
open( FH, 'MAH' ) or die "$!";
while ( $lines = <FH> ) {
$SSA = substr( $lines, 194, 9 );
open( FH1, 'MAH2' ) or die "$!";
while ( $array1 = <FH1> ) {
@fieldnames = split( /\|/, $array1 );
$SSA1 = $fieldnames[1];
$report4 = $fieldnames[0];
if ( $SSA =~ /$SSA1/ ) {
$report5= $report4;
}
}
}
作为正则表达式:
our $file1 = "MAH";
our $file2 = "MAH2";
open our $fh1, "<", $file1 or die $!;
our $ssa_regex = "(?|" .
join( "|",
map join("", "^([^|]*)[|](", quotemeta($_), ")(?=[|])"),
map substr( $_, 194, 9 ),
<$fh1> ) .
")"
;
close $fh1;
open our $fh2, "<", $file2 or die $!;
our @ssa_matches = do { local $/; <$fh2> =~ m/$ssa_regex/mg; };
close $fh2;
undef $ssa_regex;
die "match array contains an odd number of entries??\n" if @ssa_matches % 2;
while (@ssa_matches) {
my($report4, $SSA1) = splice @ssa_matches, 0, 2;
## do whatever with this information ##
}
让我们用一些评论来打破它。
读取 file1 并构建正则表达式。
our $file1 = "MAH";
our $file2 = "MAH2";
# open file1 as normal
open our $fh1, "<", $file1 or die $!;
# build up a regular expressions that will match all of the SSA fields
our $ssa_regex =
# Start the alternation reset group. This way you always have $1
# and $2 regardless of how many groups or total parens there are.
"(?|" .
# Join all the alternations together
join( "|",
# Create one regex group that will match the beginning of the line,
# the first "record4" field, the | delimiter, the SSA, and then
# make sure the following character is the delimiter. [|] is
# another way to escape the | character that can be more clear
# than \|.
# Escape any weird characters in the SSA with quotemeta(). Omit
# this if plain text.
map join("", "^([^|]*)[|](", quotemeta($_), ")(?=[|])"),
# Pull out the SSA value with substr().
map substr( $_, 194, 9 ),
# Read all the lines of file1 and feed them into the map pipeline.
<$fh1> ) .
# Add the closing parethesis for the alternation reset group.
")"
;
# Close file1.
close $fh1;
读入 file2 并应用正则表达式。
# Open file2 as normal.
open our $fh2, "<", $file2 or die $!;
# Read all of file2 and apply the regex to get an array of the wanted
# "record4" field and the matching SSA.
our @ssa_matches =
# Using a do{} block lets do the undef inline.
do {
# Undefine $/ which is the input record seperator which will let
# us read the entire file as a single string.
local $/;
# Read the file as a single string and apply the regex, doing a global
# multiline match. /m means to apply the ^ assertion at every line,
# not just at the beginning of the string. /g means to perform and
# return all of the matches at once.
<$fh2> =~ m/$ssa_regex/mg;
};
# Close file2 as normal.
close $fh2;
# Clear the memory for the regex if we don't need it anymore
undef $ssa_regex;
# Make sure we got pairs
die "match array contains an odd number of entries??\n" if @ssa_matches % 2;
# Now just iterate through @ssa_matches two at a time to do whatever
# you wanted to do with the matched SSA values and that "record4"
# field. Why is it record4 if it's the first field?
while (@ssa_matches) {
# Use splice() to pull out and remove the two values from @ssa_matches
my($report4, $SSA1) = splice @ssa_matches, 0, 2;
## do whatever with this information ##
}
如果我们是迂腐的,正则表达式可以压缩得更多。
our $ssa_regex = "^([^|]*)[|](" .
join( "|",
map quotemeta($_),
map substr( $_, 194, 9 ),
<$fh1> ) .
")(?=[|])"
;
我不保证这种方式比任何其他方式更好或更快,但它是一种用更少步骤完成的方式。
ikegami 已经指出了一种将文件存储为查找表的更好方法。 但请允许我提供一些我的观察,也许这些也可以适用。
通过这个表达式,我们将 $SSA1 视为正则表达式:
$SSA =~ /$SSA1/
我发现很少将正则表达式存储在文件中......您是否可能是要进行子字符串搜索而不是将 $SSA1 视为正则表达式? 如果是这样的话,这可能是:
index($SSA, $SSA1) >= 0
OTOH 在同一个 if 语句中,匹配成功后的反应是:
$report5 = $report4
当同一个内循环中有多个成功匹配时,同一个语句会被执行多次,这意味着 $report5 存储了与最后一个匹配对应的内容。
如果最多只能从 MAH2 中获得一个匹配,则可能添加一个“最后一个”以离开内循环。
if ( index($SSA, $SSA1) >= 0 ) {
$report5 = $report4;
last;
}
取决于比赛在 MAH2 中的位置,这可能会偷工减料。 虽然,这会在第一次匹配而不是最后一次匹配时停止循环......这意味着它不是直接替换你原来的鳕鱼。 如果这仍然符合您的目的,也许可以使用它。
然而,作为这段程序的“输出”,$report5 只使用一次给定的代码,这意味着对于我们所做的所有 90 亿次迭代,只有一个匹配真正重要——也许离开也是有意义的外循环(同样,这可能不是你想要的。)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.