Arrays 用Perl处理多行

我有几百行的表格文件

1st  2n  2p  3n  3p  4n  4p
1ABJa  2  20  8  40  3  45
1ABJb  2  40  8  80  3  45
2C3Da  4  50  5  39  2  90
2D4Da  1  10  8  90  8  65

（制表符分隔文件）

从这个文件中，我想处理第一列中具有类似4个开头字符的所有行（即1ABJa和1ABJb），并执行以下操作：

• 对于第1列，合并保留公共字符的两个名称
• 对于

  2n、3n、4n…

  列，数字将被求和
• 对于

  2p、3p、4p，…

  列，数字将平均

（请注意，这可以由列位置而不是名称指定）。 这将产生：

1st  2n  2p  3n  3p  4n  4p
1ABJab  4  30  16  60  6  45       
2C3Da  4  50  5  39  2  90
2D4Da  1  10  8  90  8  65

你将如何解决这个问题

这可能是实现这一点最复杂的方法，但这里是：我正在考虑创建一个包含第1列中所有4个字符的唯一元素的数组。然后，对于该数组，运行一个循环，查找与这4个字符匹配的所有实例。如果有多个实例，请标识它们、推送列并操纵它们。这是我到目前为止的观点：

#!/usr/local/bin/perl
use strict;
use warnings;
use feature 'say';
use List::MoreUtils qw(uniq);

my $dir='My\\Path\\To\\Directory';
open my $in,"<", "$dir\\my file.txt" or die;
my @uniqarray; my @lines;

#collects unique elements in 1st column and changes them to 4-character words
while (my $line = <$in>) {
    chomp $line;
    @lines= split '\t', $line;
    if (!grep /$lines[0]/, @uniqarray ){
        $lines[0] =~ s/^(.{4}).*/$1/;
        push @uniqarray,$lines[0];
    }
}

my @l;
#for @uniqarray, find all rows in the input that match them. if more than 1 row is found, manipulate the columns
while (my $something=<$in>) {
    chomp $something;
    @l= split '\t', $something;
    if ( map $something =~ m/$_/,@uniqarray){
        **[DO STUFF]**
    }
}

print join "\n", uniq(@uniqarray);

close $in;

#/usr/local/bin/perl
严格使用；
使用警告；
使用特征“说”；
使用列表：：MoreUtils qw（uniq）；
my$dir='my\\Path\\To\\Directory'；
打开我的$in，“怎么样：

my $result;
my $head = <DATA>;
while(<DATA>) {
    chomp;
    my @l = split/\s+/;
    my ($k1,$k2) = ($l[0] =~ /^(....)(.*)$/);
    $result->{$k1}{more} .= $k2 // '';
    $result->{$k1}{nbr}++;

    ;
    $result->{$k1}{n}{2} += $l[1];
    $result->{$k1}{n}{3} += $l[3];
    $result->{$k1}{n}{4} += $l[5];
    $result->{$k1}{p}{2} += $l[2];
    $result->{$k1}{p}{3} += $l[4];
    $result->{$k1}{p}{4} += $l[6];
}

print $head;
foreach my $k (keys %$result) {
    print $k,$result->{$k}{more},"\t";
    for my $c (2,3,4) {
        printf("%d\t",$result->{$k}{n}{$c});
        if (exists($result->{$k}{nbr}) && $result->{$k}{nbr} != 0) {
            printf("%d\t",$result->{$k}{p}{$c}/$result->{$k}{nbr});
        } else {
            printf("%d\t",0);
        }
    }
    print "\n";
}

这似乎满足了您的需要。它在散列中为每个不同的四字符前缀保留了一组数据：在key
n
下具有相同前缀的记录数，在key
totals
下保存该前缀的列总计的数组，以及在key
suf下包含该前缀的所有后缀的散列修复

第一次看到前缀时，会将其添加到数组
@Prefixes
，以便输出可以与输入以相同的顺序显示

只需将
总计
数组的所有偶数列除以
n
，然后累积数据并以所需格式转储即可

use strict;
use warnings;

open my $fh, '<', 'data.txt' or die $!;

print scalar <$fh>; # Copy header

my %data;
my @prefixes;

