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

主に池上とマットンから盗まれました：

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

ただし、順序を維持し、ループを1つだけ使用します。

後で：

二度考えた後

はい、それら[行]は現在と同じままである必要があります。これは[IDの]番号順になっています。

痛い商品をお返しすることができます：

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実行されます。これにより、配列をテキストファイルにマップできるため、配列から要素を削除すると、ファイルから行も削除されます。

このプログラムは、ファイルを2回通過します。1回目は最初のフィールドの各値の出現回数をカウントし、2回目はそのフィールドがファイル内で一意である行を削除します。

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);

編集：行を並べ替えたままにする場合は、最後の行のsort前にaを追加します。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 に答える