重发求助！！

codeternity

小弟之前发过一个，但似乎没有表达清楚自己的意思，现想重新发一下求助，原始数据：

   name1 name2 name3 name4 name5
MG1 A G C D C A C G A D
MG2 A G D C A C G C D A
SH_1 G G C C C C 0 0 A A
SH_2 A A 0 0 A A C C D D
SH_3 G A D D 0 0 G G 0 0
SD1 A G C D C C C G A D
SD2 0 0 D C C A C C D A

name1、name2、name3分别对应2列，并以空格隔开。现想统计一下以MG、SH、SD开头的分别含字母的个数，并转化一下格式，
字母里只有ACDG这4种字母，每两列只含其中的两种，但不一定是哪两种，是随机给出的，
最终想得到下面的结果：

      MG SH SD
name1 2,2 3,3 1,1 #(A的个数,G的个数)
name2 2,2 2,2 2,2 #(C的个数,D的个数)
name3 2,2 2,2 1,3 #(A的个数,C的个数)
name4 2,2 2,2 3,1 #(C的个数,G的个数)
name5 2,2 2,2 2,2 #(A的个数,D的个数)


不知道应该怎么写呢，肯请大家指点一下。

rubyish

biru:

1. #!/usr/bin/perl
   
2. use 5.018;
   
3. my @intention = qw[ A G   C D   A C   C G   A D ];
   
4. my ( @titles, %data, %filter );
   
5. my @name = <DATA> =~ /\S+/g;
   
6. $filter{$_} = [ splice @intention, 0, 2 ] for @name;
   
7. 
   
8. while (<DATA>) {
   
9.     my ( $title, $data ) = /^([^\d_]+)\S*\s*(.*)$/;
   
10.     my @data = split /\s+/, $data;
    
11.     push @titles, $title if !@titles || $titles[-1] ne $title;
    
12.     for my $n (@name) {
    
13.         $data{$n}{$title}{$_}++ for splice @data, 0, 2;
    
14.     }
    
15. }
    
16. 
    
17. say join "\t", '', @titles;
    
18. for my $n (@name) {
    
19.     say join "\t", $n, map {
    
20.         my $t = $_;
    
21.         join ', ', map { $data{$n}{$t}{$_} || 0 } @{ $filter{$n} };
    
22.     } @titles;
    
23. }
    
24. 
    
25. __DATA__
    
26.    name1 name2 name3 name4 name5
    
27. MG1 A G C D C A C G A D
    
28. MG2 A G D C A C G C D A
    
29. SH_1 G G C C C C 0 0 A A
    
30. SH_2 A A 0 0 A A C C D D
    
31. SH_3 G A D D 0 0 G G 0 0
    
32. SD1 A G C D C C C G A D
    
33. SD2 0 0 D C C A C C D A

复制代码

1.         MG      SH      SD
   
2. name1   2, 2    3, 3    1, 1
   
3. name2   2, 2    2, 2    2, 2
   
4. name3   2, 2    2, 2    1, 3
   
5. name4   2, 2    2, 2    3, 1
   
6. name5   2, 2    2, 2    2, 2
   

复制代码

reyleon

http://bbs.chinaunix.net/thread-4115322-1-1.html

mcshell

1. my ( $h, $k );
   
2. my @letter = qw/A C D G/;
   
3. my @name = split " ", <DATA>;
   
4. while (<DATA>) {
   
5.     /([A-Z]+)_?\d+\s+(.*)$/;
   
6.     @_ = split " ", $2;
   
7.     push @{ $h->{$1} }, [@_];
   
8. }
   
9. print "\t", join " ", ( sort keys $h ), "\n";
   
10. for my $key ( sort keys %$h ) {
    
11.     my $g;
    
12.     for my $m ( @{ $h->{$key} } ) {
    
13.         for my $i ( 1 .. $#$m +1 / 2 ) {
    
14.             $g->{$i}{$_}++ for splice @$m, 0, 2;
    
15.         }
    
16.     }
    
17.     for my $key ( sort { $a cmp $b } keys %$g ) {
    
18.         delete $g->{$key}{0} if $g->{$key}{0};
    
19.         for (@letter) {
    
20.             push @{ $k->{$key} }, $g->{$key}{$_} if $g->{$key}{$_};
    
21.         }
    
22.     }
    
23. }
    
24. for my $key ( sort keys %$k ) {
    
25.     print "name$key ";
    
26.     print " ",join ",", splice @{$k->{$key}}, 0, 2 for 0 .. $#{$k->{$key}} / 2;
    
27.     print "\n";
    
28. }
    
29. __DATA__
    
30. name1 name2 name3 name4 name5
    
31. MG1 A G C D C A C G A D
    
32. MG2 A G D C A C G C D A
    
33. SH_1 G G C C C C 0 0 A A
    
34. SH_2 A A 0 0 A A C C D D
    
35. SH_3 G A D D 0 0 G G 0 0
    
36. SD1 A G C D C C C G A D
    
37. SD2 0 0 D C C A C C D A
    

复制代码

codeternity

回复 3# reyleon

大神有心了，竟把这个作为一个帖子集思，多谢多谢！
   

codeternity

回复 4# mcshell

恩，对对，这个就是我想要的结果，真的好难表达明白，谢谢大侠了！！
   

yestreenstars

1. #!/usr/bin/perl
   
2. use 5.010;
   
3. 
   
4. my(@names, @lines, %times, @heads, %hash, $str, $temp, $value);
   
5. my @letters = qw/A C D G/;
   
6. 
   
7. while (<DATA>) {
   
8.         if ( $. < 2 ) {
   
9.                 @names = split;
   
10.         } else {
    
11.                 @lines = split;
    
12.                 $lines[0] =~ s/[^A-Z]+//;
    
13.                 push @heads, $lines[0] if ! $times{$lines[0]}++;
    
14.                 $hash{int(($_-1)/2)}{$lines[0]}{$lines[$_]}++ for 1 .. $#lines;
    
15.         }
    
16. }
    
17. 
    
18. END {
    
19.         $str .= "\t" . $heads[$_] for 0 .. $#heads;
    
20.         say $str;
    
21.         undef $str;
    
22.         for my $i ( 0 .. $#names ) {
    
23.                 printf "%s\t", $names[$i];
    
24.                 for my $j ( 0 .. $#heads ) {
    
25.                         for my $k ( 0 .. $#letters ) {
    
26.                                 $value = $hash{$i}{$heads[$j]}{$letters[$k]};
    
27.                                 $temp = $temp ? $temp . "," . $value : $value if $value;
    
28.                         }
    
29.                         $str = $str ? $str . "\t" . $temp : $temp;
    
30.                         undef $temp;
    
31.                 }
    
32.                 say $str;
    
33.                 undef $str;
    
34.         }
    
35. }
    
36. 
    
37. __DATA__
    
38.    name1 name2 name3 name4 name5
    
39. MG1 A G C D C A C G A D
    
40. MG2 A G D C A C G C D A
    
41. SH_1 G G C C C C 0 0 A A
    
42. SH_2 A A 0 0 A A C C D D
    
43. SH_3 G A D D 0 0 G G 0 0
    
44. SD1 A G C D C C C G A D
    
45. SD2 0 0 D C C A C C D A

复制代码