perl區(qū)間交集

清泉一邊1

第2列三列沒用,那么用每一行的第5列和第6列與下面各列的進(jìn)行比較，5列為起始坐標(biāo)，6列為終止坐標(biāo)。輸出他們的最大交集（即如果坐標(biāo)區(qū)間有重疊,則合并之并取其最小的起始坐標(biāo)和最大的終止坐標(biāo)）
a.1        1        3        1_b        2        8
a.2        2        5        1_b        5        9
a.3        3        6        1_b        4        7
a.4        2        4        1_b        12        15
c.1        3        8        1_d        1        7
c.2        4        8        1_d        6        8
理想輸出
a        1_b        2-9_12-15
c        1_d        1        8
另外還需要輸出另一個文件，即最小交集（如果坐標(biāo)區(qū)間有重疊,則合并之并取其最大的起始坐標(biāo)和最小的終止坐標(biāo)）
理想結(jié)果是
a        1_b        5-7_12-15
c        1_d        6        7
菜鳥，之前大神們寫的程序我改不對，懇請大神幫我再寫個吧！

yinyuemi

回復(fù) 1# 清泉一邊1

1. #/usr/bin/env perl
   
2. 
   
3. use strict;
   
4. use Data::Dumper;
   
5. 
   
6. my %h;
   
7. 
   
8. while(<DATA>){
   
9.     chomp;
   
10.     my @a = split;
    
11.     my $k = substr($a[0],0,1)."\t".$a[3];
    
12.     $h{$k}{min} = $a[4] if $h{$k}{min} > $a[4] or ! defined $h{$k}{min};
    
13.     $h{$k}{$a[4]} = $a[5];
    
14. }
    
15. my %max;
    
16. my %min;
    
17. my $start;
    
18. my $end;
    
19. foreach my $k(keys %h){
    
20.     foreach my $t (sort{$a<=>$b}grep{/\d/}keys %{$h{$k}}){
    
21.         if($t == $h{$k}{min} || $t > $max{$k}{$start}->[-1]){
    
22.             $max{$k}{$t} = [$t,$h{$k}{$t}];
    
23.             $min{$k}{$t} = [$h{$k}{$t}-$t,$t."-".$h{$k}{$t}];
    
24.             $start = $t;
    
25.         }elsif($t <= $max{$k}{$start}->[-1] ){  
    
26.             $min{$k}{$start} = [$end-$t,$t."-".$end] if $min{$k}{$start}->[0] > ($end-$t);
    
27.                         $max{$k}{$start} = [$start,$h{$k}{$t}] if $h{$k}{$t} > $max{$k}{$start}->[-1];
    
28.         }
    
29.                 $end = $h{$k}{$t};
    
30.     }
    
31. }
    
32. 
    
33. print "Max Gap\n";
    
34. foreach my $k (keys %max){
    
35.         print $k,"\t";
    
36.         print join "_",map{join "-",@{$max{$k}{$_}}}(sort{$a<=>$b}keys %{$max{$k}});
    
37.         print "\n";
    
38. }
    
39. print "Min Gap\n";
    
40. foreach my $k (keys %min){
    
41.         print $k,"\t";
    
42.         print join "_",map{@{$min{$k}{$_}}[1]}(sort{$a<=>$b}keys %{$min{$k}});
    
43.         print "\n";
    
44. }
    
45. 
    
46. 
    
47. __DATA__
    
48. a.1        1        3        1_b        2        8
    
49. a.2        2        5        1_b        5        9
    
50. a.3        3        6        1_b        4        7
    
51. a.4        2        4        1_b        12        15
    
52. c.1        3        8        1_d        1        7
    
53. c.2        4        8        1_d        6        8
    
54. 
    
55. -----output-----
    
56. Max Gap
    
57. a       1_b     2-9_12-15
    
58. c       1_d     1-8
    
59. Min Gap
    
60. a       1_b     5-7_12-15
    
61. c       1_d     6-7
    
62. 
    

復(fù)制代碼

rubyish

biru:

1. #!/usr/bin/perl
   
2. my @files = qw/file1 file2/;    # for output
   
3. 
   
