用于管理 Perl 中非相邻行之间计算的数组数组

Question

我正在处理一些数据以计算样本的平均值，并且当有很大差异时（值超过平均值 +/- 2 个标准偏差），进行插值，但我需要一个强有力的帮助！

困难的部分是选择行，使计算尊重它们所属的样本。 样本标识放在第一列或第二列或第三列（下例中不存在第三列）中的依赖逻辑，不易管理。

我的数据看起来像这样（直接从我的文件中复制和粘贴）。 输入文件也可从https://gofile.io/?c=3PLR8m 获得。 列以制表符分隔，每个标识符在字符前都有一个空格。

ENTITY-CODE     XX  YY  ZZ  AA  BB  CC  att 1
/P1
 ^/A1/S1        143.07  124.05  -159.24 -160.53 0.39    3.31    15
 ^<S2       143.45  123.69  -157.19 -160.74 0.43    1.5 14.8
     +A1/S1 143.87  122.84  -157.08 -147.56 -30.37  3.07    4.9
     ^<S2   152.09  120.29  -155.42 -145.61 -67.13  0.37    3.3
     ^<S3   161.5   120.13  -153.34 -134.92 -73.39  -3.93   3.4
     ^<S4   27.76   122.15  -152.59 -103.01 -74.37  -20 2.9
     ^<S5   179.58  125.71  -153.46 -90.21  -73.6   -21.68  2.8
     ^<S6   189.23  128.85  -152.9  -86.28  -72.54  -19.89  2.4
     ^<S7   196.23  135.77  -152.82 -73.48  -75.22  -19.93  2.1
     ^<S8   195.49  147.85  -150.64 -63.59  -80.44  -32.27  1.5
 ^<S3       143.07  124.1   -157.05 -145.58 -1.81   6.34    16
     +A1/S1 142.03  123.41  -156.23 -72.07  -19.45  -0.4    5.5
     ^<S2   134.29  121.27  -153.31 -76.28  -3.92   -2.37   3.8
     ^<S3   128.55  119.39  -152.31 -73.1   6.95    0.04    2.7
     ^<S4   120.87  115.88  -150.91 -69.62  8.05    0.63    2.7
     ^<S5   115.31  112.83  -151.31 -76.97  7.45    -2.31   2.4
     ^<S6   108.54  110.71  -149.38 -86.09  5.68    -6.48   1.5
 ^<S4       143.49  123.63  -155.79 -175.31 14.3    12.22   13.7
     +A1/S1 143.5   124.75  -155.22 175.69  25.35   25.61   5.9
     ^<S2   145.63  130.57  -156.39 141.67  42.19   31.94   5.3
     ^<S3   153.77  131.23  -153.8  71.9    34.43   20.11   3.6
     ^<S4   160.99  132.18  -149.31 89.71   35.44   14.31   2.6
     ^<S5   166.86  133.6   -146.6  93.88   34.73   11.46   1.8
     +A2/S1 143.63  122.79  -155.05 65.04   4.77    -16.93  3.5
     ^<S6   144.71  122.02  -151.41 56.49   -7.71   -16.1   2.8
     ^<S6   146.83  120.14  -148.52 61.14   24.37   48.58   2.9
     ^<S6   154.06  115.65  -149.29 60.87   20.18   13.8    2.5
 ^<S5       143.32  33.32   -153.16 -127.03 8.59    9.07    12.4
 ^<S6       143.49  121.69  -150.07 -127.26 9.04    10.85   12.5

基本上，在同一列中包含“A”的行后面的标识符的行需要进行计算（连同“A”的行）以检查越界值，因为它们属于同一样本. 如果在同一列中存在另一个包含“A”的标识符，则表示正在启动属于另一个样本的另一组行并需要进行另一次计算。

在我在这里发布的示例中，我想要一个脚本，从第一个^/A1/S1识别第一列中带有标识符的所有行，并检查它们的XX 、 YY和ZZ值。

如果+A1/S1标识符在第二列或其他列中，脚本也应该执行相同的操作。

在实践中，每次有一个包含“A”的标识符意味着开始一个样本，其中其他元素在同一列中具有 S 类型标识符（直到另一个 A 类型标识符）。

S 型标识符中包含的数字不相关。 因此，例如，具有相同标识符的三行（在输入示例的末尾旁边）必须被视为三组单独的值。

