求大神帮写一个去除交集的perl脚本！！

jason680

回复 26# felix0608

$ perl remove_over.pl
scaffold1        245        290
scaffold1        676        718
scaffold1        1027        1112
...
scaffold1        260446        260450
scaffold1        260660        261439

$ cat remove_over.pl

1. use strict;
   
2. use warnings;
   
3. 
   
4. my $DEBUG = 0;
   
5. my $sFile_data = "file1";
   
6. my $sFile_over = "file2";
   
7. 
   
8. open( my $FHdata, "<", $sFile_data) or die "cannot open $sFile_data\n";
   
9. open( my $FHover, "<", $sFile_over) or die "cannot open $sFile_over\n";
   
10. 
    
11. sub DBGprint{ print "  >>> DEBUG: @_" if $DEBUG};
    
12. 
    
13. 
    
14. sub get_next{
    
15.   my ($FH) = @_;
    
16.   my $sLine = <$FH>;
    
17.   if(! defined $sLine){
    
18.     DBGprint "cannot read file\n";
    
19.     return;
    
20.     exit;
    
21.   }
    
22.   chomp $sLine;
    
23.   my @aRet = split(/\s+/,$sLine);
    
24.   DBGprint "get_next, @aRet\n";
    
25.   return @aRet;
    
26. }
    
27. sub Xprint{
    
28.   my( $sId, $sStart, $sEndof) = @_;
    
29.   print "$sId\t$sStart\t$sEndof\n";
    
30. }
    
31. sub remove_over(++){
    
32.   my ($raData, $raOver) = @_;
    
33.   DBGprint "data=@{$raData}, Over=@{$raOver} \n";
    
34. 
    
35.   exit if(! defined $raData->[0]);
    
36.   if(! defined $raOver->[0]){
    
37.     Xprint @{$raData};
    
38.     return(1,0);
    
39.   }
    
40.   # ID different
    
41.   # Data: scaffold1  ss xx
    
42.   # Over: scaffold2  tt yy
    
43.   if( $raData->[0] ne $raOver->[0]){
    
44.     Xprint @{$raData};
    
45.     return (1,0);
    
46.   }
    
47.   
    
48.   # ID same
    
49. 
    
50.   # Data: scaffold1  1 15
    
51.   if($raData->[1] == $raOver->[1]){
    
52.     # Over: scaffold1  1 15
    
53.     return(1,1) if ($raData->[2] == $raOver->[2]);
    
54. 
    
55.     # Over: scaffold1  1 20
    
56.     return(1,0) if ($raData->[2] <  $raOver->[2]);
    
57.    
    
58.     # Data: scaffold1  1  15
    
59.     # Over: scaffold1  1  13
    
60.     # change Data start to 14 (Note: 13 + 1)
    
61.     $raData->[1] = $raOver->[2]+1;
    
62.     # Data: scaffold1  14 15
    
63.     # and read Over file
    
64.     return(0,1);
    
65.   }
    
66. 
    
67.   # Over start is more Data start
    
68.   # Data: scaffold1  1  xx
    
69.   # Over: scaffold1  10 yy
    
70.   if($raData->[1] < $raOver->[1]){
    
71.    
    
72.     # Data: scaffold1  1  15
    
73.     if($raData->[2] < $raOver->[1]){
    
74.       # Over: scaffold1  20 yy
    
75.       # Output: scaffold1 1 15
    
76.       Xprint($raData->[0], $raData->[1], $raData->[2]);
    
77.       return(1,0);
    
78.     }
    
79.     if($raData->[2] == $raOver->[1]){
    
80.       # Over: scaffold1  15 yy
    
81.       # Output: scaffold1 1 14
    
82.       Xprint($raData->[0], $raData->[1], $raData->[2] -1);
    
83.       return(1,0);
    
84.     }
    
85. 
    
86.     # Data: scaffold1  1  15
    
87.     # Over: scaffold1  10 yy
    
88.     # Output: scaffold1 1 9
    
89.     Xprint($raData->[0], $raData->[1], $raOver->[1]-1);
    
90. 
    
91.     # Over: scaffold1  10 15
    
92.     return(1,1) if ($raData->[2] == $raOver->[2]);
    
93. 
    
94.     # Over: scaffold1  10 20
    
95.     return(1,0) if ($raData->[2] <  $raOver->[2]);
    
96. 
    
97.     # Data: scaffold1  1  15
    
98.     # Over: scaffold1  10 13
    
99.     # change Data start to 14 (Note: 13 + 1)
    
100.     $raData->[1] = $raOver->[2]+1;
     
101.     # Data: scaffold1  14 15
     
102.     # and read Over file
     
103.     return(0,1);
     
104.   }
     
105.   
     
106.   # Data: scaffold1  3  xx
     
107.   # Over: scaffold1  1  3
     
108.   if($raData->[1] == $raOver->[2]){
     
109.     $raData->[1] = $raOver->[2] + 1;
     
110.     return(0,1);
     
111.   }
     
112.   if($raData->[1] < $raOver->[2]){
     
113.     # Data: scaffold1  3  10
     
114.     # Over: scaffold1  1  13
     
115.     if($raData->[2] < $raOver->[2]){
     
116.       return(1,0);
     
117.     }
     
118. 
     
119.     # Data: scaffold1  3  10
     
120.     # Over: scaffold1  1  5
     
121.     $raData->[1] = $raOver->[2] + 1;
     
122.   }
     
123.   return(0,1);
     
124. }
     
