- 论坛徽章:
- 7
|
overlay, contain, reverse, gapped
lnc
|| ref
|| ref
...
gapped => BIG FILE- #!/usr/bin/perl
- use 5.016;
- my @in = qw/refGene.txt lncipedia_location.txt/;
- my @out = qw/gapped contain overlap reverse/;
- my %index = qw/gap 0 con 1 ove 2 rev 3/;
- my ( $r, $l ) = map { open my ($f), $_; $f } @in;
- my @fh = map { open my ($f), '>', $_; $f } @out;
- my ( %r, %l );
- map { @_ = split /\t/, $_, 5; push @{ $r{ $_[1] } }, [ @_[ 2, 3 ], $_ ] } <$r>;
- map { @_ = split; push @{ $l{ $_[1] } }, [ @_[ 2, 3 ], $_ ] } <$l>;
- while ( my ( $k, $v ) = each %l ) {
- next unless $r{$k};
- my @L = sort { $a->[0] <=> $b->[0] } @$v;
- my @R = sort { $b->[1] <=> $a->[1] } @{ $r{$k} };
- my %RO = map { $_ => $R[$_][2] } 0 .. $#R;
- for my $l (@L) {
- my ( $A, $B, $L, %Q ) = @$l;
- my %R = %RO;
- for my $ri ( 0 .. $#R ) {
- my ( $C, $D, $R ) = @{ $R[$ri] };
- next if $B < $C;
- last if $A > $D;
- my $cor =
- ( $C <= $A and $B <= $D ) ? 'con'
- : ( $A < $C and $D < $B ) ? 'rev'
- : 'ove';
- push @{ $Q{$cor} }, $R;
- delete $R{$ri};
- }
- $Q{gap} = [ values %R ] if %R;
- local $, = "|| ";
- print { $fh[ $index{$_} ] } $L, @{ $Q{$_} } for keys %Q;
- }
- }
复制代码 overlay, contain, reverse
lnc
|| ref
|| ref
...
gapped
lnc
- #!/usr/bin/perl
- use 5.016;
- my @in = qw/refGene.txt lncipedia_location.txt/;
- my @out = qw/gapped contain overlap reverse/;
- my %index = qw/gap 0 con 1 ove 2 rev 3/;
- my ( $r, $l ) = map { open my ($f), $_; $f } @in;
- my @fh = map { open my ($f), '>', $_; $f } @out;
- my ( %r, %l );
- map { @_ = split /\t/, $_, 5; push @{ $r{ $_[1] } }, [ @_[ 2, 3 ], $_ ] } <$r>;
- map { @_ = split; push @{ $l{ $_[1] } }, [ @_[ 2, 3 ], $_ ] } <$l>;
- while ( my ( $k, $v ) = each %l ) {
- next unless $r{$k};
- my @L = sort { $a->[0] <=> $b->[0] } @$v;
- my @R = sort { $b->[1] <=> $a->[1] } @{ $r{$k} };
- for my $l (@L) {
- my ( $A, $B, $L, %Q ) = @$l;
- for my $r ( @R ) {
- my ( $C, $D, $R ) = @$r;
- next if $B < $C;
- last if $A > $D;
- my $cor =
- ( $C <= $A and $B <= $D ) ? 'con'
- : ( $A < $C and $D < $B ) ? 'rev'
- : 'ove';
- push @{ $Q{$cor} }, $R;
- }
- my $all = 0;
- $all += @$_ for values %Q;
- $Q{gap} = [] if @R > $all;
- local $, = "|| ";
- print { $fh[ $index{$_} ] } $L, @{ $Q{$_} } for keys %Q;
- }
- }
复制代码 |
|