Perl - 从 arrayref 中删除不需要的元素答案

【问题标题】：Perl - Removing unwanted elements from an arrayrefPerl - 从 arrayref 中删除不需要的元素
【发布时间】：2017-04-21 23:38:52
【问题描述】：

我正在编写一个脚本来解析“pure-ftpwho -s”命令以获取当前传输的列表。但是，当用户从 FTP 断开连接并重新连接并恢复传输时，该文件会显示两次。我想用 Perl 删除重影。解析后，arrayref 是这样的（用 Data::Dumper 转储）

$VAR1 = [
      {
        'status' => 'DL',
        'percent' => '20',
        'speed' => '10',
        'file' => 'somefile.txt',
        'user' => 'user1',
        'size' => '14648'
      },
      {
        'status' => 'DL',
        'percent' => '63',
        'speed' => '11',
        'file' => 'somefile.txt',
        'user' => 'user1',
        'size' => '14648'
      },
      {
        'status' => 'DL',
        'percent' => '16',
        'speed' => '60',
        'file' => 'somefile.txt',
        'user' => 'user2',
        'size' => '14648'
      }
    ];

这里 user1 和 user2 正在下载同一个文件，但是 user1 出现了两次，因为第一个是“幽灵”。检查和删除我不需要的元素（在本例中为 arrayref 的第一个元素）的最佳方法是什么。检查的条件是 - 如果“文件”键和“用户”键相同，则删除包含“百分比”键值较小的 hashref（如果它们相同，则删除除一个之外的所有值）。

【问题讨论】：

请阅读perldoc perldsc（也可在线获取perldoc.perl.org/perldsc.html）。

标签： perl parsing

【解决方案1】：

如果原始 arrayref 中的顺序无关紧要，这应该可以：

my %users;
my @result;

for my $data (@$arrayref) {
    push @{ $users{$data->{user}.$data->{file}} }, $data;
}

for my $value (values %users) {
    my @data = sort { $a->{percent} <=> $b->{percent} } @$value;
    push @result, $data[-1];
}

这绝对可以提高效率。

【讨论】：

【解决方案2】：

在这种情况下，正确的解决方案是在解析日志文件时使用哈希。将所有信息放入一个散列中，例如%log，由user 和file 键入：

$log{$user}->{$file} = {
    'status' => 'DL',
    'percent' => '20',
    'speed' => '10',
    'size' => '14648'
};

等等。日志文件中后面的条目会覆盖前面的条目。或者，您可以选择用完成率较高的条目覆盖完成百分比较低的条目。

使用散列可以消除很多完全多余的代码来解决错误数据结构的选择。

【讨论】：

【解决方案3】：

对于它的价值，这是我的（稍微）替代方法。同样，它不会保留原始顺序：

my %most_progress;

for my $data ( sort { $b->{percent} <=> $a->{percent} } @$data ) {
    next if exists $most_progress{$data->{user}.$data->{file}};
    $most_progress{$data->{user}.$data->{file}} = $data;
}

my @clean_data = values %most_progress;

【讨论】：

【解决方案4】：

这将保持秩序：

use strict;
use warnings;

my $data = [ ... ]; # As posted.

my %pct;
for my $i ( 0 .. $#{$data} ){
    my $r = $data->[$i];
    my $k = join '|', $r->{file}, $r->{user};
    next if exists $pct{$k} and $pct{$k}[1] >= $r->{percent};
    $pct{$k} = [$i, $r->{percent}];
}

@$data = @$data[sort map $_->[0], values %pct];

【讨论】：

【解决方案5】：

my %check; 

for (my $i = 0; $i <= $#{$arrayref}; $i++) { 
  my $transfer = $arrayref->[$i]; 

  # check the transfer for user and file 
  my $key = $transfer->{user} . $transfer->{file};  
  $check{$key} = { } if ( !exists $check{$key} ); 

  if ( $transfer->{percent} <= $check{$key}->{percent} ) { 
    # undefine this less advanced transfer 
    $arrayref->[$i] = undef; 

  } else { 
    # remove the other transfer 
    $arrayref->[$check{$key}->{index}] = undef if exists $check{$key}->{index}; 

    # set the new standard 
    $check{$key} = { index => $i, percent => $transfer->{percent} } 
  } 
}  

# remove all undefined transfers     
$arrayref = [ grep { defined $_ } @$arrayref ];

【讨论】：

【解决方案6】：

主题与Perl6::Gather的变化

use Perl6::Gather;

my @cleaned = gather {
    my %seen;
    for (sort { $b->{percent} <=> $a->{percent} } @$data) {
        take unless $seen{ $_->{user} . $_->{file} }++;
    }
};

【讨论】：