两列数据统计重复出现次数

摇摆蝶仙

-----------------data------------
A01     A
A01     C
A01     C
A01     C
A01     B
A01     A
A01     C
A02     D
A02     D
A02     B
A02     B
A02     A
A03     A
A03     D
A03     B
希望统计以第一列为范围统计第二列出现的次数,并且标注出出现最多的第二列类别。希望得到的结果是
-----------------data------------
A01     A      2      C
A01     C      4      C
A01     C      4      C
A01     C      4      C
A01     B      1      C
A01     A      2      C
A01     C      4      C
A02     D      2      B,D
A02     D      2      B,D
A02     B      2      B,D
A02     B      2      B,D
A02     A      1      B,D
A03     A      1      A,B,D
A03     D      1      A,B,D
A03     B      1      A,B,D

substr函数

简单场景直接利用字典就够了。

104359176

用易表，foxtable 处理此类问题最合适了

rubyish

foxtable ~

1. #!/usr/bin/perl
   
2. 
   
3. my @foxtable;
   
4. my $V = '\(^oo^)/';
   
5. 
   
6. while (<DATA>) {
   
7.     my ( $A, $B ) = split;
   
8.     $V ne $A
   
9.       ? push @foxtable, [ {}, $V = $A, $B ]
   
10.       : push @{ $foxtable[-1] }, $B;
    
11.     $foxtable[-1][0]{$B}++;
    
12. }
    
13. 
    
14. for (@foxtable) {
    
15.     my ( $fox, $tab, @le ) = @$_;
    
16.     my ($it) = sort { $b <=> $a } values %$fox;
    
17.     my $that = join ',', sort grep $fox->{$_} == $it, keys %$fox;
    
18.     print map join( "\t", $tab, $_, $fox->{$_}, $that ) . $/, @le;
    
19. }
    
20. 
    
21. __DATA__
    
22. A01     A
    
23. A01     C
    
24. A01     C
    
25. A01     C
    
26. A01     B
    
27. A01     A
    
28. A01     C
    
29. A02     D
    
30. A02     D
    
31. A02     B
    
32. A02     B
    
33. A02     A
    
34. A03     A
    
35. A03     D
    
36. A03     B
    

复制代码

清泉一边

为什么找不到写代码的<>了呢
   

清泉一边

我觉得大神的这种写法首先要确定按第一列排序，斗胆给大神的代码加了一步排序

1. #!/usr/bin/perl
   
2. my @sort = map {$_->[0]}
   
3.             sort {$a->[1] cmp $b->[1]}
   
4.             map {[$_,split]}<DATA>;
   
5. my @foxtable;
   
6. my $V = 0;
   
7. for my $sort (@sort) {
   
8.     my ( $A, $B ) = split /\s+/,$sort;
   
9.     if($V ne $A){
   
10.     $V = $A;
    
11.     push @foxtable, [ {}, $V, $B ];
    
12.     }
    
13.     else{
    
14.       push @{ $foxtable[-1] }, $B;
    
15. #      $foxtable[-1][0]{$B}++;
    
16.     }
    
17.     $foxtable[-1][0]{$B}++;
    
18. }
    
19. for (@foxtable) {
    
20.     my ( $fox, $tab, @le ) = @$_;
    
21.     my ($it) = sort { $b <=> $a } values %$fox;
    
22.     my $that = join ',', sort grep $fox->{$_} == $it, keys %$fox;
    
23.     print map join( "\t", $tab, $_, $fox->{$_}, $that ) . $/ ,sort @le;
    
24. }
    
25. 
    
26. __DATA__
    
27. A01     A
    
28. A01     C
    
29. A01     C
    
30. A01     C
    
31. A01     B
    
32. A01     A
    
33. A01     C
    
34. A02     D
    
35. A02     D
    
36. A02     B
    
37. A02     B
    
38. A02     A
    
39. A03     A
    
40. A03     D
    
41. A03     B

复制代码

回复 6# rubyish


   

rubyish

回复 8# 清泉一边

3Q~     

wo muce tade diyi lie shi youxude, suoyi...
ru yao gai?
wo xiang zhe keneng hui bijiao hao?
dan zhe yu yuqide jieguo bufu.

1. my @sort = map { $_->[0] }
   
2.   sort { $a->[1] cmp $b->[1] }
   
3.   map { [ $_, split ] } <DATA>;
   
4.   ...
   
5. for my $sort (@sort) {
   
6.     my ( $A, $B ) = split /\s+/, $sort;

复制代码

1. 
   
2. my @sort =
   
3.   # map { $_->[0] }
   
4.   sort { $a->[0] cmp $b->[0] }
   
5.   map { [ split ] } <DATA>;
   
6.   # map { [ $_, split ] } <DATA>;
   
7.   # [ "A01     A", "A01", "A" ], $_ shi duoyude
   
8. 
   
9. for my $sort (@sort) {
   
10.     # my ( $A, $B ) = split /\s+/, $sort;
    
11.     # BAD: 1 hang split 2 ci
    
12.     my ( $A, $B ) = @$sort;

复制代码

zhe shi lingyige xiefa(wuxude):
yiyang shiyong foxtable ~

1. #!/usr/bin/perl
   
2. my %foxtable;
   
3. 
   
4. while (<DATA>) {
   
5.     my ( $A, $B ) = split;
   
6.     $foxtable{$A}{$B}++;
   
7. }
   
8. 
   
9. for my $k ( sort keys %foxtable ) {
   
10.     my %F   = %{ $foxtable{$k} };
    
11.     my ($V) = sort { $b <=> $a } values %F;
    
12.     my $T   = join ',', sort grep $F{$_} == $V, keys %F;
    
13.     print map { "$k\t$_\t$F{$_}\t$T\n" x $F{$_} } sort keys %F;
    
14. }
    
15. 
    
16. __DATA__
    
17. A01     A
    
18. A01     C
    
19. A01     C
    
20. A02     A
    
21. A03     A
    
22. A03     D
    
23. A01     C
    
24. A01     B
    
25. A01     A
    
26. A01     C
    
27. A02     D
    
28. A02     D
    
29. A02     B
    
30. A02     B
    
31. A03     B
    

复制代码

sunzhiguolu

1. #!/usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. 
   
5. my ($id, @aData, %hCnt) = "";
   
6. map {my ($k, $v) = split; $id ne $k ? push (@aData, [$k, [$v]]) : push (@{$aData[-1][-1]}, $v); $id = $k} <DATA>;
   
7. foreach my $ra (@aData){
   
8.     $hCnt{$_}++ for @{$ra->[-1]};
   
9.     my @aT = map {[$_, $hCnt{$_}]} sort {$hCnt{$b} <=> $hCnt{$a}} keys %hCnt;
   
10.     my @aChars = $aT[0][0];
    
11.     foreach (1 .. $#aT){
    
12.         push (@aChars, $aT[$_][0]) if ($aT[0][-1] == $aT[$_][-1]);
    
13.     }
    
14.     print join ("\t", $ra->[0], $_, $hCnt{$_}, join (",", sort @aChars)), "\n" for @{$ra->[-1]};
    
15.     %hCnt = ();
    
16. }
    
17. 
    
18. __DATA__
    
19. A01     A
    
20. A01     C
    
21. A01     C
    
22. A01     C
    
23. A01     B
    
24. A01     A
    
25. A01     C
    
26. A02     D
    
27. A02     D
    
28. A02     B
    
29. A02     B
    
30. A02     A
    
31. A03     A
    
32. A03     D
    
33. A03     B

复制代码