文件每列数据统计

newfinder

大家过年好呀！

请教大家一个问题。以文件每列为单位，对每行内容进行重复统计(包括频数和频率)，如下所示。

data1.txt
---------
A B C D E F
A C D E F A
B D C E F A
E F D C G A

想输出的结果为：
data2.txt
---------
A:2, 0.50        B:1, 0.25        C:2, 0.50        C:1, 0.25        E:1, 0.25        A:3, 0.75
B:1, 0.25        C:1, 0.25        D:2, 0.50        D:1, 0.25        F:2, 0.50        F:1, 0.25
E:1, 0.25        D:1, 0.25                              E:2, 0.50        G:1, 0.25
                      F:1, 0.25

请问大家不知道有没有什么好的方法可以借鉴一下。

jason680

回复 1# newfinder

1. $ cat data1.txt
   
2. A B C D E F
   
3. A C D E F A
   
4. B D C E F A
   
5. E F D C G A
   
6. 
   
7. $ perl get_col.pl data1.txt > data2.txt
   
8. 
   
9. $ cat data2.txt
   
10. A:2, 0.50    B:1, 0.25    C:2, 0.50    C:1, 0.25    E:1, 0.25    A:3, 0.75   
    
11. B:1, 0.25    C:1, 0.25    D:2, 0.50    D:1, 0.25    F:2, 0.50    F:1, 0.25   
    
12. E:1, 0.25    D:1, 0.25                 E:2, 0.50    G:1, 0.25                 
    
13.              F:1, 0.25   

复制代码

                                                   

$ cat get_col.pl

1. use strict;
   
2. use warnings;
   
3. 
   
4. sub mesg{
   
5.   print "Usage:   $0 FILE\n";
   
6.   print "Example: $0 data1.txt\n";
   
7.   exit(1);
   
8. }
   
9. 
   
10. 
    
11. mesg if @ARGV !=1;
    
12. 
    
13. my @aCol;
    
14. while(<>){
    
15.   s/^\s+|\s+$//g;
    
16.   next if (m/^(#|$)/);
    
17.   my @aData = split;
    
18.   foreach( 0 .. scalar @aData-1) {
    
19.     $aCol[$_]{'count'}{$aData[$_]}++;
    
20.     $aCol[$_]{'total'}++;
    
21.   }
    
22. }
    
23. my @aResult;
    
24. my $sCol     = 0;
    
25. my $sMax_cnt = 0;
    
26. my $sMax_len = 0;
    
27. foreach (@aCol) {
    
28.   my $sTotal = $_->{'total'};
    
29.   my $sCnt = 0;
    
30.   foreach my $sKey (sort keys %{$_->{'count'}}) {
    
31.     my $sVal = $_->{'count'}{$sKey};
    
32.     my $sStr = sprintf("%s:%d, %.2f", $sKey, $sVal, $sVal/$sTotal);
    
33.     my $sLen = length($sStr);
    
34.     push @{$aResult[$sCol]},$sStr;
    
35.     $sMax_cnt = $sCnt if($sMax_cnt < $sCnt);
    
36.     $sMax_len = $sLen if($sMax_len < $sLen);
    
37.     ++$sCnt;
    
38.   }
    
39.   ++$sCol;
    
40. }
    
41. foreach my $sCnt ( 0 .. $sMax_cnt) {
    
42.   my $sLine = "";
    
43.   foreach (0 .. $sCol-1) {
    
44.     my $sStr = $aResult[$_]->[$sCnt] // "";
    
45.     $sLine .= sprintf("%*s    ", $sMax_len, $sStr);
    
46.   }  
    
47.   print "$sLine\n";
    
48. }

复制代码

newfinder

回复 2# jason680

厉害厉害，多谢多谢！让我消化消化，学习学习！

Okelani

perl count.pl data.txt > data.xls

1. #!/usr/bin/perl
   
2. 
   
3. use 5.010;
   
4. 
   
5. my @data;
   
6. while (<>) {
   
7.     my @line = split;
   
8.     for my $i ( 0 .. $#line ) {
   
9.         $data[$i]{ $line[$i] }++;
   
10.     }
    
11. }
    
12. 
    
13. my ($elems) = sort { $b <=> $a } map { scalar %$_ } @data;
    
14. my @print = map {
    
15.     my $elem = $_;
    
16.     [ map { "$_: $elem->{$_}, " . ( $elem->{$_} / $. ) } keys %$elem ]
    
17. } @data;
    
18. 
    
19. for my $i ( 0 .. $elems ) {
    
20.     say join "\t", map { $_->[$i] // '' } @print;
    
21. }
    

复制代码

newfinder

回复 4# Okelani

简洁！多谢分享了！

L_WC

回复 1# newfinder

重复提交了，忽略此贴。

1. 
   

复制代码

L_WC

回复 1# newfinder

今天看了Perl 6 Introduction，写的第一个Perl6程序，难免有使用不巧的地方，不足请指正。

1. my @array_expected;
   
2. my $i = 0;
   
3. for 'data1.txt'.IO.lines -> $line
   
4. {
   
5.         next unless $line.chars;
   
6.         my @line = $line.split(' ');
   
7.         map ->$n {@array_expected[$n;$i] = @line[$n]} , 0 .. @line.end;
   
8.         $i++;
   
9. }
   
10. 
    
11. for @array_expected -> $line
    
12. {
    
13.         for parse-count $line -> (:$key, :$value)
    
14.         {
    
15.                 say $key ~ ': ' ~ $value<count> ~ ',' ~ $value<fre>;
    
16.         }
    
17. }
    
18. 
    
19. sub parse-count(@list)
    
20. {
    
21.         my %hash = ();
    
22.         map {%hash{$_}<fre> += 1 / @list.elems; %hash{$_}<count> += 1}, @list.sort;
    
23.         return %hash.sort;
    
24. }
    

复制代码

1. [root@Liuweic lab]# perl6 data1.pl6
   
2. A: 2,0.5
   
3. B: 1,0.25
   
4. E: 1,0.25
   
5. B: 1,0.25
   
6. C: 1,0.25
   
7. D: 1,0.25
   
8. F: 1,0.25
   
9. C: 2,0.5
   
10. D: 2,0.5
    
11. C: 1,0.25
    
12. D: 1,0.25
    
13. E: 2,0.5
    
14. E: 1,0.25
    
15. F: 2,0.5
    
16. G: 1,0.25
    
17. A: 3,0.75
    
18. F: 1,0.25
    

复制代码

newfinder

回复 7# L_WC

多谢多谢。我要学的还太多呀。