125. sub FLGprint{
     
126.   my ($sFlg, $sMesg) = @_;
     
127.   DBGprint "$sMesg" if $sFlg;
     
128. }
     
129. 
     
130. $DEBUG=1 if(@ARGV >=1 && $ARGV[0] eq '-d');
     
131. my $sRead_data = 1;
     
132. my $sRead_over = 1;
     
133. my (@aData, @aOver);
     
134. my $sCnt = 0;
     
135. while(1){
     
136.     $sCnt++;
     
137.     DBGprint "Cycle: $sCnt\n";
     
138.     FLGprint $sRead_data, "Read Data\n";
     
139.     @aData = get_next($FHdata) if($sRead_data == 1);
     
140.     FLGprint $sRead_over, "Read Over\n";
     
141.     @aOver = get_next($FHover) if($sRead_over == 1);
     
142.     ($sRead_data, $sRead_over) = remove_over(@aData, @aOver);
     
143.     #exit if($sCnt > 500);
     
144. }

复制代码

一个人取暖

回复 1# felix0608


    给你个思路，去寻找一个叫做 并查集 的算法，可以满足你

xiumu2280

1. #!/usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. 
   
5. open (FILE1,"C:\\Users\\Desktop\\Test\\2014_1_23\\file1.txt");
   
6. open (FILE2,"C:\\Users\\Desktop\\Test\\2014_1_23\\file2.txt");
   
7. open (OUT,">C:\\Users\\Desktop\\Test\\2014_1_23\\11.txt");
   
8. 
   
9. my %hash_group;
   
10. map {
    
11.         chomp;
    
12.         my ($key,$start,$end) = split;
    
13.         push @{$hash_group{$key}},($start..$end)
    
14. }<FILE2>;
    
15. 
    
16. 
    
