Массив для управления вычислениями между несмежными строками в Perl

Question

Я работаю с некоторыми данными, чтобы рассчитать среднее значение по выборкам и, если есть большая разница (значения по среднему +/- 2 стандартных отклонения), выполнить интерполяцию, но мне нужна сильная помощь!

Сложной задачей является выбор строк, для которых при расчете учитывается образец, которому они принадлежат. Идентификатор образца помещается в первый, второй или третий столбец (третий столбец отсутствует в приведенном ниже примере) в логике зависимостей c, которой нелегко управлять.

Мои данные выглядят так (напрямую скопировано и вставлено из моего файла). Входной файл также доступен в 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» в одном и том же столбце, должны в go вычислении (вместе со строкой «A») проверить наличие значения, поскольку они принадлежат одному и тому же образцу. Если в том же столбце есть другой идентификатор, содержащий «A», это означает, что он запускает другую группу строк, принадлежащих другому образцу и нуждающихся в go при другом вычислении.

В примере, который я опубликовать здесь я хотел бы сценарий, который, начиная с первого ^/A1/S1, распознает все строки с идентификатором в первом столбце и делает проверку на значения XX, YY и ZZ, которые они имеют.

Сценарий должен делать то же самое, если идентификатор +A1/S1 находится во втором или других столбцах.

На практике каждый раз, когда существует идентификатор, содержащий "A", означает, что он запускается образец, у которых у последующих элементов есть идентификаторы S-типа в том же столбце (до другого идентификатора A-типа).

Число, включенное в идентификатор S-типа, не имеет значения. Поэтому, например, три строки с одинаковым идентификатором (рядом с концом входного примера) должны рассматриваться как три отдельных набора значений.

Формат вывода должен быть таким же, как и у вход с единственной разницей измененных интерполированных значений. Интерполяция должна состоять в вычислении среднего значения и стандартного отклонения по выборке (строки с идентификатором в том же столбце, от одного, отмеченного «A» до последнего перед другим идентификатором в том же столбце, имеющему «A») и проверка, превышает ли значение среднее значение +/- 2 стандартных отклонения (mean±(2*dev.st)). Если это так, то значение заменяется средним значением выборки.

В приведенном здесь примере я хотел бы получить то же входное значение, за исключением: значение XX в восьмой строке (27,76), которое должно заменить на среднее значение, рассчитанное для значений XX из строк того же образца, которые являются предыдущими и следующими строками (которые имеют ^<S3 и ^<S5 соответственно в качестве идентификаторов во втором столбце) и (ii) YY значение в тридцатой строке (33.32), которое следует заменить на среднее значение, рассчитанное для строки, в первом столбце которой есть ^<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 во втором столбце) the * Значение 1046 * 27,76 было заменено средним значением, вычисленным по значениям XX в строках с 5 по 12 (которые имеют +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;
}