抽取信息進行統(tǒng)計

tingshuibanxia

假如有3個文本：A1.txt
                     A2.txt
                     A3.txt
格式一樣(列以tab分隔)，如下：

      A1.txt                                     A2.txt                                  A3.txt

ID    group    o                         ID    group    o                       ID    group    o
11    s k        sd                        1      aa1      222                    3      a b       dwd
12    aa1       34                        2      aa1      dd                      2      s k       222
12    a b        bb                        1      a b      111                    
13    a b        eee


提取每個文本中group列的類別信息并計數，生成文件第一列名稱“group”，后幾列是文本前綴，并且按名稱排序“A1 A2 A3”，列之間以tab分隔：

group    A1    A2    A3

s k        1       0      1
aa1       1       2       0
a b        2       1       1



用哈�？梢詫崿F(xiàn)嗎？

首先提取各個文本的統(tǒng)計信息，存成哈希，
第二步對生成文本的表頭排序：sort {$a cmp $b} keys %datas)
這個思路如何？

sunzhiguolu

1. #!/usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. 
   
5. my ($offset, $idx, $last) = (-1, 0, "");
   
6. my (%grpMap, %grpCnt, @aTh, @aData);
   
7. 
   
8. while (<>){
   
9.     next if (/\A\s*ID/);
   
10.     if ($last ne $ARGV){
    
11.         $last = $ARGV;
    
12.         %grpCnt = ();
    
13.         $offset++;
    
14.     }
    
15.     my @aCols = split;
    
16.     my $group = @aCols > 3 ? "@aCols[1, 2]" : $aCols[1];
    
17.     if (!exists $grpMap{$group}){
    
18.         $grpMap{$group} = $idx++;
    
19.         push (@aTh, $group);
    
20.     }
    
21.     my $index = $grpMap{$group};
    
22.     $aData[$index][$offset] = ++$grpCnt{$group};
    
23. }
    
24. 
    
25. print join ("\t", qw /group A1 A2 A3/), "\n";
    
26. while (my ($gID, $gName) = each @aTh){
    
27.     $aData[$gID][$offset] = $aData[$gID][$offset] // 0;
    
28.     my @aT = map {defined ? $_ : 0} @{$aData[$gID]};
    
29.     print join ("\t", $gName, @aT), "\n";
    
30. }
    

復制代碼

perl abc.pl a1.txt a2.txt a3.txt
----------------------------------------------------------------------
group   A1      A2      A3
s k     1       0       1
aa1     1       2       0
a b     2       1       1

MMMIX

1. #!/usr/bin/perl
   
2. 
   
3. use strict;
   
4. use warnings;
   
5. 
   
6. use v5.14;
   
7. use autodie;
   
8. use Data::Dumper;
   
9. 
   
10. sub load_data {
    
11.   local @ARGV = @_;
    
12. 
    
13.   my (%records, %groups);
    
14.   while (<>) {
    
15.     next if /^ID/;
    
16. 
    
17.     my $group = (split)[1];
    
18.     $records{$ARGV}->{$group} += 1;
    
19.     $groups{$group} = 1;
    
20.   }
    
21. 
    
22.   return (\%records, \%groups);
    
23. }
    
24. 
    
25. ###
    
26. 
    
27. my @files = @ARGV;
    
28. my ($records, $groups) = load_data @files;
    
29. 
    
30. print Dumper($records);
    
31. 
    
32. say join("\t", 'group', map { s/\.txt//r } @files);
    
33. 
    
34. foreach my $group (sort keys %$groups) {
    
35.   say join("\t", $group, map { $_->{$group} // 0 } @{$records}{@files});
    
36. }
    

復制代碼

華小飛_Perl

1. #!/usr/bin/perl
   
2. 
   
3. use warnings;
   
4. use strict;
   
5. use YAML;
   
6. 
   
7. my (@calculation, @allstring);
   
8. my @copy = my @filebak = grep { s/(\S+)\.txt/$1/ } @ARGV;
   
9. 
   
10. foreach my $file (@ARGV) {
    
11.         open DATA, '<', $file.'.txt' or die "Can't open the file $file: $!";
    
12.         my $string_cal;                # autovivification
    
13.         my $filename = shift @filebak;       
    
14.         while (<DATA>) {
    
15.                 chomp;
    
16.                 next if (/^ID/);               
    
17.                 my $catch = (split /\t+/)[1];
    
18.                 $string_cal->{$filename}{$catch}++;
    
19.         }       
    
20.         push @calculation, $string_cal;
    
21.         push @allstring, keys %{ $string_cal->{$filename} };
    
22. }
    
23. 
    
24. for my $hash_ref (@calculation) {
    
25.         my $name = shift @copy;
    
26.         for (@allstring) {
    
27.                 $hash_ref->{$name}{$_} = 0 unless ( exists $hash_ref->{$name}{$_} );
    
28.         }
    
29. }
    
30. 
    
31. print Dump( \@calculation );

復制代碼

僅供參考~

RE_HASH

$>  perl aa.pl A?.txt
group   A1      A2      A3
s k     1       0       1
aa1     1       2       0
a b     2       1       1


aa.pl:

while (<>)
{
  next if (/group/);
my $Key  = $ARGV =~ s/.txt//r;
my ($group) = /\t(.+?)\t/;
$Keys->{$Key} ++;
$OUT->{$group}->{$Key} ++;
}


printf "group\t%s\n", join "\t",sort keys %$Keys;
for $G (reverse sort keys %$OUT)
{
  print "$G";
  printf "\t%d", $OUT->{$G}->{$_} for (sort keys %$Keys);
  print "\n";
}