【求助改程序高手帮我改下这个程序】，只需输出结果中加入一些数据

rubyish

3Q~
是否适合:

1. 
   
2. ERROR!!
   
3. delete
   
4. 
   

复制代码

yanglc2013

回复 11# rubyish
行啊。谢谢老大啊

rubyish

看懂 le

1. #!/usr/bin/perl
   
2. use 5.016;
   
3. my @in    = qw/refGene.txt lncipedia_location.txt/;
   
4. my @out   = qw/gapped contain overlap  reverse/;
   
5. my %index = qw/gap 0 con 1 ove 2  rev 3/;
   
6. my ( $r, $l ) = map { open my ($f), $_; $f } @in;
   
7. my @fh = map { open my ($f), '>', $_; $f } @out;
   
8. my ( %r, %l );
   
9. map { @_ = split /\t/, $_, 5; push @{ $r{ $_[1] } }, [ @_[ 2, 3 ], $_ ] } <$r>;
   
10. map { @_ = split; push @{ $l{ $_[1] } }, [ @_[ 2, 3 ], $_ ] } <$l>;
    
11. 
    
12. while ( my ( $k, $v ) = each %l ) {
    
13.     next unless $r{$k};
    
14.     my @L = sort { $a->[0] <=> $b->[0] } @$v;
    
15.     my @R = sort { $b->[1] <=> $a->[1] } @{ $r{$k} };
    
16.     for my $l (@L) {
    
17.         my ( $A, $B, $L, %Q ) = @$l;
    
18.         for my $r ( @R ) {
    
19.             my ( $C, $D, $R ) = @$r;
    
20.             next if $B < $C;
    
21.             last if $A > $D;
    
22.             my $cor =
    
23.                 ( $C <= $A and $B <= $D ) ? 'con'
    
24.               : ( $A < $C  and $D < $B )  ? 'rev'
    
25.               :                             'ove';
    
26.             $cor eq 'ove' ? push @{ $Q{$cor} }, $R : $Q{$cor}++;
    
27.         }
    
28.         my $all = 0;
    
29.         $all += ref $_ eq 'ARRAY' ? @$_ : $_ for values %Q;
    
30.         $Q{gap}++ if @R > $all;
    
31.         for ( keys %Q ) {
    
32.             print { $fh[ $index{$_} ] } $L and next if $_ ne 'ove';
    
33.             my @p = ( $L, @{ $Q{$_} } );
    
34.             s/\r?\n$// for @p;
    
35.             say { $fh[ $index{$_} ] } "@p";
    
36.         }
    
37.     }
    
38. }

复制代码

rubyish

yanglc2013 发表于 2013-04-04 11:41
回复 11# rubyish
行啊。谢谢老大啊

BU 行啊。
有 ERROR!!
输出有少了!

yanglc2013

回复 13# rubyish
老大还有gapped的呢？


   

rubyish

overlay, contain, reverse, gapped
lnc
|| ref
|| ref
...
gapped => BIG FILE

1. #!/usr/bin/perl
   
2. use 5.016;
   
3. my @in    = qw/refGene.txt lncipedia_location.txt/;
   
4. my @out   = qw/gapped contain overlap  reverse/;
   
5. my %index = qw/gap 0 con 1 ove 2  rev 3/;
   
6. my ( $r, $l ) = map { open my ($f), $_; $f } @in;
   
7. my @fh = map { open my ($f), '>', $_; $f } @out;
   
8. my ( %r, %l );
   
9. map { @_ = split /\t/, $_, 5; push @{ $r{ $_[1] } }, [ @_[ 2, 3 ], $_ ] } <$r>;
   
10. map { @_ = split; push @{ $l{ $_[1] } }, [ @_[ 2, 3 ], $_ ] } <$l>;
    
11. 
    
12. while ( my ( $k, $v ) = each %l ) {
    
13.     next unless $r{$k};
    
14.     my @L = sort { $a->[0] <=> $b->[0] } @$v;
    
15.     my @R = sort { $b->[1] <=> $a->[1] } @{ $r{$k} };
    
16.     my %RO = map { $_ => $R[$_][2] } 0 .. $#R;
    
17.     for my $l (@L) {
    
18.         my ( $A, $B, $L, %Q ) = @$l;
    
19.         my %R = %RO;
    
20.         for my $ri ( 0 .. $#R ) {
    
21.             my ( $C, $D, $R ) = @{ $R[$ri] };
    
22.             next if $B < $C;
    
23.             last if $A > $D;
    
24.             my $cor =
    
25.                 ( $C <= $A and $B <= $D ) ? 'con'
    
26.               : ( $A < $C  and $D < $B )  ? 'rev'
    
27.               :                             'ove';
    
28.             push @{ $Q{$cor} }, $R;
    
29.             delete $R{$ri};
    
30.         }
    
31.         $Q{gap} = [ values %R ] if %R;
    
32.         local $, = "|| ";
    
33.         print { $fh[ $index{$_} ] } $L, @{ $Q{$_} } for keys %Q;
    
34.     }
    
35. }

复制代码

overlay, contain, reverse
lnc
|| ref
|| ref
...
gapped
lnc

1. #!/usr/bin/perl
   
2. use 5.016;
   
3. my @in    = qw/refGene.txt lncipedia_location.txt/;
   
4. my @out   = qw/gapped contain overlap  reverse/;
   
5. my %index = qw/gap 0 con 1 ove 2  rev 3/;
   
6. my ( $r, $l ) = map { open my ($f), $_; $f } @in;
   
7. my @fh = map { open my ($f), '>', $_; $f } @out;
   
8. my ( %r, %l );
   
9. map { @_ = split /\t/, $_, 5; push @{ $r{ $_[1] } }, [ @_[ 2, 3 ], $_ ] } <$r>;
   
10. map { @_ = split; push @{ $l{ $_[1] } }, [ @_[ 2, 3 ], $_ ] } <$l>;
    
11. 
    
12. while ( my ( $k, $v ) = each %l ) {
    
13.     next unless $r{$k};
    
14.     my @L = sort { $a->[0] <=> $b->[0] } @$v;
    
15.     my @R = sort { $b->[1] <=> $a->[1] } @{ $r{$k} };
    
16.     for my $l (@L) {
    
17.         my ( $A, $B, $L, %Q ) = @$l;
    
18.         for my $r ( @R ) {
    
19.             my ( $C, $D, $R ) = @$r;
    
20.             next if $B < $C;
    
21.             last if $A > $D;
    
22.             my $cor =
    
23.                 ( $C <= $A and $B <= $D ) ? 'con'
    
24.               : ( $A < $C  and $D < $B )  ? 'rev'
    
25.               :                             'ove';
    
26.             push @{ $Q{$cor} }, $R;
    
27.         }
    
28.         my $all = 0;
    
29.         $all += @$_ for values %Q;
    
30.         $Q{gap} = [] if @R > $all;
    
31.         local $, = "|| ";
    
32.         print { $fh[ $index{$_} ] } $L, @{ $Q{$_} } for keys %Q;
    
33.     }
    
34. }

复制代码