17. while (<FILE1>) {
    
18.         chomp;
    
19.         my ($key,$start,$end) = split;
    
20.         my %uniq;
    
21.         @uniq{@{$hash_group{$key}}}=@{$hash_group{$key}};
    
22.         my @data =sort {$a <=> $b} grep {!$uniq{$_}}($start..$end);
    
23.         my @zone;
    
24.         map {
    
25.                 my $n = $_;
    
26.                 $n == 0 && push @zone,$data[$n];
    
27.                 $n+1<=$#data && $data[$n+1]-$data[$n]>1 && push @zone,($data[$n],$data[$n+1]);
    
28.                 $n==$#data && push @zone,$data[-1];
    
29.         }0..$#data;
    
30. 
    
31.         for (1..($#zone+1)) {
    
32.                 $_%2
    
33.                         ? print OUT "$key\t$zone[$_-1]\t"
    
34.                         : print OUT "$zone[$_-1]\n";
    
35.         }
    
36. }

复制代码

楼主来一发试试

xiumu2280

1. scaffold1        245        290
   
2. scaffold1        676        718
   
3. scaffold1        1027        1112
   
4. scaffold1        1330        1331
   
5. scaffold1        1647        1652
   
6. scaffold1        1911        2033
   
7. scaffold1        2285        2510
   
8. scaffold1        2672        3005
   
9. scaffold1        3127        3844
   
10. scaffold1        3945        3946
    
11. scaffold1        4080        4172
    
12. scaffold1        4353        5019
    
13. scaffold1        5126        5129
    
14. scaffold1        5230        5967
    
15. scaffold1        6133        7598
    
16. scaffold1        7703        8313
    
17. scaffold1        8581        8656
    
18. scaffold1        8814        9155
    
19. scaffold1        9377        9724
    
20. scaffold1        11200        11205
    
21. scaffold1        13849        13880
    
22. scaffold1        13981        13985
    
23. scaffold1        14149        14172
    
24. scaffold1        14476        14758
    
25. scaffold1        15305        15428
    
26. scaffold1        15607        15691
    
27. scaffold1        15798        15897
    
28. scaffold1        16172        16439
    
29. scaffold1        18075        18655
    
30. scaffold1        22506        22525
    
31. scaffold1        53109        55597
    
32. scaffold1        64277        76351
    
33. scaffold1        84997        85240
    
34. scaffold1        91210        98127
    
35. scaffold1        98569        99022
    
36. scaffold1        101188        102851
    
37. scaffold1        105232        105249
    
38. scaffold1        113602        116343
    
39. scaffold1        124999        125184
    
40. scaffold1        125930        126558
    
41. scaffold1        134339        134668
    
42. scaffold1        141085        141482
    
43. scaffold1        141576        142066
    
44. scaffold1        142183        142295
    
45. scaffold1        142368        142817
    
46. scaffold1        143613        145919
    
47. scaffold1        146106        146119
    
48. scaffold1        146456        146501
    
49. scaffold1        147426        147715
    
50. scaffold1        148846        149512
    
51. scaffold1        149776        149813
    
52. scaffold1        150361        150747
    
53. scaffold1        158353        160761
    
54. scaffold1        165280        165383
    
55. scaffold1        165486        165737
    
56. scaffold1        166810        173128
    
57. scaffold1        174606        175266
    
58. scaffold1        176688        179222
    
59. scaffold1        183911        184183
    
60. scaffold1        186787        188238
    
61. scaffold1        190183        191560
    
62. scaffold1        192206        195941
    
63. scaffold1        202089        202265
    
64. scaffold1        202944        203048
    
65. scaffold1        208786        208979
    
66. scaffold1        211069        211420
    
67. scaffold1        212044        212069
    
68. scaffold1        217631        217813
    
69. scaffold1        218313        219423
    
70. scaffold1        222785        226870
    

复制代码

jzp520520

回复 42# 一个人取暖
看了下并查集的介绍，是实现将元素归类并快速查找的高效算法；
而楼主是想要将两个集合比较，除去交集，得到补集的高效算法。

   

xiumu2280

大神，学习了···
这才是专业的
真心太厉害！！！！
回复 41# jason680


   

jzp520520

大神们都很犀利，jason是术业有专攻啊，工作语言主要是perl吗？

一个人取暖

回复 45# jzp520520


    再去好好看吧

pitonas

请问大大, 我没想明白这个问题的是怎么使用 并查集 的算法。
请大大指点。
{:2_172:} 感激

一个人取暖 发表于 2014-01-23 13:43
回复 1# felix0608

junglegq

Is it what you want?

#!/usr/bin/perl -w

use strict;

open F1, '<file1' or die "Can't open file: $!\n";
open F2, '<file2' or die "Can't open file: $!\n";
open OUT, '>output' or die "Can't open file: $!\n";


my %f2_ha;

while (<F2>) {
        my ($x, $y) = (split)[1,2];
        $f2_ha{$x} = $y;        # dup data will be overridden as we don't care.
}

while (<F1>) {
        my ($name, $x,$y) = split;
        next if ( exists $f2_ha{$x} && $f2_ha{$x} eq $y );

        print OUT $_;
}