|
0
|
1 #!/usr/bin/env perl
|
|
|
2
|
|
|
3 use strict ;
|
|
|
4 use warnings ;
|
|
|
5
|
|
|
6 die "usage: a.pl intronA intronB [op]\n" if (@ARGV == 0 ) ;
|
|
|
7
|
|
|
8 my %intronInfo ;
|
|
|
9 my %chromRank ;
|
|
|
10
|
|
|
11 sub sortIntron
|
|
|
12 {
|
|
|
13 my @cols1 = split /\s+/, $a ;
|
|
|
14 my @cols2 = split /\s+/, $b ;
|
|
|
15
|
|
|
16 if ( $cols1[0] ne $cols2[0] )
|
|
|
17 {
|
|
|
18 $chromRank{ $cols1[0] } cmp $chromRank{ $cols2[0] } ;
|
|
|
19 }
|
|
|
20 elsif ( $cols1[1] != $cols2[1] )
|
|
|
21 {
|
|
|
22 $cols1[1] <=> $cols2[1] ;
|
|
|
23 }
|
|
|
24 else
|
|
|
25 {
|
|
|
26 $cols1[2] <=> $cols2[2] ;
|
|
|
27 }
|
|
|
28 }
|
|
|
29
|
|
|
30 open FP1, $ARGV[0] ;
|
|
|
31 my $cnt = 0 ;
|
|
|
32 while ( <FP1> )
|
|
|
33 {
|
|
|
34 chomp ;
|
|
|
35 my $line = $_ ;
|
|
|
36 my @cols = split /\s+/ ;
|
|
|
37 push @cols, 1 ;
|
|
|
38 @{ $intronInfo{ $cols[0]." ".$cols[1]." ".$cols[2] } } = @cols ;
|
|
|
39 if ( !defined $chromRank{ $cols[0]} )
|
|
|
40 {
|
|
|
41 $chromRank{ $cols[0] } = $cnt ;
|
|
|
42 ++$cnt ;
|
|
|
43 }
|
|
|
44 }
|
|
|
45 close FP1 ;
|
|
|
46
|
|
|
47 open FP1, $ARGV[1] ;
|
|
|
48 while ( <FP1> )
|
|
|
49 {
|
|
|
50 chomp ;
|
|
|
51 my $line = $_ ;
|
|
|
52 my @cols = split /\s+/ ;
|
|
|
53 my $key = $cols[0]." ".$cols[1]." ".$cols[2] ;
|
|
|
54 next if ( !defined $intronInfo{ $key } ) ;
|
|
|
55 my @infoCols = @{ $intronInfo{ $key } } ;
|
|
|
56 $infoCols[4] = $cols[4] if ( $infoCols[4] ne "+" || $infoCols[4] ne "-" ) ;
|
|
|
57 $infoCols[9] |= 2 ;
|
|
|
58
|
|
|
59 @{ $intronInfo{ $key } } = @infoCols ;
|
|
|
60 }
|
|
|
61 close FP1 ;
|
|
|
62
|
|
|
63 foreach my $key (sort sortIntron keys %intronInfo )
|
|
|
64 {
|
|
|
65 my @infoCols = @{ $intronInfo{ $key } } ;
|
|
|
66 #print join( " ", @infoCols ), "\n" ;
|
|
|
67
|
|
|
68 next if ( $infoCols[9] != 3 ) ;
|
|
|
69 pop @infoCols ;
|
|
|
70 print join( " ", @infoCols ), "\n" ;
|
|
|
71 }
|