输出的格式应该与输入的格式相同，只是插值的差异发生了变化。 插值应包括计算样本的平均值和标准偏差（同一列中具有标识符的行，从标有“A”的行到同一列中具有“A”的另一个标识符之前的最后一个）并检查值是否超过平均值 +/- 2 个标准偏差（ mean±(2*dev.st) ）。 如果是，则用样本均值代替一个值。

在这里的示例中，我想获得相同的输入，除了：第 8 行 (27.76) 中的XX值，应替换为根据相同样本行的XX值计算的平均值，这些值是前一行和下一行（分别具有^<S3和^<S5作为第二列中的标识符）和 (ii) 第 30 行 (33.32) 中的YY值，应替换为在具有^<S4的行上计算的平均值^<S4和^<S6在第一列。

因此，这是我想要的输出。

  ENTITY-CODE       XX  YY  ZZ  AA  BB  CC  att 1
    /P1
     ^/A1/S1        143.07  124.05  -159.24 -160.53 0.39    3.31    15
     ^<S2       143.45  123.69  -157.19 -160.74 0.43    1.5 14.8
         +A1/S1 143.87  122.84  -157.08 -147.56 -30.37  3.07    4.9
         ^<S2   152.09  120.29  -155.42 -145.61 -67.13  0.37    3.3
         ^<S3   161.5   120.13  -153.34 -134.92 -73.39  -3.93   3.4
         ^<S4   173.59  122.15  -152.59 -103.01 -74.37  -20 2.9
         ^<S5   179.58  125.71  -153.46 -90.21  -73.6   -21.68  2.8
         ^<S6   189.23  128.85  -152.9  -86.28  -72.54  -19.89  2.4
         ^<S7   196.23  135.77  -152.82 -73.48  -75.22  -19.93  2.1
         ^<S8   195.49  147.85  -150.64 -63.59  -80.44  -32.27  1.5
     ^<S3       143.07  124.1   -157.05 -145.58 -1.81   6.34    16
         +A1/S1 142.03  123.41  -156.23 -72.07  -19.45  -0.4    5.5
         ^<S2   134.29  121.27  -153.31 -76.28  -3.92   -2.37   3.8
         ^<S3   128.55  119.39  -152.31 -73.1   6.95    0.04    2.7
         ^<S4   120.87  115.88  -150.91 -69.62  8.05    0.63    2.7
         ^<S5   115.31  112.83  -151.31 -76.97  7.45    -2.31   2.4
         ^<S6   108.54  110.71  -149.38 -86.09  5.68    -6.48   1.5
     ^<S4       143.49  123.63  -155.79 -175.31 14.3    12.22   13.7
         +A1/S1 143.5   124.75  -155.22 175.69  25.35   25.61   5.9
         ^<S2   145.63  130.57  -156.39 141.67  42.19   31.94   5.3
         ^<S3   153.77  131.23  -153.8  71.9    34.43   20.11   3.6
         ^<S4   160.99  132.18  -149.31 89.71   35.44   14.31   2.6
         ^<S5   166.86  133.6   -146.6  93.88   34.73   11.46   1.8
         +A2/S1 143.63  122.79  -155.05 65.04   4.77    -16.93  3.5
         ^<S6   144.71  122.02  -151.41 56.49   -7.71   -16.1   2.8
         ^<S6   146.83  120.14  -148.52 61.14   24.37   48.58   2.9
         ^<S6   154.06  115.65  -149.29 60.87   20.18   13.8    2.5
     ^<S5       143.32  123.41  -153.16 -127.03 8.59    9.07    12.4
     ^<S6       143.49  121.69  -150.07 -127.26 9.04    10.85   12.5

它在输入方面只有两个变化：

• 在第 8 行（在第二列中用标识符^<S4标记）中， XX值 27.76 已被从第 5 行到第 12 行的XX值（具有+A1/S1 、 ^<S2 、 ^<S3 , ^<S4 , ^<S5 , ^<S6 , ^<S7 , ^<S8在第二列中作为标识符）；

• 在列30（即标有标识符^<S6中的第一列）的YY值33.32已取代的平均值来计算在所述YY值从行3，4，13，20，30和31（分别标第一列中的标识符为^/A1/S1 、 ^<S2 、 ^<S3 、 ^<S4 、 ^<S5 、 ^<S6 ）。

