有高手给展示下如何处理复杂表格的

zhxftj

有大侠给展示个完整程序吗， 感激不尽。

file 1 :        第一列第二列第三列第四列第五列 第六列。。。。。
name1.1        0        1        0        1        0        0
name1.2        0        1        1        0        1        1
name1.3        1        0        0        0        0        0
name2.1        1        1        0        0        0        0
name2.2        0        1        1        0        1        1
name2.3        1        0        0        1        0        0

对于以上表格，每一行，先比较“1”的 个数，和“0”的个数，选出个数少的那个（不会出现相等的个数，因为真实情况是奇数列200+列）， 然后每一列给出  次列中出现较少数字（“0 ”或者“1”）的次数。

针对以上例子就是
第一行 “0”出现4次，“1”出现2次。所以出现次数少的是“1”
第二行 “0”出现2次，“1”出现4次。所以出现次数少的是“0”
第三行 “0”出现5次，“1”出现1次。所以出现次数少的是“1”
第四行 “0”出现4次，“1”出现2次。所以出现次数少的是“1”
第五行 “0”出现2次，“1”出现4次。所以出现次数少的是“0”
第六行 “0”出现4次，“1”出现2次。所以出现次数少的是“1”

产生以下文件，仅保留出现个数少的那个
file 2

name1.1        。        1        。        1        。        。
name1.2        0        。        。        0        。        。
name1.3        1        。        。        。        。        。
name2.1        1        1        。                。        。
name2.2        0        。        。        0        。        。
name2.3        1        。        。        1        。        。

然后， 再看每列。
给出出现数字次数，
第一列，5次，
第二列， 2次，
第三列，0，
第四列， 0
第五列，4，
第六列， 0
将大于等于2次的输出在一个表格中：results
第一列  5
第二列  2
第五列  4

rubyish

比如：

1. #!/usr/bin/perl
   
2. use 5.016;
   
3. <DATA>;
   
4. my ( $t, $d, %a ) = ( "\t", '.' );
   
5. 
   
6. while (<DATA>) {
   
7.     my ( $h, @t, $sum, $i ) = split;
   
8.     $sum += $_ for @t;
   
9.     my $s = $sum > @t / 2 ? 0 : 1;
   
10.     say join $t, "$h ",
    
11.         map { $i++; $_ eq $s ? do { $a{$i}++; $s } : $d } @t;
    
12. }
    
13. 
    
14. say for map "col$_ $a{$_}", grep $a{$_} >= 2, keys %a;
    
15. 
    
16. __DATA__
    
17. file 1 :        第一列第二列第三列第四列第五列 第六列。。。。。
    
18. name1.1        0        1        0        1        0        0
    
19. name1.2        0        1        1        0        1        1
    
20. name1.3        1        0        0        0        0        0
    
21. name2.1        1        1        0        0        0        0
    
22. name2.2        0        1        1        0        1        1
    
23. name2.3        1        0        0        1        0        0

复制代码

zhxftj

回复 2# rubyish


谢谢回复
这次我 自作主张去掉了 use 5.016;
结果出现以下错误，
syntax error at 2table.pl line 9, near "say join"
syntax error at 2table.pl line 11, near "}"
Execution of 2table.pl aborted due to compilation errors.

大侠， 有进一步指点吗
  ，谢谢。。

我是按以下方法运行的，对吗
perl 2table.pl DATA3.txt

把您的程序存成2table.pl，把数据存成DATA3.txt  

rubyish

DATA3.txt

1. file 1 :        第一列第二列第三列第四列第五列 第六列。。。。。
   
2. name1.1        0        1        0        1        0        0
   
3. name1.2        0        1        1        0        1        1
   
4. name1.3        1        0        0        0        0        0
   
5. name2.1        1        1        0        0        0        0
   
6. name2.2        0        1        1        0        1        1
   
7. name2.3        1        0        0        1        0        0

复制代码

2table.pl

1. #!/usr/bin/perl -l
   
2. <>;
   
3. my ( $t, $d, %a ) = ( "\t", '.' );
   
4. 
   
5. while (<>) {
   
6.     my ( $h, @t, $i ) = split;
   
7.     my $s = ( grep $_, @t ) > @t / 2 ? 0 : 1;
   
8.     print join $t, "$h ",
   
9.       map { $i++; $_ eq $s ? do { $a{$i}++; $s } : $d } @t;
   
10. }
    
11. 
    
12. print for map "col$_ $a{$_}", grep $a{$_} >= 2, keys %a;

复制代码

1. perl 2table.pl DATA3.txt

复制代码

zhxftj

回复 4# rubyish
真的感谢每次快速，简洁的回复。

结果是
name1.2         0        .        .        0        .        .
name1.3         1        .        .        .        .        .
name2.1         1        1        .        .        .        .
name2.2         0        .        .        0        .        .
name2.3         1        .        .        1        .        .
col4 3
col1 5

不对呀

大侠，有解药吗。。。
程序高深，得研究下。。。我先试图将结果写入一个 文件。

   

rubyish

na我就不太清楚了。{:3_203:}{:3_203:}

1. name1.1         .       1       .       1       .       .
   
2. name1.2         0       .       .       0       .       .
   
3. name1.3         1       .       .       .       .       .
   
4. name2.1         1       1       .       .       .       .
   
5. name2.2         0       .       .       0       .       .
   
6. name2.3         1       .       .       1       .       .
   
7. col1 5
   
8. col4 4
   
9. col2 2

复制代码

zhxftj

回复 4# rubyish


    照着葫芦，画了个平面的葫芦，呵呵

去掉《》
即可。。。呵呵

谢谢，编程高手呢

zhxftj

{:3_198:}
把第二行删了即可，就是那个答案，呵呵

你 真逗。。。

回复 6# rubyish


   

yestreenstars

我又无聊的倒腾了一下~

1. awk 'NR==1{for(i=2;i<=NF;i++)a[i]=$i}NR>1{for(i=2;i<=NF;i++){if($i)m++;else n++}if(m>n)gsub("1",".");else gsub("0",".");for(i=2;i<=NF;i++)if($i!=".")b[i]++;m=n=0}END{for(i=2;i<=NF;i++)if(b[i]>=2)print a[i],b[i]}'

复制代码

测试：

1. [root@localhost ~]# cat i
   
2. name         First   Second    Third   Fourth   Fifth     Sixth
   
3. name1.1        0        1        0        1        0        0
   
4. name1.2        0        1        1        0        1        1
   
5. name1.3        1        0        0        0        0        0
   
6. name2.1        1        1        0        0        0        0
   
7. name2.2        0        1        1        0        1        1
   
8. name2.3        1        0        0        1        0        0
   
9. [root@localhost ~]# awk 'NR==1{for(i=2;i<=NF;i++)a[i]=$i}NR>1{for(i=2;i<=NF;i++){if($i)m++;else n++}if(m>n)gsub("1",".");else gsub("0",".");for(i=2;i<=NF;i++)if($i!=".")b[i]++;m=n=0}END{for(i=2;i<=NF;i++)if(b[i]>=2)print a[i],b[i]}' i
   
10. First 5
    
11. Second 2
    
12. Fourth 4
    
13. [root@localhost ~]#

复制代码

zhxftj

回复 9# yestreenstars

您啥时候无聊把我 另几个问题也 答下？？ 静静的 等。。。