請(qǐng)教perl高手

owwa

請(qǐng)教perl高手一個(gè)較為復(fù)雜的列合并

總體目標(biāo)：合并file1.txt file1.rar (232 Bytes, 下載次數(shù): 160)

2014-06-16 21:39 上傳

點(diǎn)擊文件名下載附件

和file2.txt file2.rar (235 Bytes, 下載次數(shù): 45)

2014-06-16 21:39 上傳

點(diǎn)擊文件名下載附件

，形成file_out.txt file_out.rar (316 Bytes, 下載次數(shù): 197)

2014-06-16 21:39 上傳

點(diǎn)擊文件名下載附件

具體要求：
按文件file1.txt和file2.txt中的1-4列為合并參考值：
如果文件file1.txt和file2.txt中某行1-4列完全相同，則直接合并該行的所有列，如第2,3,5,10,13行。
如果某個(gè)1-4列內(nèi)容存在于文件file1.txt，而不存在于文件file2.txt，則在文件file2.txt中用“0”補(bǔ)齊，合并該行的所有列，如第7,8行。
如果某個(gè)1-4列內(nèi)容存在于文件file2.txt，而不存在于文件file1.txt，則在文件file1.txt中用“0”補(bǔ)齊，合并該行的所有列，如第4,6,9,11,12行。

說(shuō)明：
1）第一行為標(biāo)題行
2）file1.txt和file2.txt文件中有缺值（空白）

圖示文件：
file1

file2

file_out


非常感謝！

huang6894

求并集？
建議樓主搜一搜吧，挺簡(jiǎn)單的。。。


占樓~

24k菜鳥的方法{:3_195:} 弄了四個(gè)hash去做，不好意思了~：

1. my (%hash,%h1,%h2,%h2_1);
   
2. 
   
3. $file1 =  $ARGV[0];
   
4. $file2 =  $ARGV[1];
   
5. 
   
