使用 perl 从文本文件中删除唯一行

Question

我正在对 perl 中包含多列的文本文件进行一些过滤

文件格式如下：

C1  C2  C3  C4 
1   ..  ..  ..
2   ..  ..  ..
3   ..  ..  ..
3   ..  ..  ..
3   ..  ..  ..

我想删除第 1 列中所有具有唯一值的行。所以输出应该是这样的：

C1  C2  C3  C4
3   ..  ..  ..
3   ..  ..  ..
3   ..  ..  ..

我正在对这个文件执行不同的过滤步骤。这是我正在使用的脚本

my $ DATA
my $filename = $ARGV[0];
    unless ($filename) {
        print "Enter filename:\n";
        $filename = <STDIN>;
        chomp $filename;
     }
open($DATA,'<',$filename) or die "Could not open file $filename $!";
open($OUT,'+>',"processed.txt") or die "Can't write new file: $!";

while(<$DATA>){
    next if /^\s*#/; 
    print $OUT $_;
    }

close $OUT;

如您所见，我正在一个 while 循环中工作，其中我已经使用下一个命令从文件中删除注释行。现在我想在这个循环中添加命令以删除第 1 列中具有唯一值的所有行。

有人可以帮我解决这个问题吗？

Answer 1

大部分是从 ikegami 和 mattan 偷来的：

print "header: ", scalar(<>);
print "multis: \n";

my %seen;
while (<>) {
   next if /^\s*#/;
   my ($id) = /^(\S+)/;
   ++$seen{$id}{count};
   if (1 == $seen{$id}{count}) {
      # store first occurrence
      $seen{$id}{line} = $_;
   } elsif (2 == $seen{$id}{count}) {
      # print first & second occurrence
      print $seen{$id}{line};
      print $_;
   } else {
      # print Third ... occurrence
      print $_;
   }
}

但保持秩序并只使用一个循环。

稍后：

三思而后行

是的，它们 [线条] 应该保持与现在相同，即数字 顺序[ids]

我可以把独家商品还给我：

print "header: ", scalar(<>);
print "multis: \n";

my $ol = scalar(<>);                      # first/old line
my $oi = 0 + (split(" ", $ol, 2))[0];     # first/old id
my $bf = -1;                              # assume old line must be printed
do {
   my $cl = scalar(<>);                   # current line
   my $ci = 0 + (split(" ", $cl, 2))[0];  # current id
   if ($oi != $ci) {                      # old and current id differ
      $oi = $ci;                          #   remember current/first line of current id
      $ol = $cl;                          #   current id becomes old
      $bf = -1;                           #   assume first/old line must be printed
   } else {                               # old and current id are equal
      if ($bf) {                          #    first/old line of current id must be printed
        print $ol;                        #      do it
        $bf = 0;                          #      but not again
      }
      print $cl;                          #    print current line for same id
   }
} while (! eof());

Answer 2

Tie::File 巧妙地完成了这项工作，它允许您将数组映射到文本文件，以便从数组中删除元素也会从文件中删除行。

此程序需要两次遍历文件：第一次计算第一个字段的每个值的出现次数，第二次删除该字段在文件中唯一的行。

use strict;
use warnings;

use Tie::File;

tie my @file, 'Tie::File', 'textfile.txt' or die $!;

my %index;

for (@file) {
  $index{$1}++ if /^(\d+)/;
}

for (my $i = 1; $i < @file; ++$i) {
  if ( $file[$i] =~ /^(\d+)/ and $index{$1} == 1 ) {
    splice @file, $i, 1;
    --$i;
  }
}

Answer 3

my %id_count;
while(my $line = <$DATA>){
    next if $line =~ /^\s*#/; 
    my ($id) = split(/\s+/,$line,1);
    $id_count{$id}{lines} .= $line;
    $id_count{$id}{counter}++;
}

print $OUT join("",map { $id_count{$_}{lines} } grep { $id_count{$_}{counter} ne "1" } keys %id_count);

编辑： 如果要保持行排序，只需在最后一行的grep 之前添加sort。

Answer 4

首先，让我们从你的程序中删除无关的东西。

while (<>) {
   next if /^\s*#/; 
   print;
}

好的，看来您甚至没有额外增加第一列的值。

my ($id) = /^(\S+)/;

在继续阅读之前我们不知道是否会有重复，因此我们需要存储行以供以后使用。

push @{ $by_id{$id} }, $_;

一旦我们通读了文件，我们就会打印出多于一行的 id 行。

for my $id (keys(%by_id)) {
    print @{ $by_id{$id} } if @{ $by_id{$id} } > 1;
}

最后，你没有处理标题，可以使用

print scalar(<>);

总之，我们得到

print scalar(<>);

my %by_id;
while (<>) {
   next if /^\s*#/; 
   my ($id) = /^(\S+)/;
   push @{ $by_id{$id} }, $_;
}

for my $id (sort { $a <=> $b } keys(%by_id)) {
    print @{ $by_id{$id} } if @{ $by_id{$id} } > 1;
}

用法：

script.pl file.in >processed.txt