求助：perl求关键字相同行的均值[已解决]

流星北

用perl解决。
有一个文本数据集，在excel中通过排序后发现，行首的关键字，有的行有重复，希望求有重复关键字行的均值，在文件中没有重复关键字的行按原样输出，有重复关键字的行，只输出均值一行。
CA6        1       2      3       4      5       
CA7        2       5      3       2      1
CA8        2       8      6       3      2                       
CA8        3       4      4       1      5               
CA9        5       8       7      6      1       
希望能得到：
CA6        1       2      3       4      5       
CA7        2       5      3       2      1
CA8        2.5    6      5       2      3.5       
CA9        5       8       7      6      1

每一行除了行首的关键字，有78个值。关键字大部分是唯一的，一个关键字对应一行数据，重复关键字的，行数量不一定。
请各位高手指点，在此谢过大家！

兰花仙子

恩。。but,,,,, what's your code so far?

黑色阳光_cu

1. 
   
2. #!/bin/env perl
   
3. 
   
4. use strict;
   
5. use warnings;
   
6. 
   
7. my @lines;
   
8. my @stack;
   
9. my $keyword;
   
10. my $sp = " " x 8;
    
11. 
    
12. foreach $_ (sort { &filter($a, $b) } <DATA>)
    
13. {
    
14.         my @fields = split(/\s+/, $_);
    
15.         $keyword = $fields[0] if (not defined $keyword);
    
16.         if ($keyword ne $fields[0])
    
17.         {
    
18.                 push(@lines, &average());
    
19.                 @stack = (\@fields);
    
20.                 $keyword = $fields[0];
    
21.         }
    
22.         else
    
23.         {
    
24.                 push(@stack, \@fields);
    
25.         }
    
26. }
    
27. 
    
28. push(@lines, &average());
    
29. die join("\n", @lines), "\n";
    
30. 
    
31. sub filter
    
32. {
    
33.         return (split(/\s+/, $_[0]))[0] cmp (split(/\s+/, $_[1]))[0];
    
34. }
    
35. 
    
36. sub average()
    
37. {
    
38.         my $result;
    
39.         for (my $n = 1; $n <= $#stack; $n++)
    
40.         {
    
41.                 for (my $nn = 1; $nn <= $#{$stack[$n]}; $nn++)
    
42.                 {
    
43.                         $stack[0]->[$nn] += $stack[$n]->[$nn];
    
44.                 }
    
45.         }
    
46. 
    
47.         for (my $nn = 1; $nn <= $#{$stack[0]}; $nn++)
    
48.         {
    
49.                 $stack[0]->[$nn] /= $#stack + 1;
    
50.         }
    
51. 
    
52.         $result = join($sp, @{$stack[0]});
    
53.         @stack = ();
    
54.         return $result;
    
55. }
    
56. 
    
57. __DATA__
    
58. CA6        1       2      3       4      5      
    
59. CA7        2       5      3       2      1
    
60. CA8        2       8      6       3      2                       
    
61. CA8        3       4      4       1      5               
    
62. CA9        5       8       7      6      1   
    

复制代码

wfnh

呵呵··看见带妹了··

toniz

黑色阳光_cu

toniz 发表于 2010-03-19 09:44

1. use strict;
   
2. use Data::Dumper;
   
3. 
   
4. my %data;
   
5. while(<DATA>){
   
6.     s/\s+$//g;
   
7.     s/ +/\t/g;
   
8.     my @dtmp = split /\t/,$_;
   
9.     my $key = shift @dtmp;
   
10.     if (exists $data{$key}){            
    
11.         $data{$key}=[map{($dtmp[$_]+${$data{$key}}[$_])/2}0..(@dtmp-1)];
    
12.     }else{
    
13.         $data{$key}=\@dtmp;
    
14.     }   
    
15. }
    
16. 
    
17. foreach my $key(sort keys %data){
    
18.     print $key," "x8,join " "x8,@{$data{$key}},"\n";
    
19. }
    
20. 
    
21. 
    
22. __DATA__
    
23. CA6        1       2      3       4      5        
    
24. CA7        2       5      3       2      1
    
25. CA8        2       8      6       3      2                        
    
26. CA8        3       4      4       1      5               
    
27. CA9        5       8       7      6      1

复制代码

流星北

黑色阳光_cu 发表于 2010-03-18 22:51

    谢谢大哥的回复，程序在示例数据上面运行得很好。但是文本数据太大，我希望通过文件操作来处理，我自己加入了文件打开，文件读取，文件写入命令，出来的结果文件不对。附件里面是我的部分数据。请看看这个怎么解决。

黑色阳光_cu

把 foreach $_ (sort { &filter($a, $b) } <DATA>)
改为 while ($_ = <FILE>)

前提是文件是排序过的

试试

toniz

那个有BUG  我编辑了 呵呵

1. use strict;
   
2. use Data::Dumper;
   
3. 
   
4. my %data;
   
5. while(<DATA>){
   
6.                 s/\s+$//g;
   
7.                 s/ +/\t/g;
   
8.                 my @dtmp = split /\t/,$_;
   
9.                 my $key = shift @dtmp;
   
10.                 if (exists $data{$key}){                       
    
11.                                 $data{$key}->{'data'}=[map {$dtmp[$_]+${$data{$key}->{'data'}}[$_]}0..(@dtmp-1)];
    
12.                                 $data{$key}->{'count'}+=1;
    
13.                 }else{
    
14.                                 $data{$key}->{'data'}=\@dtmp;
    
15.                                 $data{$key}->{'count'} =1;
    
16.                 }               
    
17. }
    
18. 
    
19. foreach my $key(sort keys %data){
    
20.                 my @tmp = map {$_/$data{$key}->{'count'}}@{$data{$key}->{'data'}};
    
21.                 print $key," "x8,join " "x8,@tmp ,"\n";
    
22. }
    
23. 
    
24. 
    
25. __DATA__
    
26. CA6        1       2      3       4      5        
    
27. CA7        2       5      3       2      1
    
28. CA8        2       8      6       3      2                        
    
29. CA8        3       4      4       1      5               
    
30. CA9        5       8       7      6      1

复制代码

黑色阳光_cu

你的代码比我少多了