[求助]用perl实现复杂一点的comm比较

wanggd1983

想用perl实现类似comm的功能，但又稍稍复杂一点：
文件格式是这样的：

file 1:
A  1  name1-1  name2-1
A  2  name3-1  name9-1
A  5  name7-1  name6-1

file 2:
A  1  name1-2  name2-2
A  3  name3-2  name9-2
A  5  name7-2  name6-2

两个文件按照第一列asc码，第二列数字排过序。

需要的操作是，比较前两列，如果一致，则将两行打入一列，file1 在前，file2在后；如果不一致按照顺序排列下来，即：

After comm process：(F1, file1;  F2, file 2)

F1   A  1  name1-1  name2-1      F2   A  1  name1-2  name2-2
F1   A  2  name3-1  name9-1
F2   A  3  name3-2  name9-2
F1   A  5  name7-1  name6-1      F2   A  5  name7-2  name6-2

实际文本很大，需逐行操作。请问如此文本操作，如何用perl实现？ 谢谢。

wfnh

等高手

ttcn_cu

没照顾效率...

     1 #!/usr/bin/perl -w
      2 my (%F);
      3 open IN,"file1";
      4 while(<IN>){
      5     chomp;
      6     if (/(\w+)\s+(\d+)/){
      7         $F{sprintf"%10s%10s%10s",$1,$2,"F1"}="F1 $_";
      8     }
      9 }
     10 close IN;
     11 open IN,"file2";
     12 while(<IN>){
     13     chomp;
     14     if (/(\w+)\s+(\d+)/){
     15         $F{sprintf"%10s%10s%10s",$1,$2,"F2"}="F2 $_";
     16     }
     17 }
     18 close IN;
     19 my $old;
     20 foreach my $key (sort keys %F){
     21     $key=~/(.*)F./;
     22     print "\n" unless $old eq $1;
     23     $old=$1;
     24
     25     print $F{$key};
     26     print "     ";
     27
     28 }
     29 print "\n";

ulmer

1. 
   
2. use strict;
   
3. 
   
4. my $new_data = mergen_data(
   
5.     get_data('f1.txt'), get_data('f2.txt')
   
6. );
   
7. print join "\n", @$new_data;
   
8. 
   
9. sub get_data {
   
10.     my ($file) = @_;
    
11.     my $href = {};
    
12.     open F, $file or die "[$file]: $!\n";
    
13.     while(<F>) {
    
14.         chomp;
    
15.         my ($col1, $col2, $rest) = split /\s+/, $_, 3;
    
16.         if ($col1 and $col2) {
    
17.             $href->{$col1.$col2} = $rest;
    
18.         }
    
19.     }
    
20.     return $href;
    
21. }
    
22. 
    
23. sub mergen_data {
    
24.     my ($href1, $href2)= @_;
    
25.     my $aref = [];
    
26.     foreach my $key (keys %$href1) {
    
27.         if (exists $href2->{$key}) {
    
28.             my $value = 'F1: '. $key. ' '. $href1->{$key}. ' '.
    
29.                         'F2: '. $key. ' '. $href2->{$key};
    
30.             push @$aref, $value;
    
31.             delete $href1->{$key};
    
32.             delete $href2->{$key};
    
33.         }
    
34.     }
    
35.     push @$aref, 'F1: '. $href1->{$_} for keys %$href1;
    
36.     push @$aref, 'F2: '. $href2->{$_} for keys %$href2;
    
37.     return $aref;
    
38. }
    

复制代码

toniz

感觉还可以再简单点，第二三步似乎还可以合一起。但是不会写了。  ╮(╯▽╰)╭

#!/usr/bin/perl use strict; use Data::Dumper; open FILE1,"<putext.t1" or die "can't open file: putext.t1.$!"; open FILE2,"<putext.t2" or die "can't open file: putext.t2.$!"; #整理一下 my @F1 = map {"F1 ".$_} <FILE1>; my @F2 = map {"F2 ".$_} <FILE2>; my @sorted = &nbsp;&nbsp;&nbsp;&nbsp;map {$_ ->[2]} &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sort {$a->[1] <=> $b->[1] or $a->[0] cmp $b->[0]} &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;map {[(split)[1,2],$_]}(@F1,@F2); #比较前后两个，相同就加一起。 my @result; while (my $sorted = shift @sorted ){ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$sorted =~ s/(\r\n|\r|\n)//g; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $te1 = (split /\s+/,$sorted)[2]; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $te2 = (split /\s+/,$sorted[0])[2]; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if ($te1 == $te2){ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @result ,$sorted ." ". shift @sorted; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}else{ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @result ,$sorted; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;} } print Dumper @result;

[ 本帖最后由 toniz 于 2009-11-25 11:36 编辑 ]

wanggd1983

原帖由 ulmer 于 2009-11-24 22:25 发表

use strict;

my $new_data = mergen_data(
    get_data('f1.txt'), get_data('f2.txt')
);
print join "\n", @$new_data;

sub get_data {
    my ($file) = @_;
    my $href = {};
    open F, ...

这个生成文件没有问题，但是顺序就乱掉了

DQP

需求有些不清楚地地方
在同一个文件中是否有第一列和第二列都相同的行
是2个文件都不会有这种情况 还是有一个会有 或者2个文件都有这种情况

wanggd1983

原帖由 DQP 于 2009-11-25 15:03 发表
需求有些不清楚地地方
在同一个文件中是否有第一列和第二列都相同的行
是2个文件都不会有这种情况 还是有一个会有 或者2个文件都有这种情况

两个文件内部都不会存在第一列和第二列相同的行，即，如果cut出第一列和第二列，不会有重复的行。
另外，两个文件是按照第一列asc码，第二列数字排序的；
第三点，有些顺序编码（即1，2，3，4，5，6，...）下来的行可能没有，即 可能两个文件都不存在 前两列是“A   7” 的行

其实可以有一些很没效率的方法，比如先 把两个文件cat到一起，然后sort，然后再合并重复的行。。

但是这样就浪费了原先已经排好序的文件信息了。

其实本质上想如何用perl 实现类似comm的算法，还望各位大虾不吝赐教

DQP

哈哈 这个好办. 你要的不就是一对一的merge join么。 回了家再帮你写

wanggd1983

原帖由 DQP 于 2009-11-25 16:40 发表
哈哈 这个好办. 你要的不就是一对一的merge join么。 回了家再帮你写

还望大虾们写完后再大概描述一下如何实现的，感激不禁呀！！