0

我正在对 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 列中具有唯一值的所有行。

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

4

4 回答 4

2

大部分是从 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 $_;
   }
}

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

之后：

经过三思而后行

是的，它们 [the lines] 应该与现在保持一致，即 [of 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());
于 2013-03-23T22:15:36.460 回答
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;
  }
}
于 2013-03-23T22:35:11.130 回答
1 
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);

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

于 2013-03-23T21:22:08.863 回答
0

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

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
于 2013-03-23T21:17:41.060 回答