使用perl除去常数列

chembaobao

现在有一个数据文件如下：
No  v1  v2  v3  v4  v5  v6  ...
1    2.3 3.5 4.1 4.5 3.5 6
2    3.2 3.4 4.1 4.2 3.5 7
3    2.6 2.2 4.1 3.3 3.5 4.4
4    1.1 2.2 4.1 3.7 3.5 5.6
...

现在我需要将常数列（一列中的数据全部相同，如上例中的v3和v5）除去，并获取剩下的数据集，请问使用perl如何实现？

iamlimeng

实现倒不难，就是太啰嗦，我想应该有更简洁的实现方法，你将就用吧

1. #!/usr/bin/perl
   
2. 
   
3. use strict;
   
4. use warnings;
   
5. my %data;
   
6. my %filter;
   
7. while (<DATA>) {
   
8.         chomp;
   
9.         my ($no,@data) = split /\s+/;
   
10.          $data{$no} = \@data;
    
11.          foreach my $n (0..$#data) {
    
12.                  $filter{$n}{$data[$n]} = 1;
    
13.          }
    
14. }
    
15. my %same;
    
16. foreach my $rol (keys %filter) {
    
17.         $same{$rol} = 1 if (keys %{$filter{$rol}} == 1);
    
18. }
    
19. foreach my $no (sort keys %data) {
    
20.         print "$no\t";
    
21.          my @data_new = ();
    
22.          foreach my $rol (0..$#{$data{$no}}) {
    
23.                  push(@data_new,${$data{$no}}[$rol]) if (!$same{$rol});
    
24.          }
    
25.          print join("\t",@data_new),"\n";
    
26. }
    
27. <STDIN>;
    
28. 
    
29. __DATA__
    
30. 1    2.3 3.5 4.1 4.5 3.5 6
    
31. 2    3.2 3.4 4.1 4.2 3.5 7
    
32. 3    2.6 2.2 4.1 3.3 3.5 4.4
    
33. 4    1.1 2.2 4.1 3.7 3.5 5.6

复制代码

kk861123

我先抛块砖吧

1. #!/usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. 
   
5. my (@row,%col);
   
6. while (<DATA>) {
   
7.     my @data = split;
   
8.     push @row,[@data];
   
9.     $col{$_}{$data[$_]}++ for 0..$#data;
   
10. }
    
11. 
    
12. foreach my $i (0..$#row) {
    
13.     foreach my $j (0..$#{$row[$i]}) {
    
14.         if ( keys %{ $col{$j} } > 1) {
    
15.             print $row[$i][$j],"\t";
    
16.         }
    
17.     }
    
18.     print "\n";
    
19. }
    
20. 
    
21. __DATA__
    
22. 2.3 3.5 4.1 4.5 3.5 6
    
23. 3.2 3.4 4.1 4.2 3.5 7
    
24. 2.6 2.2 4.1 3.3 3.5 4.4
    
25. 1.1 2.2 4.1 3.7 3.5 5.6

复制代码

chembaobao

感谢两位的回复，我以前使用java实现过，就是太麻烦，要转置两次
perl是初学

cdtits

1. use strict;
   
2. use warnings;
   
3. use List::MoreUtils qw( uniq );
   
4. 
   
5. my @datas;
   
6. 
   
7. while (<DATA>) {
   
8.     my ($no, @ds) = split;
   
9.     push @{$datas[$_]}, $ds[$_] for (0..$#ds);
   
10. }
    
11. @datas = grep { scalar(uniq @{$_}) > 1; } @datas;
    
12. for my $i (0..$#{$datas[0]}) {
    
13.     my @tmp = ($i + 1);
    
14.     push @tmp, @{$_}[$i] for (@datas);
    
15.     print join("\t", @tmp), "\n";
    
16. }
    
17. 
    
18. __DATA__
    
19. 1    2.3 3.5 4.1 4.5 3.5 6
    
20. 2    3.2 3.4 4.1 4.2 3.5 7
    
21. 3    2.6 2.2 4.1 3.3 3.5 4.4
    
22. 4    1.1 2.2 4.1 3.7 3.5 5.6

复制代码

justqb

感觉需要把整个文件都读了，才能做下一步，如果文件很大的话要小心了。
或者读两遍文件。
第一遍看哪列数据没变化过，
第二遍读，写。

chembaobao

我做了些修改：

1. use strict;
   
2. use warnings;
   
3. 
   
4. open my $fh, '<', 'C:/Users/pumbaa/Desktop/test/1.txt';
   
5. open my $fh2, '>', 'C:/Users/pumbaa/Desktop/test/2.txt';
   
6. 
   
7. my (@title, @row, %col);
   
8. my $flag = 1;
   
9. while (<$fh>) {
   
10.         chomp;
    
11.         if($flag) {
    
12.                 (@title) = split /\t/;
    
13.                 $flag = 0;
    
14.                 next;
    
15.         }       
    
16.     my (@data) = split /\t/;
    
17.     push @row,[@data];
    
18.     $col{$_}{$data[$_]}++ for 0..$#data;
    
19. }
    
20. 
    
21. $flag = 1;
    
22. foreach my $i (0..$#row) {
    
23.     foreach my $j (0..$#{$row[$i]}) {
    
24.         if ( keys %{ $col{$j} } > 1) {
    
25.                 if ($flag) {
    
26.                         print $fh2 $title[$j], "\t";
    
27.                         next;
    
28.                 }
    
29.             print $fh2 $row[$i][$j],"\t";
    
30.         }
    
31.     }
    
32.     print $fh2 "\n";
    
33.     if($flag) {
    
34.             $flag = 0;
    
35.             redo;
    
36.     }   
    
37. }

复制代码

1.txt
no        v1        v2        v3        v4        v5        v6
1        2.2        3.4        5.6        7.8        9.9        10
2        2.2        3.6        5.6        7.8        9.9        11
3        2.2        1.2        3.5        2.1        9.9        12
4        2.2        1.1        1.3        1.4        9.9        13

2.txt
no        v2        v3        v4        v6       
1        3.4        5.6        7.8        10       
2        3.6        5.6        7.8        11       
3        1.2        3.5        2.1        12       
4        1.1        1.3        1.4        13       

cdtits

chembaobao 发表于 2012-08-31 15:19
我做了些修改：1.txt
no        v1        v2        v3        v4        v5        v6
1        2.2        3.4        5.6        7.8        9.9        10

结果很好