4. my ( @I, @data, %data ) = ( [ 0, 1 ], [ 2, 3 ] );
   
5. while (<DATA>) {
   
6.     my ( $A, $B, @C ) = ( /^(\w+)/, (split)[ 3, 4, 5 ] );
   
7.     push @data, $A if !@data || ( $data[-1] ne $A );
   
8.     push @{ $data{$A}{$B} }, [@C];
   
9. }
   
10. my @F = map { open my $f, '>', $_; $f } @files;
    
11. for my $i (@data) {
    
12.     for my $j ( keys %{ $data{$i} } ) {
    
13.         my @a = sort { $a->[0] <=> $b->[0] } @{ $data{$i}{$j} };
    
14.         my @b = shift @a;
    
15.         $_->[0] > $b[-1][1] ? push @b, $_ : push @{$b[-1]}, @$_ for @a;
    
16.         @b = map {
    
17.           [ ( sort { $a <=> $b } @$_ )[ 0, -1, $#$_ / 2, @$_ / 2 ] ]
    
18.         } @b[ @b >= 2 ? ( 0, -1 ) : 0 ];
    
19.         my @result = @b > 1
    
20.         ? map { @_ = @$_; join '_', map { join '-', @{$_}[@_] } @b } @I
    
21.         : map { join "\t", @{ $b[0] }[ @$_ ] } @I;
    
22.         print { $F[$_] } "$i\t$j\t$result[$_]\n" for 0 .. 1;
    
23.     }
    
24. }
    
25. 
    
26. __DATA__
    
27. a.1        1        3        1_b        2        8
    
28. a.2        2        5        1_b        5        9
    
29. a.3        3        6        1_b        4        7
    
30. a.4        2        4        1_b        12        15
    
31. c.1        3        8        1_d        1        7
    
32. c.2        4        8        1_d        6        8
    

復(fù)制代碼

清泉一邊1

謝謝�。�！回復(fù) 3# rubyish


   

yestreenstars

我也來一發(fā)~

1. [root@localhost ~]# cat p
   
2. #!/usr/bin/perl
   
3. use 5.010;
   
4. 
   
5. open FILE1, ">a";
   
6. open FILE2, ">b";
   
7. my %h;
   
8. 
   
9. while (<DATA>) {
   
10.         @_ = split;
    
11.         $_[0] =~ s/\..*//;
    
12.         my $t = $_[0]."\t".$_[3];
    
13.         push @{ $h{$t} }, [ @_[ 4, 5 ] ];
    
14. }
    
15. 
    
16. for ( sort keys %h ) {
    
17.         my @A = sort { $a->[0] <=> $b->[0] } @{ $h{$_} };
    
18.         my @M = shift @A;
    
19.         my @N = ( [ $M[0][0], $M[0][1] ] );
    
20.         for (@A) {
    
21.                 $_->[0] > $M[-1][1] && push @M, $_ and push @N, $_;
    
22.                 $_->[1] > $M[-1][1] && ( $M[-1][1] = $_->[1] );
    
23.                 $_->[0] > $N[-1][0] && ( $N[-1][0] = $_->[0] );
    
24.                 $_->[1] < $N[-1][1] && ( $N[-1][1] = $_->[1] );
    
25.         }
    
26.         printf FILE1 "%s\t%s\n", $_, join "_", map { join "-", @$_ } @M;
    
27.         printf FILE2 "%s\t%s\n", $_, join "_", map { join "-", @$_ } @N;
    
28. }
    
29. 
    
30. __DATA__
    
31. a.1        1        3        1_b        2        8
    
32. a.2        2        5        1_b        5        9
    
33. a.3        3        6        1_b        4        7
    
34. a.4        2        4        1_b        12       15
    
35. c.1        3        8        1_d        1        7
    
36. c.2        4        8        1_d        6        8
    
37. [root@localhost ~]# ./p
    
38. [root@localhost ~]# head a b
    
39. ==> a <==
    
40. a       1_b     2-9_12-15
    
41. c       1_d     1-8
    
42. 
    
43. ==> b <==
    
44. a       1_b     5-7_12-15
    
45. c       1_d     6-7
    
46. [root@localhost ~]#

復(fù)制代碼