[已解決,謝謝各位]請(qǐng)問如何用perl求行名相同列的平均值（含有很多列），謝謝

baiguihuajl

請(qǐng)問如何求行名相同列的平均值（含有很多列），謝謝
比如文件1.txt
a        2        3        1        3        2        2
s        2        2        1        1        2        3
s        1        2        3        1        2        2
f        3        7        2        1        2        1
v        2        1        3        2        2        1
t        2        2        2        2        1        3
b        3        2        2        1        5        2
g        1        3        1        2        1        2
r        2        1        1        1        1        1
t        2        2        1        3        2        3
a        2        3        3        5        2        4
f        3        1        2        2        5        2
s        1        1        4        9        2        5
相同行名的列求平均的話就會(huì)得到2.txt：
a        2        3        2        4        2        3
s        1.33        1.67        2.67        3.67        2        3.33
f        3        4        2        1.5        3.5        1.5
v        2        1        3        2        2        1
t        2        2        1.5        2.5        1.5        3
b        3        2        2        1        5        2
g        1        3        1        2        1        2
r        2        1        1        1        1        1

b114213903

1. #!/usr/bin/perl
   
2. use strict;
   
3. use Data::Dumper;
   
4. 
   
5. my $data={};        #用來保存數(shù)據(jù)
   
6. my $num={};                #用來保存出現(xiàn)次數(shù)
   
7. my @keys=();        #用來記錄出現(xiàn)順序
   
8. while(my $line=<DATA>){
   
9.         my ($key,@values)=split /\s+/,$line;
   
10.         if($data->{$key}){
    
11.                 $num->{$key}++;
    
12.                 my $val_num=scalar @{$data->{$key}};
    
13.                 for (my $i=0;$i<$val_num;$i++){
    
14.                         $data->{$key}->[$i]+=$values[$i];
    
15.                 }
    
16.         }else{
    
17.                 $data->{$key}=\@values;
    
18.                 $num->{$key}++;
    
19.                 push @keys,$key;
    
20.         }
    
21. }
    
22. 
    
23. foreach my $key(@keys){
    
24.         my $val_num=scalar @{$data->{$key}};
    
25.         print "$key\t";
    
26.         for (my $i=0;$i<$val_num;$i++){
    
27.                 my $val= ($data->{$key}->[$i]) / ($num->{$key});        #依據(jù)次數(shù)計(jì)算平均值
    
28.                 my $mod=($data->{$key}->[$i]) % ($num->{$key});                #判斷是否整除
    
29.                 if($mod){
    
30.                         printf "%-.2f\t",$val;
    
31.                 }else{
    
32.                         print "$val\t";
    
33.                 }
    
34.         }
    
35.         print "\n";
    
36. }
    
37. 
    
38. __DATA__
    
39. a        2        3        1        3        2        2
    
40. s        2        2        1        1        2        3
    
41. s        1        2        3        1        2        2
    
42. f        3        7        2        1        2        1
    
43. v        2        1        3        2        2        1
    
44. t        2        2        2        2        1        3
    
45. b        3        2        2        1        5        2
    
46. g        1        3        1        2        1        2
    
47. r        2        1        1        1        1        1
    
48. t        2        2        1        3        2        3
    
49. a        2        3        3        5        2        4
    
50. f        3        1        2        2        5        2
    
51. s        1        1        4        9        2        5

復(fù)制代碼

sunzhiguolu

試下:

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use warnings;
   
5. 
   
6. my %h_keys;
   
7. while (<>){
   
8.    chomp;
   
9.    my @a_line = split /\s+/;
   
10.    my $id = shift @a_line;
    
11.    if (exists $h_keys{$id}){
    
12.       $h_keys{$id} .= ';' . "@a_line";
    
13.    }else{
    
14.       $h_keys{$id} = "@a_line";
    
15.    }   
    
16. }
    
17. 
    
18. while (my ($id, $numbers) = each %h_keys){
    
19.    my $cnt_rows = my @a_lines = split (/;/, $numbers);
    
20.    if ($cnt_rows == 1){
    
21.       print "$id $numbers\n";
    
22.    }else{
    
23.       print "$id";
    
24.       my $cnt_cols = my @a_numbers = split /\s+/,(shift @a_lines);
    
25.       foreach (@a_lines){
    
26.          my @a_other_numbers = split /\s+/;
    
27.          for (my $i = 0; $i < $cnt_cols; $i++){
    
28.             $a_numbers[$i] += $a_other_numbers[$i];
    
29.          }   
    
30.       }   
    
31.       for (my $i = 0; $i < $cnt_cols; $i++){
    
32.          my $value = $a_numbers[$i];
    
33.          $value % $cnt_rows == 0 ? printf " %d", $value / $cnt_rows : printf " %.2f", $value / $cnt_rows;
    
34.       }   
    
35.       print "\n";
    
36.    }   
    
37. }
    

復(fù)制代碼

1. 
   
2. perl abc.pl 1.txt > 2.txt
   

復(fù)制代碼

MMMIX

這種寫法是不是太復(fù)雜？

#!/usr/bin/perl

use strict;
use warnings;

use v5.14;
use List::MoreUtils qw(pairwise);