while (<$fh>) {
  chomp;
  my @fields = split /\t/;
  my ($prefix, $suffix) = shift(@fields) =~ /(.{4})(.*)/;
  push @prefixes, $prefix unless $data{$prefix};
  ++$data{$prefix}{n};
  ++$data{$prefix}{suffixes}{$suffix};
  $data{$prefix}{totals}[$_] += $fields[$_] for 0 .. $#fields;
}

for my $prefix (@prefixes) {
  my $val      = $data{$prefix};
  my $totals   = $val->{totals};
  for (my $i = 1; $i < @$totals; $i += 2) {
    $totals->[$i] /= $val->{n};
  }
  my $suffixes = join '', sort keys %{ $val->{suffixes} };
  print join("\t", "$prefix$suffixes", @$totals), "\n";
}

在您的示例输出中，为什么第一行是
1ABJab
？您还没有指定规则，因此它似乎同样可以是
1ABJa
。我给它命名为
1ABJab
，因为它包含来自
1ABJa
和
1ABJb
的数据，我想将其与其他行区分开来。我将为它添加规则这个。谢谢！唯一困难的部分是把最终结果放在一起，因为
yeild的
看起来像是在事后，结果与未分析的行合并。别担心，我读得太快了……我想你只使用了其中一行的名称（例如
1ABJb
），不是一个组合。
'D:\'
是不正确的代码，反斜杠将跳出你的结束引号。这在上面的降价格式中非常明显。ehh实际上它让我想起了你在线程中的答案！我仍然需要掌握这些哈希引用的诀窍。只有几个问题（如果更简单的话，请将我重定向到文档中，我正在尝试学习）：1.
$result->{$k1}{n}{2}
的意思是
$result->{$k1}
？2.你能对你给出的名字做些什么（即
n
或
2
）@Sosi：我不明白。你为什么认为
$result->{$k1}{n}{2}
与
$result->{$k1}
相同，用作散列键的值、
$k1
、
n
和
2
都是简单的字符串。类似于
n
的单字在作为散列键出现时会被隐式引用。您可以对它们执行任何可以对字符串执行的操作。@M42:OP's对于第2n、3n、4n列……将对数字进行求和"对我来说，这意味着可能有超过表中显示的六列数据example@Borodin：是的，我想你是对的，但我把剩下的留作练习。他只需要用一些循环来重新组织。@Borodin的确，我用了大约40列。但我会看看是否可以从M42做的扩展。哇，这真是太棒了！我需要一个好东西d看看你明天使用的那些数组引用！谢谢，现在我知道了！谢谢你的帮助！即使在我的真实案例中，它也能完美地工作
+$data{$prefix}{n}
也可以是
$data{$prefix}{n}++
，或者在创建散列值时，您需要先将其递增吗？我知道
->
的运算符优先级高于
++
，所以这两种方法都是等效的，对吗？@Sosi:是的，这两种方法是等效的。人们在默认情况下使用postfix
$x++
的唯一原因是因为E语言C++。有一些语言可以做额外的工作，即使不使用前增量值，也可以逆转这个习惯。
use strict;
use warnings;

open my $fh, '<', 'data.txt' or die $!;

print scalar <$fh>; # Copy header

my %data;
my @prefixes;

while (<$fh>) {
  chomp;
  my @fields = split /\t/;
  my ($prefix, $suffix) = shift(@fields) =~ /(.{4})(.*)/;
  push @prefixes, $prefix unless $data{$prefix};
  ++$data{$prefix}{n};
  ++$data{$prefix}{suffixes}{$suffix};
  $data{$prefix}{totals}[$_] += $fields[$_] for 0 .. $#fields;
}

for my $prefix (@prefixes) {
  my $val      = $data{$prefix};
  my $totals   = $val->{totals};
  for (my $i = 1; $i < @$totals; $i += 2) {
    $totals->[$i] /= $val->{n};
  }
  my $suffixes = join '', sort keys %{ $val->{suffixes} };
  print join("\t", "$prefix$suffixes", @$totals), "\n";
}

1st     2n  2p  3n  3p  4n  4p
1ABJab  4   30  16  60  6   45
2C3Da   4   50  5   39  2   90
2D4Da   1   10  8   90  8   65