如何使用 PERL 匹配列和计算百分比

Question

我有这样的数据

pop A   B   C   D   E
P1  T/T C/C C/C T/T C/C
P2  A/A G/G C/C T/T C/C
1   A/A G/G C/C T/T C/C
2   A/A G/G C/C T/T C/C
3   A/T A/C A/G A/T A/C
4   T/A T/G T/C T/A T/G
5   G/A G/T G/C G/A G/T
6   C/A C/T C/G C/A C/T
pop A   B   C   D   E
P1  T/T C/C C/C T/T C/C
P2  A/A G/G C/C T/T C/C
1   A/A G/G C/C T/T C/C
2   A/A G/G C/C T/T C/C
3   A/T A/C A/G A/T A/C
4   T/A T/G T/C T/A T/G
5   G/A G/T G/C G/A G/T
6   C/A C/T C/G C/A C/T

我想对我的数据做以下事情

1. 我想将所有A/A 转换为A，T/T 转换为T，C/C 转换为C，G/G 转换为G，Z/Z 转换为@39和 -/- 到 - 和其余字符，如 A/T,G/T,C/G,T/C 到 H

2. 现在我想通过比较P1 和P2 来了解从A 到E 的状态，如果P1=P2 然后从A 到E 的状态是单声道或任何一个P1 或P2 包含Z/Z 或-/- 然后从A 到E 的状态是单声道，从A 到E 的状态是多边形

3. 如果pop 列中的 1 与 pop 列中的 p2 匹配，我想将 pop 列中的 1 与 A 到 E 的弹出列中的 P2 匹配它的状态只有 poly 然后我想给 1 否则，如果它是 mono 我不想做任何事情。

4. 现在我将计算# 1s 和# H's

5. 最后我会用这个公式=((#1*2+#H)/((#1+#H)*2))*100计算%sim。

6. 我想对第二组父母 P1 和 P2 重复相同的过程

预计会是这样的

pop A   B   C   D   E   A   B   C   D   E           
P1  POLY    POLY    MONO    MONO    MONO    POLY    POLY    MONO    MONO    MONO    #1's    #H's    %sim
P2  A   G   C   T   C                               
1   A   G   C   T   C   1   1   C   T   C   2   0   100
2   A   G   C   T   C   1   1   C   T   C   2   0   100
3   A   G   C   -   C   H   H   H   H   H   0   5   100
4   H   H   H   H   H   H   H   H   H   H   0   5   50
5   H   H   H   H   H   H   H   H   H   H   0   5   50
6   H   H   H   H   H   H   H   H   H   H   0   5   50
7   H   H   H   H   H   H   H   H   H   H   0   5   50

现在我成功到了第一步，但不知道如何继续，这是我到目前为止尝试的代码

#!/usr/bin/perl -w
use strict;
open(FILE, "<input.txt") || die "File not found";
my @lines = <FILE>;
my @newlines;
foreach(@lines) {
   $_ =~ s/AA/A/g;
   $_ =~ s/TT/T/g;
   $_ =~ s/GG/G/g;
   $_ =~ s/CC/C/g;
   $_ =~ s/AT/H/g;
   $_ =~ s/AG/H/g;
   $_ =~ s/AC/H/g;
   $_ =~ s/TA/H/g;
   $_ =~ s/TG/H/g;
   $_ =~ s/TC/H/g;
   $_ =~ s/GA/H/g;
   $_ =~ s/GT/H/g;
   $_ =~ s/GC/H/g;
   $_ =~ s/CA/H/g;
   $_ =~ s/CT/H/g;
   $_ =~ s/CG/H/g;
   $_ =~ s/ZZ/-/g;

   push(@newlines,$_);
}
open(FILE, ">input1.txt") || die "File not found";
print FILE @newlines;
close(FILE);

Answer 1

这会进行替换并创建前两行。我不明白规范的其余部分（第 7 行来自哪里？）

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

use Data::Dumper;


*ARGV = *DATA{IO} unless @ARGV;

my (@parents, @rows);

sub {
    my $header = <>;
    push @parents, map [ split ' ', <> ], 1, 2;
    push @rows,    map [ split ' ', <> ], 1 .. 6;
}->() for 1, 2;

for (map @$_, @parents, @rows) {
    s= ([ACTG]) / \1 =$1=x;
    s= ([-Z])   / \1 =-=x;
    s= .        / .  =H=x;
}

say join "\t", 'pop', ('A' .. 'E') x 2;

print 'P1';
for my $parent (0, 1) {
    print join "\t", q(), map {
        my $p1 = $parents[ $parent * 2 ][$_];
        my $p2 = $parents[ 1 + $parent * 2 ][$_];
        ($p1 eq $p2 or '-' eq $p1 or '-' eq $p2) ? 'mono' : 'poly';
    } 1 .. 5;
}
print "\n";


__DATA__
pop A   B   C   D   E
P1  T/T C/C C/C T/T C/C
P2  A/A G/G C/C T/T C/C
1   A/A G/G C/C T/T C/C
2   A/A G/G C/C T/T C/C
3   A/T A/C A/G A/T A/C
4   T/A T/G T/C T/A T/G
5   G/A G/T G/C G/A G/T
6   C/A C/T C/G C/A C/T
pop A   B   C   D   E
P1  T/T C/C C/C T/T C/C
P2  A/A G/G C/C T/T C/C
1   A/A G/G C/C T/T C/C
2   A/A G/G C/C T/T C/C
3   A/T A/C A/G A/T A/C
4   T/A T/G T/C T/A T/G
5   G/A G/T G/C G/A G/T
6   C/A C/T C/G C/A C/T