my %rec;
while (<DATA>) {
  chomp;
  my ($key, @vals) = split;
  if ($rec{$key}) {
    $rec{$key} = [ pairwise { [ ++($a->[0]), $a->[1] += $b ] } @{ $rec{$key} }, @vals ];
  }
  else {
    $rec{$key} = [ map [1, $_], @vals ];
  }
}

while (my ($key, $vals) = each %rec) {
  say join "\t", ($key, map { $_->[1] / $_->[0] } @$vals);
}

__DATA__
a        2        3        1        3        2        2
s        2        2        1        1        2        3
s        1        2        3        1        2        2
f        3        7        2        1        2        1
v        2        1        3        2        2        1
t        2        2        2        2        1        3
b        3        2        2        1        5        2
g        1        3        1        2        1        2
r        2        1        1        1        1        1
t        2        2        1        3        2        3
a        2        3        3        5        2        4
f        3        1        2        2        5        2
s        1        1        4        9        2        5

MMMIX

回復(fù) 4# MMMIX


   
利用 Perl 5.12 的新 each 和 autovivification，連 pairwise 都可以省了，代碼可以更簡(jiǎn)潔，也更易懂：

#!/usr/bin/perl

use strict;
use warnings;

use v5.14;

my %rec;
while (<DATA>) {
  chomp;
  my ($key, @vals) = split;
  while (my ($i, $v) = each @vals) {
    $rec{$key}->[$i][0] += 1;
    $rec{$key}->[$i][1] += $v;
  }
}

while (my ($key, $vals) = each %rec) {
  say join "\t", ($key, map { $_->[1] / $_->[0] } @$vals);
}

__DATA__
a        2        3        1        3        2        2
s        2        2        1        1        2        3
s        1        2        3        1        2        2
f        3        7        2        1        2        1
v        2        1        3        2        2        1
t        2        2        2        2        1        3
b        3        2        2        1        5        2
g        1        3        1        2        1        2
r        2        1        1        1        1        1
t        2        2        1        3        2        3
a        2        3        3        5        2        4
f        3        1        2        2        5        2
s        1        1        4        9        2        5

815138698

回復(fù) 5# MMMIX


    你好，關(guān)于這個(gè)題目 我在實(shí)現(xiàn)相加的時(shí)候?yàn)槭裁粗挥械谝粋�(gè)元素相加了，而后面的沒有，幫忙看下我的代碼哪邊出的問題，思考很久也沒有解決，沒有辦法只能上來請(qǐng)教了。

#!/usr/bin/perl
use strict;
use Data:umper;

my %hash;
while(<DATA>{
        chomp;
        my($key,@vals)=split;
        if(!exists $hash{$key}){
                $hash{$key}[0]=\@vals;
                $hash{$key}[1]=1;
        }
        for(my $i=(0..$#vals)){
                        $hash{$key}[0][$i]+=$vals[$i];
                        $hash{$key}[1]++;
        }
}

print Dumper(%hash);

MMMIX

回復(fù) 6# 815138698


    for 語(yǔ)句錯(cuò)了；還有這個(gè) for 應(yīng)該放在 else 里面:

my %hash;
while (<DATA>) {
  chomp;
  my ($key,@vals) = split;
  if (not exists $hash{$key}) {
    $hash{$key}[0] = \@vals;
    $hash{$key}[1] = 1;
  }
  else {
    for my $i (0 .. $#vals) {
      $hash{$key}[0][$i] += $vals[$i];
    }
    $hash{$key}[1] += 1;
  }
}

print Dumper(\%hash);


不過，上述代碼可以簡(jiǎn)化為：

my %hash;
while (<DATA>) {
  chomp;
  my ($key,@vals) = split;
  while (my ($i, $v) = each @vals) {
    $hash{$key}[0][$i] += $v;
  }
  $hash{$key}[1] += 1;
}

print Dumper(\%hash);

815138698

回復(fù) 7# MMMIX


    For的用法 沒有掌握好  按照自己想的錯(cuò)誤格式來寫了，多謝指正~
    還有您提到的each array的用法 也是第一次見到  學(xué)習(xí)了  非常感謝~

MMMIX

815138698 發(fā)表于 2015-10-15 10:38
回復(fù) 7# MMMIX

  還有您提到的each array的用法 也是第一次見到

Perl 5.12 的新特性。

Okelani

1. use 5.010;
   
2. 
   
3. my %data;
   
4. 
   
5. while (<DATA>) {
   
6.     my ( $name, @val ) = split;
   
7.     $data{$name}[$_] += $val[$_] for 0 .. $#val;
   
8.     $data{$name}[@val]++;
   
9. }
   
10. 
    
11. while ( my ( $name, $val ) = each %data ) {
    
12.     my $count = pop @$val;
    
13.     say join "\t", $name, map { sprintf "%.2f", $_ / $count } @$val;
    
14. }
    
15. 
    
16. __DATA__
    
17. a        2        3        1        3        2        2
    
18. s        2        2        1        1        2        3
    
19. s        1        2        3        1        2        2
    
20. f        3        7        2        1        2        1
    
21. v        2        1        3        2        2        1
    
22. t        2        2        2        2        1        3
    
23. b        3        2        2        1        5        2
    
24. g        1        3        1        2        1        2
    
25. r        2        1        1        1        1        1
    
26. t        2        2        1        3        2        3
    
27. a        2        3        3        5        2        4
    
28. f        3        1        2        2        5        2
    
29. s        1        1        4        9        2        5
    

復(fù)制代碼