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

#!/usr/bin/perl -w
use strict;
use Data::Dumper;
my($ref,$lnc,$contain,$overlap,$gapped,$reverse);
open($ref,$ARGV[0]) or die $!;
open($lnc,$ARGV[1]) or die $!;
open($contain,'>','contain.txt') or die $!;
open($overlap,'>','overlap.txt') or die $!;
open($gapped ,'>','gapped.txt') or die $!;
open($reverse,'>','reverse.txt') or die $!;
my %hRefDB;
while (<$ref>){
my ($chr, $beg, $end) = (split)[1,2,3]; #Tab拆分，并取第二，第三，第四个元素。
push @{ $hRefDB{$chr}}, [$beg,$end]; #存入哈希数组。
}
while (<$lnc>) {
my ($chr,$beg,$end) = (split)[1,2,3]; #Tab拆分，并取第二，第三，第四个元素。
if (!exists $hRefDB{$chr}) {
print "not exists in refDB\n";
next;
}
my $lnc = [$beg,$end];
my ($is_contain,$is_overlap,$is_reverse) = (0,0,0);
foreach my $ref (@{$hRefDB{$chr}}){ #遍历哈希数组的每个元素。
last if $is_contain and $is_overlap and $is_reverse;
unless ($is_contain){ #除非$is_contain的值为0，否则，将is_contain($lnc,$ref)的返回值赋值给 $is_contain。
$is_contain = is_contain($lnc,$ref)
and next;
}
unless ($is_reverse){
$is_reverse = is_reverse($lnc,$ref)
and next;
}
unless ($is_overlap){
$is_overlap = is_overlap($lnc,$ref)
and next;
}
}
my $is_gapped = $is_contain || $is_reverse || $is_overlap ? 0:1;
print $contain $_ if $is_contain;
print $overlap $_ if $is_overlap;
print $gapped $_ if $is_gapped;
print $reverse $_ if $is_reverse;
}
sub is_ln {
my($num,$ref) = @_;
return $num >= $ref->[0] && $num <=$ref->[1] ? 1:0;
}
sub is_contain {
my ($lnc,$ref) = @_;
return (is_ln($lnc->[0],$ref) && is_ln($lnc->[1],$ref)) ? 1:0;
}
sub is_reverse {
my ($lnc,$ref) = @_;
return is_contain($ref,$lnc);
}
sub is_overlap {
my ($lnc,$ref) = @_;
return (is_ln($lnc->[0],$ref) && ! is_ln($lnc->[1],$ref)) ||
(is_ln($lnc->[1],$ref) && ! is_ln($lnc->[0],$ref)) ? 1:0;
}
sub is_gapped {
my ($lnc,$ref) = @_;
return (! is_ln($lnc->[0],$ref) && ! is_ln($lnc->[1],$ref)) ? 1:0;
}

复制代码

ERROR!!
delete

复制代码

ERROR!!
delete

复制代码

#!/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';
$cor eq 'ove' ? push @{ $Q{$cor} }, $R : $Q{$cor}++;
}
my $all = 0;
$all += ref $_ eq 'ARRAY' ? @$_ : $_ for values %Q;
$Q{gap}++ if @R > $all;
for ( keys %Q ) {
print { $fh[ $index{$_} ] } $L and next if $_ ne 'ove';
my @p = ( $L, @{ $Q{$_} } );
s/\r?\n$// for @p;
say { $fh[ $index{$_} ] } "@p";
}
}
}

复制代码

#!/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;
}
}

复制代码

#!/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;
}
}

复制代码