<p>我没有像TLP那样使用Text::CSV。如果你需要的话,你可以,但是在这个例子中,我想因为字段中没有嵌入逗号,所以我对','做了一个简单的拆分。另外,两个运算符的真字段都列出来了(而不是1),因为我认为最后一个值的特殊情况会使解决方案复杂化。在</p>
<pre><code>#!/usr/bin/perl
use strict;
use warnings;
use List::MoreUtils qw/ mesh /;
my %data;
while (<DATA>) {
chomp;
my ($id, $op, @vals) = split /,/;
$data{$id}{$op} = \@vals;
}
my @ops = ([qw/J1 J2/], [qw/S1 S2/], [qw/J1 S1/]);
for my $id (sort keys %data) {
for my $comb (@ops) {
open my $fh, ">>", "@$comb.txt" or die $!;
my $a1 = $data{$id}{ $comb->[0] };
my $a2 = $data{$id}{ $comb->[1] };
print $fh join(",", $id, mesh(@$a1, @$a2)), "\n";
close $fh or die $!;
}
}
__DATA__
WCBP12236,J1,75.7,80.6,65.9,83.2,82.1
WCBP12236,J2,76.3,79.6,61.7,81.9,82.1
WCBP12236,S1,77.2,81.5,69.4,84.1,82.1
WCBP12236,S2,68.0,68.0,53.2,68.5,82.1
WCBP12234,J1,63.7,67.7,72.2,71.6,75.3
WCBP12234,J2,68.6,68.4,41.4,68.9,75.3
WCBP12234,S1,81.8,82.7,67.0,87.5,75.3
WCBP12234,S2,66.6,67.9,53.0,70.7,75.3
WCBP12239,J1,78.6,79.0,56.2,82.1,82.1
WCBP12239,J2,66.6,72.9,79.5,76.6,82.1
WCBP12239,S1,86.6,87.8,23.0,23.0,82.1
WCBP12239,S2,86.0,86.9,62.3,89.7,82.1
WCBP12238,J1,70.9,71.3,66.0,73.7,84.1
WCBP12238,J2,75.1,75.2,54.3,76.4,84.1
WCBP12238,S1,65.9,66.0,40.2,66.5,84.1
WCBP12238,S2,72.7,73.2,52.6,73.9,84.1
</code></pre>
<p>产生的输出文件如下</p>
<p>J1 J2.txt</p>
^{pr2}$
<p>S1 S2.txt</p>
<pre><code>WCBP12234,81.8,66.6,82.7,67.9,67.0,53.0,87.5,70.7,75.3,75.3
WCBP12236,77.2,68.0,81.5,68.0,69.4,53.2,84.1,68.5,82.1,82.1
WCBP12238,65.9,72.7,66.0,73.2,40.2,52.6,66.5,73.9,84.1,84.1
WCBP12239,86.6,86.0,87.8,86.9,23.0,62.3,23.0,89.7,82.1,82.1
</code></pre>
<p>J1 S1.txt</p>
<pre><code>WCBP12234,63.7,81.8,67.7,82.7,72.2,67.0,71.6,87.5,75.3,75.3
WCBP12236,75.7,77.2,80.6,81.5,65.9,69.4,83.2,84.1,82.1,82.1
WCBP12238,70.9,65.9,71.3,66.0,66.0,40.2,73.7,66.5,84.1,84.1
WCBP12239,78.6,86.6,79.0,87.8,56.2,23.0,82.1,23.0,82.1,82.1
</code></pre>
<p><strong>更新:</strong>为了只得到1个真值,for循环可以这样写:</p>
<pre><code>for my $id (sort keys %data) {
for my $comb (@ops) {
local $" = '';
open my $fh, ">>", "@$comb.txt" or die $!;
my $a1 = $data{$id}{ $comb->[0] };
my $a2 = $data{$id}{ $comb->[1] };
pop @$a2;
my @mesh = grep defined, mesh(@$a1, @$a2);
print $fh join(",", $id, @mesh), "\n";
close $fh or die $!;
}
}
</code></pre>
<p>更新:为grep expr中的测试添加了“defined”。因为这是正确的方法(而不是仅仅测试'$\',它可能是0并且被grep错误地排除在列表之外)。在</p>