优化 Perl 脚本以关联两个文件之间的记录

Posted

技术标签:

【中文标题】优化 Perl 脚本以关联两个文件之间的记录【英文标题】:Optimize Perl Script to Correlate Records Between Two Files 【发布时间】:2021-03-05 14:51:21 【问题描述】:
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”值。我能够获得输出,但需要大量时间来处理。有什么办法可以优化代码让它快速完成吗?

我的每个文件都有 300,000 条记录,文件大小为 15 MB。目前需要5个小时来处理

【问题讨论】:

我们需要更多信息来回答这个问题——比如这两个文件的内容是什么。您将通过反复重新打开和重新读取第二个文件来显着优化。 300,000 * 300,000 = 90,000,000,000。循环体被执行了 900 亿次。所以你说循环体每秒执行 500 万次,或者每 200 ns 执行一次。这很不错。微优化(例如,只读取文件一次,如果可能的话用字符串比较替换正则表达式匹配)不会有太大帮助。 [继续] 为了加快速度,如果可能,您希望从使用二次算法 (O(N*M)) 更改为使用线性算法 (O(N+M))。这会将时间减少到您现在使用的时间的一小部分。为了看看这是否可能,我们需要了解更多关于 SSA 和比较的信息。您是否要尝试两个文件中具有相同 SSA 的记录?如果是这样,它是一对一、一对多还是多对多的关系? 还有什么是脚本应该在什么时间完成的目标? 是的,尝试匹配记录。SSA 是唯一编号,我们只有 MAH2 文件中的一些值,并且是一对一关系 【参考方案1】:

建立一个查找表。

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 倍以上。我们说的是几秒钟,而不是几小时。

【讨论】:

【参考方案2】:

如果您的任务只是通过 SSA 字段查找 file2 中与 file1 中的记录相对应的记录,那么还有另一种方法可以比经典的查找哈希表方法更快、更简单。

您可以使用从 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 ##


让我们用一些 cmets 来打破它。

读取 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> ) .
    ")(?=[|])"
;

我不保证这种方式比任何其他方式更好或更快,但它是一种用更少步骤完成的方式。

【讨论】:

【参考方案3】:

ikegami 已经指出了一种将文件存储为查找表的更好方法。但请允许我提供一些我的观察,也许这些也适用。

通过这个表达式,我们将 $SSA1 视为正则表达式:

$SSA =~ /$SSA1/

我发现很少将正则表达式存储在文件中...您可能是要进行子字符串搜索而不是将 $SSA1 视为正则表达式?如果是这样的话,这可能是:

index($SSA, $SSA1) >= 0

OTOH 在同一个 if 语句中,匹配成功后的反应是:

$report5 = $report4

当同一个内循环有多个匹配成功时,同一个语句会被执行多次,也就是说$report5存储的是最后一个匹配对应的东西。

如果最多只能从 MAH2 中得到一个匹配,则可能添加一个“最后一个”以离开内循环。

if ( index($SSA, $SSA1) >= 0 ) 
    $report5 = $report4;
    last;

根据 MA​​H2 中的比赛位置,这可能会走捷径。虽然,这会在 first 匹配而不是 last 匹配处停止循环......这意味着它不是直接替换你的原始 cod。如果这仍然符合您的目的,也许可以使用它。

然而,作为这段程序的“输出”,$report5 只在给定的一段代码中使用一次,这意味着对于我们所做的所有 90 亿次迭代,只有一个匹配真正重要——也许它也会使离开外循环的感觉(同样,这可能不是你想要的。)

【讨论】:

Re“你是否可能意味着进行子字符串搜索而不是将 $SSA1 视为正则表达式?”,他们在 cmets 中澄清了他们想要数值相等。

以上是关于优化 Perl 脚本以关联两个文件之间的记录的主要内容,如果未能解决你的问题,请参考以下文章

perl - 帮助修改代码以包含子例程的使用

从 Perl 中的输出记录

将记录的日期时间转换为 UNIX 纪元时间戳的 Perl 脚本

wkhtmltopdf/perl:HTTP 标头和日志记录

向具有 4000 万条记录的表添加多列主键

从cron运行时,Perl脚本不会将STDOUT输出到文件