6. while (<>) {
   
7.         chomp;
   
8.         my @h = split(/\t/);
   
9.         my ($k1,$k2,$k3,$k4,@v) = @h[0,1,2,3,4 .. $#h];
   
10.         map{$hash{"$k1\t$k2\t$k3\t$k4"} .= "$_\t"}@v;
    
11. }
    
12. my @merge = keys (%hash);
    
13. open F1, "< $file1" or die "$!";
    
14. open F2, "< $file2" or die "$!";
    
15. while(<F1>){
    
16.         chomp;
    
17.         my @h = split(/\t/);
    
18.         my ($k1,$k2,$k3,$k4) = @h[0,1,2,3];
    
19.         my $t = "0\t" x ($#h-3);
    
20.         $t =~  s/\t$//;
    
21.         $h1{"$k1\t$k2\t$k3\t$k4"} = 1;
    
22.         $h2_1{"not_exit_file1"} = $t;
    
23. }
    
24. close F1;
    
25. while(<F2>){
    
26.         chomp;
    
27.         my @h = split(/\t/);
    
28.         my ($k1,$k2,$k3,$k4) = @h[0,1,2,3];
    
29.         my $t = "0\t" x ($#h-3);
    
30.         $t =~  s/\t$//;
    
31.         $h2{"$k1\t$k2\t$k3\t$k4"} = 1;
    
32.         $h2_1{"not_exit_file2"} = $t;
    
33. }
    
34. close F2;
    
35. my @f1 = keys (%h1);
    
36. my @f2 = keys (%h2);
    
37. for $i (grep {!$h1{$_}} @merge){
    
38.         print "$i\t$hash{$i}$h2_1{not_exit_file1}\n";
    
39. }
    
40. for $i (grep {!$h2{$_}} @merge){
    
41.         chop $hash{$i};
    
42.         print "$i\t$h2_1{not_exit_file2}\t$hash{$i}\n";
    
43. }
    
44. for $i (grep {$h1{$_}} @f2){
    
45.         chop $hash{$i};
    
46.         print "$i\t$hash{$i}\n";
    
47. }

復(fù)制代碼

stanley_tam

偶試試，貌似把所有空的都弄成0了。不知道行不行。。。{:3_193:}

1. #!perl
   
2. use Modern::Perl;
   
3. 
   
4. sub _get_fh;
   
5. 
   
6. my $data_in_txt_href = +{};
   
7. my @headers = ();
   
8. 
   
9. # get the data
   
10. for my $file ('file1.txt', 'file2.txt'){
    
11.     my $fh = _get_fh({file => $file, mode => '<'});
    
12. 
    
13.     my $header = readline $fh;
    
14.     chomp $header;
    
15.     my @header_parts = split /\t/, $header;
    
16. 
    
17.     push @headers, @header_parts[4 .. $#header_parts];
    
18. 
    
19.     while (my $line = readline $fh) {
    
20.         chomp $line;
    
21.         my @parts     = split /\t/, $line;
    
22.         my $first4col = join "\t", @parts[0 .. 3];
    
23. 
    
24.         for my $item (4 .. $#header_parts){
    
25.             $data_in_txt_href->{$first4col}->{ $header_parts[$item] } = $parts[$item] || 0;
    
26.         }
    
27.     }
    
28.     close $fh;
    
29. }
    
30. 
    
31. # output the data
    
32. my $out_fh = _get_fh({file => 'file_out.txt', mode => '>'});
    
33. say {$out_fh} join "\t", ('chrom', 'start', 'end', 'strand', @headers);
    
34. 
    
35. for my $first4col ( sort keys %{$data_in_txt_href} ){
    
36.     my $out_line = $first4col;
    
37. 
    
38.     for my $head_item (@headers){
    
39.         my $item_value = $data_in_txt_href->{$first4col}->{$head_item} || 0;
    
40.         $out_line .= "\t$item_value";
    
41.     }
    
42. 
    
43.     say {$out_fh} $out_line;
    
44. }
    
45. 
    
46. close $out_fh;
    
47. say "Done, cost @{[time - $^T]} seconds, press <ENTER> to exit.";
    
48. <STDIN>;
    
49. 
    
50. 
    
51. sub _get_fh {
    
52.     my $param = shift;
    
53.     my $file = $param->{file};
    
54.     my $mode = $param->{mode};
    
55.     open my $fh, $mode, $file or
    
56.         die "Fail to open file $file:$!\n";
    
57.     return $fh;
    
58. }
    
59. 
    
60. __END__

復(fù)制代碼

owwa

回復(fù) 3# stanley_tam

謝謝stanley兄弟，能實(shí)現(xiàn)。Modern Perl ！   

owwa

回復(fù) 2# huang6894
非常感謝兄弟！我去測(cè)試下。

stanley兄的代碼如果file2.txt中的header名稱與file1.txt的header名稱有重復(fù)的話會(huì)有點(diǎn)問題。




   

owwa

回復(fù) 2# huang6894

謝謝黃兄，經(jīng)測(cè)試發(fā)現(xiàn)代碼處理標(biāo)題行有點(diǎn)問題，標(biāo)題行會(huì)移到文件中去，另外，沒有匹配1-4列時(shí)，插入0的位置不對(duì)。呵呵，多謝多謝！
   

huang6894

回復(fù) 6# owwa


    well~這只是一個(gè)思路，關(guān)于標(biāo)題行。。你把44-47行和37-39行換個(gè)位置就好了

owwa

回復(fù) 7# huang6894

多謝多謝，換行后還是沒在header的位置，一時(shí)沒看明白。
   

huang6894

回復(fù) 8# owwa

1. 
   
2. ===》 perl map5.pl file1.txt file2.txt
   
3. chrom   chromstart      chromend        strand  a1      a2      b1      b2      c1      c2      d1      d2      e1      e2      f1      f2      o1      o2  p1       p2      q1      q2
   
4. chr1    363     364     -       0       10      0       7       0       8       0       3       0.1     10      0       27      0       21      0       11  08
   
5. chr1    33      34      +       0       3       0       20      0       4               0       0.11    9               0       0       1       0       1   017
   
6. chr1    231     232     +       0       3       0       21      0       4               0       0.11    9               0       0       1       0       2   020
   
7. chr1    210     211     +       0       3       0       21      0       4               0       0.11    9               0       0       1       0       2   020
   
8. chr1    13      14      +       0       3       0.06    18      0.33    3               0       0.11    9               0       0       1       0       2   0.05     19
   
9. chr1    217     218     -       0       0       0       0       0       0       0       0       0       0       0       0               0       0       1   023
   
10. chr1    211     212     -       0       0       0       0       0       0       0       0       0       0       0       0               0       0       1   0.09     23
    
11. chr1    232     233     -       0       0       0       0       0       0       0       0       0       0       0       0               0       0       1   024
    
12. chr1    34      35      -       0       0       0       0       0       0       0       0       0       0       0       0               0       0       1   024
    
13. chr1    253     254     -       0       0       0       0       0       0       0       0       0       0       0       0               0       0       1   023
    
14. chr1    216     217     +       0       3       0       21      0       4               0       0.11    9               0       0       0       0       0   00
    
15. chr1    212     213     +       0       3       0       21      0       4               0       0.11    9               0       0       0       0       0   00
    
16. 
    
17. ===》cat map5.pl
    
18. #########################################################################
    
19. #! /usr/bin/perl -w
    
20. # File Name: map5.pl
    
21. # Created Time: 2014年06月17日 星期二 10時(shí)46分35秒
    
22. ## 　　　┏┓　       ┏┓
    
23. ##  　　┏┛┻━━━━━━━━━┛┻┓
    
24. ##  　　┃　  　    　 ┃
    
25. ## 　 　┃　　  ━　　　┃
    
26. ##　  　┃ 　┳┛ 　┗┳   ┃
    
27. ##  　　┃　　　　　　 ┃
    
28. ##  　　┃ **　 ┻  **　┃
    
29. ##  　　┃　　　　　　 ┃
    
30. ##　  　┗━┓　　     ┏━┛
    
31. ##　　　　┃　　   　┃
    
32. ## 　 　　┃　   　　┃
    
33. ##　　　　┃　　   　┗━━━┓
    
34. ##　　　　┃　　　　 　　┣┓
    
35. ## 　 　　┃　　　　　　 ┏┛
    
36. ## 　　 　┗┓┓┏━━━━━━━┳┓┏┛
    
37. ## 　　　　┃┫┫　     ┃┫┫
    
38. ##　 　　　┗┻┛　     ┗┻┛
    
39. ## ━━━━━━神獸保佑，代碼無(wú)bug━━━━━━
    
40. ## Code is far away from bug with the animal protecting.
    
41. #########################################################################
    
42. my (%hash,%h1,%h2,%h2_1);
    
43. 
    
44. $file1 =  $ARGV[0];
    
45. $file2 =  $ARGV[1];
    
46. 
    
47. while (<>) {
    
48.         chomp;
    
49.         my @h = split(/\t/);
    
50.         my ($k1,$k2,$k3,$k4,@v) = @h[0,1,2,3,4 .. $#h];
    
51.         map{$hash{"$k1\t$k2\t$k3\t$k4"} .= "$_\t"}@v;
    
52. #       print "$k1\t$k2\t$k3\t$k4\t".$hash{"$k1\t$k2\t$k3\t$k4"}."\n";
    
53. }
    
54. my @merge = keys (%hash);
    
55. open F1, "< $file1" or die "$!";
    
56. open F2, "< $file2" or die "$!";
    
57. while(<F1>){
    
58.         chomp;
    
59.         my @h = split(/\t/);
    
60.         my ($k1,$k2,$k3,$k4) = @h[0,1,2,3];
    
61.         my $t = "0\t" x ($#h-3);
    
62.         $t =~  s/\t$//;
    
63.         $h1{"$k1\t$k2\t$k3\t$k4"} = 1;
    
64.         $h2_1{"not_exit_file1"} = $t;
    
65. }
    
66. close F1;
    
67. while(<F2>){
    
68.         chomp;
    
69.         my @h = split(/\t/);
    
70.         my ($k1,$k2,$k3,$k4) = @h[0,1,2,3];
    
71.         my $t = "0\t" x ($#h-3);
    
72.         $t =~  s/\t$//;
    
73.         $h2{"$k1\t$k2\t$k3\t$k4"} = 1;
    
74.         $h2_1{"not_exit_file2"} = $t;
    
75. }
    
76. close F2;
    
77. my @f1 = keys (%h1);
    
78. my @f2 = keys (%h2);
    
79. for $i (grep {$h1{$_}} @f2){
    
80.         chop $hash{$i};
    
81.         print "$i\t$hash{$i}\n";
    
82. }
    
83. 
    
84. for $i (grep {!$h1{$_}} @merge){
    
85.         chop $hash{$i};
    
86.         print "$i\t$h2_1{not_exit_file1}\t$hash{$i}\n";
    
87. }
    
88. for $i (grep {!$h2{$_}} @merge){
    
89.         chop $hash{$i};
    
90.         print "$i\t$hash{$i}\t$h2_1{not_exit_file2}\n";
    
91. }
    
92. 
    

復(fù)制代碼

owwa

回復(fù) 9# huang6894

非常感謝黃兄！奇怪的是我這里標(biāo)題行總是在第二行。