comparison scripts/refine_breakpoint.ex.pl @ 0:28d1a6f8143f draft

planemo upload for repository https://github.com/portiahollyoak/Tools commit 132bb96bba8e7aed66a102ed93b7744f36d10d37-dirty
author portiahollyoak
date Mon, 25 Apr 2016 13:08:56 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:28d1a6f8143f
1 #! /usr/bin/perl
2
3 use strict;
4
5 my @files=<*.excision.cluster.*>;
6 foreach my $file (@files) {
7 if (($file !~ /sfcp/)&&($file !~ /refsup/)) {
8 my $sfcp=$file.".sfcp";
9 my $title=$file.".refined.bp";
10
11 open (input, "<$file") or die "Can't open $file since $!\n";
12 open (input1, "<$sfcp") or die "Can't open $sfcp since $!\n";
13 open (output, ">>$title") or die "Can't open $title since $!\n";
14 print output "Chr\tStart\tEnd\tTransposonName\t5\'_Junction\t3\'_Junction\n";
15 while (my $line=<input>) {
16 chomp($line);
17 my @a=split(/\s+/, $line);
18 my $line1=<input1>;
19 chomp($line1);
20 my @b=split(/\t/, $line1);
21 my @pos=split(/\;/, $b[4]);
22 my $plusnext=""; my $minusnext="";
23 my $plusover=0; my $minusover=0;
24 my $lpcoor=""; my $lmcoor=""; my $rpcoor=""; my $rmcoor="";
25 my $lp=0; my $lm=0; my $rp=0; my $rm=0;
26 my %plus=(); my %minus=();
27 foreach my $site (@pos) {
28 my @x=split(/\:/, $site);
29 my @y=split(/\(/, $x[0]);
30 chop($y[1]);
31 if (($y[0] =~ /\-/)&&($y[1] eq "+")&&($x[1] >= $plusover)) {
32 if ($plusover >= 2) {$plusnext="$lpcoor\-$rpcoor\:$plusover";}
33 $plusover=$x[1];
34 my @z=split(/\-/, $y[0]);
35 $lpcoor=$z[0]; $lp=$x[1];
36 $rpcoor=$z[1]; $rp=$x[1];
37 }
38 elsif (($y[0] =~ /\-/)&&($y[1] eq "-")&&($x[1] >= $minusover)) {
39 if ($minusover >= 2) {$minusnext="$lmcoor\-$rmcoor\:$minusover";}
40 $minusover=$x[1];
41 my @z=split(/\-/, $y[0]);
42 $lmcoor=$z[0]; $lm=$x[1];
43 $rmcoor=$z[1]; $rm=$x[1];
44 }
45 elsif (($y[0] !~ /\-/)&&($y[1] eq "+")) {
46 $plus{$y[0]}=$x[1];
47 }
48 elsif (($y[0] !~ /\-/)&&($y[1] eq "-")) {
49 $minus{$y[0]}=$x[1];
50 }
51 }
52
53 if (($plusnext ne "")&&($minusover == 0)) {
54 my @m=split(/\:/, $plusnext);
55 if (($m[1] >= 2)&&($m[1] == $plusover)) {
56 my $count1=$m[1]; my $count2=$plusover;
57 foreach my $id (keys %plus) {
58 if ($m[0] =~ /$id/) {$count1 += $plus{$id};}
59 elsif ($rpcoor == $id) {$count2 += $plus{$id};}
60 }
61 if ($count1 > $count2) {
62 my @n=split(/\-/, $m[0]);
63 $lpcoor=$n[0]; $lp=$m[1];
64 $rpcoor=$n[1]; $rp=$m[1];
65 }
66 }
67 }
68
69 if (($minusnext ne "")&&($plusover == 0)) {
70 my @m=split(/\:/, $minusnext);
71 if (($m[1] >= 2)&&($m[1] == $minusover)) {
72 my $count1=$m[1]; my $count2=$minusover;
73 foreach my $id (keys %minus) {
74 if ($m[0] =~ /$id/) {$count1 += $minus{$id};}
75 elsif ($lmcoor == $id) {$count2 += $minus{$id};}
76 }
77 if ($count1 > $count2) {
78 my @n=split(/\-/, $m[0]);
79 $lmcoor=$n[0]; $lm=$m[1];
80 $rmcoor=$n[1]; $rm=$m[1];
81 }
82 }
83 }
84
85 if (($plusover >= 2)&&($minusover >= 2)&&(($lpcoor-$rpcoor) != ($lmcoor-$rmcoor))) {
86 if ($plusnext ne "") {
87 my @m=split(/\:/, $plusnext);
88 my @n=split(/\-/, $m[0]);
89 if ((($n[1]-$n[0]) == ($rmcoor-$lmcoor))&&($m[1] >= 2)) {
90 $rpcoor=$n[1];
91 $lpcoor=$n[0];
92 $plusover=$m[1];
93 $lp=$m[1];
94 $rp=$m[1];
95 }
96 }
97 if ($minusnext ne "") {
98 my @m=split(/\:/, $minusnext);
99 my @n=split(/\-/, $m[0]);
100 if ((($n[1]-$n[0]) == ($rpcoor-$lpcoor))&&($m[1] >= 2)) {
101 $rmcoor=$n[1];
102 $lmcoor=$n[0];
103 $minusover=$m[1];
104 $lm=$m[1];
105 $rm=$m[1];
106 }
107 }
108 }
109
110 my $plusc=0; my $pluscoor="";
111 my $minusc=0; my $minuscoor="";
112 foreach my $id (keys %plus) {
113 if ($id eq $rpcoor) {
114 $rp=$plusover+$plus{$id};
115 }
116 if ($plus{$id} > $plusc) {
117 $plusc=$plus{$id};
118 $pluscoor=$id;
119 }
120 elsif (($plus{$id} == $plusc)&&(abs($id-$b[2]) < abs($pluscoor-$b[2]))) {
121 $plusc=$plus{$id};
122 $pluscoor=$id;
123 }
124 }
125 foreach my $id (keys %minus) {
126 if ($id eq $lmcoor) {
127 $lm=$minusover+$minus{$id};
128 }
129 if ($minus{$id} > $minusc) {
130 $minusc=$minus{$id};
131 $minuscoor=$id;
132 }
133 elsif (($minus{$id} == $minusc)&&(abs($id-$b[1]) < abs($minuscoor-$b[1]))) {
134 $minusc=$minus{$id};
135 $minuscoor=$id;
136 }
137 }
138 if ($plusover < 2) {
139 $lpcoor="";
140 if ($plusc >= 3) {$rpcoor=$pluscoor; $rp=$plusc;}
141 else {$rpcoor="";}
142 }
143 if ($minusover < 2) {
144 $rmcoor="";
145 if ($minusc >= 3) {$lmcoor=$minuscoor; $lm=$minusc;}
146 else {$lmcoor="";}
147 }
148
149 my $bp1=""; my $bp2="";
150 if (($lpcoor ne "")&&($lmcoor ne "")) {
151 $bp1="$lpcoor\(\+\)\:$lp,$lmcoor\(\-\)\:$lm";
152 }
153 elsif ($lpcoor ne "") {$bp1="$lpcoor\(\+\)\:$lp";}
154 elsif ($lmcoor ne "") {$bp1="$lmcoor\(\-\)\:$lm";}
155 if (($rpcoor ne "")&&($rmcoor ne "")) {
156 $bp2="$rpcoor\(\+\)\:$rp,$rmcoor\(\-\)\:$rm";
157 }
158 elsif ($rpcoor ne "") {$bp2="$rpcoor\(\+\)\:$rp";}
159 elsif ($rmcoor ne "") {$bp2="$rmcoor\(\-\)\:$rm";}
160
161 print output "$a[2]\t$a[3]\t$a[4]\t$a[5]\t$bp1\t$bp2\n";
162 }
163
164 close input;
165 close input1;
166 close output;
167 }
168 }