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

时间:2013-03-23 20:59:08

标签: perl

我正在对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 个答案:

答案 0 :(得分:2)

大部分是从池上和马坦被盗的:

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 $_;
   }
}

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

<强>随后:

经过三思而后行

  是的,他们[行]应该保持现在的相同,这是数字的   订单[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());

答案 1 :(得分: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;
  }
}

答案 2 :(得分: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);

编辑: 如果您想对线条进行排序,只需在最后一行的sort之前添加grep

答案 3 :(得分: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