到目前为止我编写的代码如下。 我想到了数组数组，但我不确定如何设置它。

任何建议都是非常受欢迎的，因为我非常着迷。 谢谢！

open (HAN, "<", "$file") || die "problems with the input file";
    my @lines = ();
    while (<HAN>) { 
    chomp; 
    push(@lines, $_); }
    #print STDERR "@lines\n";

    close (HAN);
    for ($lines[$i] =0; $i<=$#lines; $i++){
        @columns = split (/\t/, $lines[$i]);
                #print STDERR "@columns\n";
    my @p;
    my @s;

    if (( $columns[0] ne "" ) && ( $columns[1] eq "" )){
            push @p, $lines[$i] ;       
                    #print STDERR "@p\n";
        } elsif (( $columns[0] eq "" ) && ( $columns[1] ne "" )){
            push @s, $lines[$i] ;       
                    #print  STDERR "@s\n";
        print STDERR "@s\n";

Answer 1

抱歉，我没有更多时间专门用于此。 也许以下可以帮助您找到正确的方法。

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

use List::Util qw{ sum };

my @data;

while (<>) {
    chomp;
    push @data, [ split /\t/ ];
}

my (@dev_st, @mean);
for my $line_index (0 .. $#data) {
    for my $column (2, 3) {
        for my $level (0, 1) {
            if (($data[$line_index][$level] // "") =~ /A/) {
                my $to = $line_index;
                my $inner_group;
                do { ++$to } until $to > $#data
                             || $level == 1 && $data[$to][0]
                             || (($data[$to][$level] // "") =~ /A/
                                 and $inner_group = 1);
                --$to if $inner_group;

                my @group_data = map $data[$_][2],
                                 grep $data[$_][$level],
                                 $line_index .. $to;
                $mean[$level] = sum(@group_data) / @group_data;
                $dev_st[$level] = sqrt(1/(@group_data - 1) * sum(
                    map { ($_ - $mean[$level]) ** 2 } @group_data));
                # warn "$line_index: @group_data\n$mean[$level] $dev_st[$level]\n";
            }
        }

        my $value = $data[$line_index][$column] // "";
        next unless $value =~ /-?[0-9]+(?:\.[0-9]+)?/;

        my ($level) = grep $data[$line_index][$_], 0, 1;
        if (   $value > $mean[$level] + 2 * $dev_st[$level]
            || $value < $mean[$level] - 2 * $dev_st[$level]
        ) {
            $data[$line_index][$column]
                = sprintf '%.2f', $mean[$level];
        }
    }
    say join "\t", map $_ // "", @{ $data[$line_index] };
}
print "\n";

Answer 2

这是您如何处理它的另一个示例：

package Main;
use feature qw(say);
use strict;
use warnings;

my $self = Main->new( fn => 'in.mtg', save_fn => 'out.mtg');
$self->read_file();
$self->calc_mean();
$self->calc_std();
$self->do_subst();
$self->write_file();
say "Done";

sub do_subst {
    my ( $self ) = @_;

    for my $i (0..2) {
        my $var = $self->{vars}[$i];
        my $mean = $self->{mean}[$i];
        my $std = $self->{std}[$i];
        for my $col_no (0..1) {
            my $col = $self->{col}[$col_no];
            $self->do_subst_col( $col, $var, $mean->[$col_no], $std->[$col_no] );
        }
    }
}

sub do_subst_col {
    my ( $self,  $col, $var, $mean, $std ) = @_;

    my $mean_cur;
    my $std_cur;
    my $k = 0;
    for my $i (0..$#$col) {
        my $id = $col->[$i];
        next if $id !~ /\S/;  # No identifier in this row
        if ( $id =~ /A/ ) {
            $k++ if defined $mean_cur;
            $mean_cur = $mean->[$k];
            $std_cur = $std->[$k];
        }
        if ( ($var->[$i] < ($mean_cur - 2*$std_cur))
             || ($var->[$i] > ($mean_cur + 2*$std_cur)) ) {
            $var->[$i] = $mean_cur;
        }
    }
}

sub calc_std {
    my ( $self ) = @_;

    my @std;
    for my $i (0..2) {
        push @std, $self->calc_std_var( $i );
    }
    $self->{std} = \@std;
}

sub calc_std_var {
    my ( $self,  $i ) = @_;

    my $mean = $self->{mean}[$i];
    my $var = $self->{vars}[$i];
    my @std;
    for my $col_no (0..1) {
        my $col = $self->{col}[$col_no];
        push @std, $self->calc_std_col( $col, $var, $mean->[$col_no] );
    }
    return \@std;
}

sub calc_std_col {
    my ( $self,  $col, $var, $mean ) = @_;

    my @std;
    my $sum;
    my $N;
    my $k = 0;
    my $mean_cur = $mean->[$k];
    for my $i (0..$#$col) {
        my $id = $col->[$i];
        next if $id !~ /\S/;  # No identifier in this row
        if ( $id =~ /A/ ) {
            if (defined $sum) {
                push @std, sqrt($sum/$N);
                $k++;
            }
            $sum = 0; $N = 0;
            $mean_cur = $mean->[$k];
        }
        $sum += ($var->[$i] - $mean_cur)**2;
        $N++;
    }
    push @std, sqrt($sum/$N);
    return \@std;
}

sub calc_mean {
    my ( $self ) = @_;

    my @mean;
    for my $i (0..2) {
        push @mean, $self->calc_mean_var( $i );
    }
    $self->{mean} = \@mean;
}

sub calc_mean_var {
    my ( $self,  $i ) = @_;

    my $var = $self->{vars}[$i];
    my @mean;
    for my $col_no (0..1) {
        my $col = $self->{col}[$col_no];
        push @mean, $self->calc_mean_col( $col, $var );
    }
    return \@mean;
}

sub calc_mean_col {
    my ( $self,  $col, $var ) = @_;

    my @mean;
    my $sum;
    my $N;
    for my $i (0..$#$col) {
        my $id = $col->[$i];
        next if $id !~ /\S/;  # No identifier in this row
        if ( $id =~ /A/ ) {
            push @mean, $sum/$N if defined $sum;
            $sum = 0; $N = 0;
        }
        $sum += $var->[$i];
        $N++;
    }
    push @mean, $sum/$N;
    return \@mean;
}

sub new {
    my ( $class, %args ) = @_;

    my $self = bless \%args, $class;
    return $self;
}

sub read_file {
    my ( $self ) = @_;

    my $fn = $self->{fn};
    open ( my $fh, '<', $fn ) or die "Could not open file '$fn': $!";
    my $line = $self->read_header( $fh );
    my @col1; my @col2; my @xx; my @yy; my @zz; my @rest;
    while (1) {
        chomp $line;
        my @F = split "\t", $line;
        die "Bad file." if @F != 9;
        push @col1, $F[0];
        push @col2, $F[1];
        push @xx, $F[2];
        push @yy, $F[3];
        push @zz, $F[4];
        push @rest, join "\t", @F[5..8];
        $line = <$fh>;
        last if !defined $line;
    }
    close $fh;
    $self->{col} = [\@col1, \@col2];
    $self->{vars} = [\@xx, \@yy, \@zz];
    $self->{rest} = \@rest;
    $self->{N} = scalar @col1;
}

sub read_header {
    my ( $self,  $fh ) = @_;

    my $line;
    my @header;
    while (1) {
        $line = <$fh>;
        die "Bad file." if !defined $line;
        last if $line =~ m{^ \^/A1/S1};
        push @header, $line;
    }
    $self->{header} = \@header;
    return $line;
}

sub write_file {
    my ( $self ) = @_;

    my $fn = $self->{save_fn};
    open ( my $fh, '>', $fn ) or die "Could not open file '$fn': $!";
    print {$fh} join "", @{ $self->{header} };
    my $N = $self->{N};
    my $col1 = $self->{col}[0];
    my $col2 = $self->{col}[1];
    my $xx = $self->{vars}[0];
    my $yy = $self->{vars}[1];
    my $zz = $self->{vars}[2];
    my $rest = $self->{rest};
    for my $i (0..($N - 1)) {
        say {$fh} join "\t", $col1->[$i], $col2->[$i], $xx->[$i],
          $yy->[$i], $zz->[$i], $rest->[$i];
    }
    close $fh;
}