如何删除数据文件中每组列的第一个子集？

debugcn 发表于 Dev

扎拉

我有一个超过40000列的数据文件。在标题中，每列的名称均以C1，c2，...，cn开头，每组c具有一个或多个子集，例如c1。有2个子集。我需要删除每组c的第一列（子集）。例如，如果输入看起来像：

输入：

    c1.20022  c1.31012  c2.44444  c2.87634  c2.22233 c3.00444  c3.44444 
     1    1         0         1         0         0         0         1     
     2    0         1         0         0         1         0         1     
     3    0         1         0         0         1         1         0     
     4    1         0         1         0         0         1         0     
     5    1         0         1         0         0         1         0     
     6    1         0         1         0         0         1         0

我需要的输出是这样的：

    c1.31012  c2.87634  c2.22233  c3.44444 
     1    0         0         0         1     
     2    1         0         1         1     
     3    1         0         1         0     
     4    0         0         0         0     
     5    0         0         0         0     
     6    0         0         0         0     
     7    1         0         0         0

有什么建议吗？

更新：如果行中的数字之间没有空格（这是我的数据集的实际情况），那我该怎么办？我的意思是我的真实数据如下所示：输入：

c1.20022  c1.31012  c2.44444  c2.87634  c2.22233 c3.00444  c3.44444 
         1    1010001     
         2    0100101     
         3    0100110     
         4    1010010     
         5    1010010     
         6    1010010

并输出：

c1.31012  c2.87634  c2.22233  c3.44444 
         1    0001     
         2    1011     
         3    1010     
         4    0000     
         5    0000     
         6    0000     
         7    1000

疾病

Perl解决方案：首先读取标题行，使用正则表达式在点之前提取列名称，并保留要保留的列号列表。然后，它使用索引从标题和其余行仅打印所需的列。

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my @header = split ' ', <>;
my $last = q();
my @keep;
for my $i (0 .. $#header) {
    my ($prefix) = $header[$i] =~ /(.*)\./;
    if ($prefix eq $last) {
        push @keep, $i + 1;
    }
    $last = $prefix;
}
unshift @header, q();
say join "\t", @header[@keep];

while (<>) {
    my @columns = split;
    say join "\t", @columns[@keep];
}

更新：

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my @header = split ' ', <>;
my $last = q();
my @keep;
for my $i (0 .. $#header) {
    my ($prefix) = $header[$i] =~ /(.*)\./;
    if ($prefix eq $last) {
        push @keep, $i;
    }
    $last = $prefix;
}
say join "\t", @header[@keep];

while (<>) {
    my ($line_number, $all_digits) = split;
    my @digits = split //, $all_digits;
    say join "\t", $line_number, join q(), @digits[@keep];
}

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。