3
|
1 #!/usr/bin/perl
|
4
|
2 #V1.1.1 minor bug correction (see in code)
|
3
|
3 #V1.1.0 integrated gene extraction
|
|
4 #V1.0.2 integrated segment fasta extraction
|
|
5 #V1.0.1 added log and option
|
|
6 #V1.0.0
|
|
7 use strict;
|
|
8 use warnings;
|
|
9 use Getopt::Long;
|
|
10
|
|
11 my $input_blast_files;
|
|
12 my $input_genes_position_file;
|
|
13 my $input_assembly_file;
|
|
14 my $input_markers_position_file;
|
|
15 my $input_markers_file;
|
|
16 my $log_file;
|
|
17 my $output_fasta_file;
|
|
18 my $output_segment_file;
|
|
19 my $output_genes_list_file;
|
|
20 my $EXTRACT_SEQ = "NO";
|
|
21 my $WINDOW = 200000;
|
|
22 my $OFFSET = 100000;
|
|
23 my $MAX_BLAST_LINES = 1;
|
|
24
|
|
25 GetOptions (
|
|
26 "input_assembly_file=s" => \$input_assembly_file,
|
|
27 "input_markers_position_file=s" => \$input_markers_position_file,
|
|
28 "input_markers_file=s" => \$input_markers_file,
|
|
29 "log_file=s" => \$log_file,
|
|
30 "output_fasta_file=s" => \$output_fasta_file,
|
|
31 "output_segment_file=s" => \$output_segment_file,
|
|
32 "extractseq=s" => \$EXTRACT_SEQ,
|
|
33 "window=i" => \$WINDOW,
|
|
34 "offset=i" =>\$OFFSET,
|
|
35 "input_blast_files=s" => \$input_blast_files,
|
|
36 "input_genes_position_file=s"=> \$input_genes_position_file,
|
|
37 "output_genes_list_file=s"=>\$output_genes_list_file,
|
|
38 "max_blast_lines=i" => \$MAX_BLAST_LINES
|
|
39 ) or die("Error in command line arguments\n");
|
|
40
|
|
41 open(LF, ">$log_file") or die("Can't open $log_file\n");
|
|
42 #print LF $EXTRACT_SEQ."\n";
|
|
43
|
|
44 my $current_annotation="";
|
|
45 my @list_marquer;
|
|
46 my %chr;
|
|
47 my %position;
|
|
48
|
|
49 open(MP, $input_markers_position_file) or die("Can't open $input_markers_position_file\n");
|
|
50
|
|
51 my $compt=0;
|
|
52 while (my $line=<MP>){
|
|
53 $compt++;
|
|
54 my @cols = split(/\t/,$line);
|
|
55 if ($#cols != 3){
|
|
56 print STDERR "Error in marker position file format\n$compt : $line\n";
|
|
57 exit(0);
|
|
58 }
|
|
59 my %current;
|
|
60 # Number#Map#Name#Chr#Position#GeneAT#FunctionAT
|
|
61 my $Name = $cols[0];
|
|
62 my $Locus = $cols[1];
|
|
63 my $Chr = $cols[2];
|
|
64 my $Position = $cols[3];
|
|
65
|
|
66
|
|
67 $chr{$Name} = $Chr;
|
|
68 $position{$Name} = $Position;
|
|
69
|
|
70 ### Modification 0.9.9
|
|
71 if ($Locus ne $Name){
|
|
72 $chr{$Locus} = $Chr;
|
|
73 $position{$Locus} = $Position;
|
|
74 }
|
|
75 ###
|
|
76
|
|
77 }
|
|
78 close (MP);
|
|
79
|
|
80 open(MA, $input_markers_file) or die("Can't open $input_markers_file\n");
|
|
81 while (my $line=<MA>){
|
|
82 my @cols = split (/\s+/,$line);
|
|
83 for (my $i=0;$i<=$#cols;$i++){
|
|
84 my $current = $cols[$i];
|
|
85 chomp($current);
|
|
86 if ($current !~ /^\s+$/){
|
|
87 push(@list_marquer,$current);
|
|
88 }
|
|
89 }
|
|
90 }
|
|
91 close (MA);
|
|
92
|
|
93 my %coord_by_chr;
|
|
94 for (my $i=0;$i<=$#list_marquer;$i++){
|
|
95 my $current_name = $list_marquer[$i];
|
|
96 my $current_chr = $chr{$current_name};
|
|
97 my $current_position = $position{$current_name};
|
|
98
|
|
99 if ($current_position =~ /^\d+$/){
|
|
100 my @tbl_coord_for_current_chr;
|
|
101 if ($coord_by_chr{$current_chr}){
|
|
102 @tbl_coord_for_current_chr = @{$coord_by_chr{$current_chr}};
|
|
103 }
|
|
104 push(@tbl_coord_for_current_chr,$current_position);
|
|
105 $coord_by_chr{$current_chr}=\@tbl_coord_for_current_chr;
|
|
106 }
|
|
107 elsif (($current_position =~/\s*-\s*/)||($current_position =~/none/i)){
|
|
108
|
|
109 }
|
|
110 else {
|
|
111 chomp($current_position);
|
|
112 print STDERR "Error Parsing $current_name\tposition not recognized : $current_position \n";
|
|
113 print $list_marquer[$i],"\n";
|
|
114 }
|
|
115 }
|
|
116
|
|
117 open(OS, ">$output_segment_file") or die ("Can't open $output_segment_file\n");
|
|
118
|
|
119 my @segment_chr;
|
|
120 my @segment_start;
|
|
121 my @segment_end;
|
|
122
|
|
123 foreach my $key (sort keys %coord_by_chr){
|
|
124 my @tbl_coord = @{$coord_by_chr{$key}};
|
|
125 @tbl_coord = sort { $a <=> $b } @tbl_coord;
|
|
126 my $current_start;
|
|
127 my $current_stop;
|
|
128 my $current_start_with_offset;
|
|
129 my $current_stop_with_offset;
|
|
130
|
|
131 for (my $i=0;$i<=$#tbl_coord;$i++){
|
|
132 if (!$current_start){$current_start=$tbl_coord[$i];$current_stop=$tbl_coord[$i]}
|
|
133
|
|
134 # print "$i : $current_start / $current_stop\n";
|
|
135 if ($tbl_coord[$i]>$current_stop+$WINDOW){
|
|
136 #OFFSET
|
|
137 if ($current_start>$OFFSET){$current_start_with_offset=$current_start-$OFFSET;}else{$current_start_with_offset=1;}
|
|
138 $current_stop_with_offset = $current_stop + $OFFSET;
|
|
139 #######
|
|
140 print OS $key,":",$current_start_with_offset,"..",$current_stop_with_offset,"\n";
|
|
141 push(@segment_chr,$key);
|
|
142 push(@segment_start,$current_start_with_offset);
|
|
143 push(@segment_end,$current_stop_with_offset);
|
|
144
|
|
145 $current_start = $tbl_coord[$i];
|
|
146 $current_stop = $tbl_coord[$i];
|
|
147
|
|
148 if ($i==$#tbl_coord){
|
|
149 #OFFSET
|
|
150 if ($current_start>$OFFSET){$current_start_with_offset=$current_start-$OFFSET;}else{$current_start_with_offset=1;}
|
|
151 $current_stop_with_offset = $current_stop + $OFFSET;
|
|
152 #######
|
|
153 print OS $key,":",$current_start_with_offset,"..",$current_stop_with_offset,"\n";
|
|
154 push(@segment_chr,$key);
|
|
155 push(@segment_start,$current_start_with_offset);
|
|
156 push(@segment_end,$current_stop_with_offset);
|
|
157 }
|
|
158 }
|
|
159 else {
|
|
160 $current_stop=$tbl_coord[$i];
|
|
161 if ($i==$#tbl_coord){
|
|
162 #OFFSET
|
|
163 if ($current_start>$OFFSET){$current_start_with_offset=$current_start-$OFFSET;}else{$current_start_with_offset=1;}
|
|
164 $current_stop_with_offset = $current_stop + $OFFSET;
|
|
165 #######
|
|
166 print OS $key,":",$current_start_with_offset,"..",$current_stop_with_offset,"\n";
|
|
167 push(@segment_chr,$key);
|
|
168 push(@segment_start,$current_start_with_offset);
|
|
169 push(@segment_end,$current_stop_with_offset);
|
|
170 }
|
|
171 }
|
|
172 }
|
|
173 }
|
|
174 close(OS);
|
|
175
|
|
176 ### Sequence extraction
|
|
177 if ($EXTRACT_SEQ eq "YES"){
|
|
178
|
|
179 my %genome;
|
|
180 my $current_header;
|
|
181 my $current_seq="";
|
|
182 open(AF, $input_assembly_file) or die ("Can't open $input_assembly_file\n");
|
|
183
|
|
184 while (my $ligne = <AF>){
|
|
185 if ($ligne =~ /^\>(.*?)\s*$/){
|
|
186 if ($current_header){
|
|
187 $genome{$current_header} = $current_seq;
|
|
188 }
|
|
189 $current_header=$1;
|
|
190 $current_seq = "";
|
|
191 }
|
|
192 else {
|
|
193 if ($ligne=~/^([ATGCNXatgcnx]+)\s*$/){
|
|
194 $current_seq .= $1;
|
|
195 }
|
|
196 else {
|
|
197 print STDERR "Erreur Parsing n°1\n$ligne\n";
|
|
198 }
|
|
199 }
|
|
200 }
|
|
201
|
|
202 #TRAITEMENT DU DERNIER
|
|
203 if ($current_header){
|
|
204 $genome{$current_header} = $current_seq;
|
|
205 undef($current_seq);
|
|
206 }
|
|
207 close (AF);
|
|
208
|
|
209 open(OF, ">$output_fasta_file") or die ("Can't open $output_fasta_file\n");
|
|
210 for (my $i=0;$i<=$#segment_chr;$i++){
|
|
211 my $compt=0;
|
|
212 my $current_seq="";
|
|
213 print OF ">",$segment_chr[$i],":",$segment_start[$i],"..",$segment_end[$i]."\n";
|
|
214 ### Modification 0.9.9
|
|
215 if ($segment_end[$i]>length($genome{$segment_chr[$i]})){
|
|
216 $segment_end[$i] = length($genome{$segment_chr[$i]});
|
|
217 }
|
|
218 ###
|
|
219
|
|
220 my @SEQ = split(//,$genome{$segment_chr[$i]});
|
|
221 for (my $coord = $segment_start[$i]-1; $coord<=$segment_end[$i]-1;$coord++){
|
|
222 $compt++;
|
|
223 if ($compt > 60 ){
|
|
224 $current_seq .= "\n";
|
|
225 $compt=1;
|
|
226 }
|
|
227 $current_seq .= $SEQ[$coord];
|
|
228
|
|
229 }
|
|
230 print OF "$current_seq\n";
|
|
231 }
|
|
232 close (OF);
|
|
233 }
|
|
234
|
|
235 ### GENE and BLAST Extraction
|
|
236 my @blast_by_base;
|
|
237 my @header;
|
|
238
|
|
239
|
|
240 my @blastfiles = split(/\,/,$input_blast_files);
|
|
241 for (my $i=0;$i<=$#blastfiles;$i++){
|
|
242 my $current_blast_file = $blastfiles[$i];
|
|
243 my $current_blast_header = "DEFAULT";
|
|
244 my %current_blast;
|
|
245 open (B,"$current_blast_file") or die ("Can't open $current_blast_file\n");
|
|
246 while (my $line =<B>){
|
|
247 if ($line =~ /^\#\#(.*?)$/){
|
|
248 $current_blast_header = $1;
|
|
249 print LF $current_blast_header."\n";
|
|
250 }
|
|
251 elsif ($line =~ /^\#/){
|
|
252 # blast file column legend
|
|
253 }
|
|
254 else {
|
|
255 my @fields = split(/\s+/,$line);
|
|
256 my $gene_id = $fields[0];
|
|
257 my @blast_for_this_gene;
|
|
258 if ($current_blast{$gene_id}){
|
|
259 @blast_for_this_gene = @{$current_blast{$gene_id}};
|
|
260 }
|
|
261
|
|
262 if ($#blast_for_this_gene<$MAX_BLAST_LINES-1){
|
|
263 push(@blast_for_this_gene,$line);
|
|
264 print LF $gene_id,"\n";
|
|
265 }
|
|
266 $current_blast{$gene_id}=\@blast_for_this_gene;
|
|
267 }
|
|
268 }
|
|
269 close(B);
|
|
270 push (@blast_by_base,\%current_blast);
|
|
271 push (@header,$current_blast_header);
|
|
272 }
|
|
273
|
|
274
|
|
275 open (OGL,">$output_genes_list_file") or die ("Can't open $output_genes_list_file\n");
|
|
276
|
|
277 for (my $i=0;$i<=$#segment_chr;$i++){
|
|
278 my $segment_chr = $segment_chr[$i];
|
|
279 my $segment_start = $segment_start[$i];
|
|
280 my $segment_end = $segment_end[$i];
|
|
281
|
|
282 print OGL "#",$segment_chr[$i],":",$segment_start[$i],"..",$segment_end[$i],"\n";
|
|
283
|
|
284 open(IG, $input_genes_position_file) or die("Can't open $input_genes_position_file\n");
|
|
285 while (my $gene_desc=<IG>){
|
4
|
286 my @gene_desc = split(/\t+/,$gene_desc);#Modification in 1.1.1 : \s => \t
|
3
|
287 if ($#gene_desc != 4){
|
|
288 print STDERR "Error in gene position file format\n$gene_desc\n";
|
|
289 exit(0);
|
|
290 }
|
|
291 my $gene_id = $gene_desc[0];
|
|
292 my $cds_id = $gene_desc[1];
|
|
293 my $gene_chr = $gene_desc[2];
|
|
294 my $gene_start = $gene_desc[3];
|
|
295 my $gene_end = $gene_desc[4];
|
|
296 if ($segment_chr eq $gene_chr){
|
|
297 if ((($gene_start>=$segment_start)&&($gene_start<=$segment_end))||(($gene_end>=$segment_start)&&($gene_end<=$segment_end))){
|
|
298 print OGL $gene_id," / ",$cds_id,"\n";
|
|
299
|
|
300 for (my $i=0;$i<=$#blast_by_base;$i++){
|
|
301 #print LF $header[$i]."\n";
|
|
302 my %current_blast = %{$blast_by_base[$i]};
|
|
303 if ($current_blast{$cds_id}){
|
|
304 my @blast_by_gene = @{$current_blast{$cds_id}};
|
|
305 #print LF $#blast_by_gene."\n";
|
|
306 for (my $j=0;$j<=$#blast_by_gene;$j++){
|
|
307 my @fields = split(/\t/,$blast_by_gene[$j]);
|
|
308 print OGL $header[$i],"\t";
|
|
309 print OGL $fields[1],"\t";
|
|
310 print OGL $fields[3],"\t";
|
|
311 print OGL $fields[4],"\t";
|
|
312 print OGL $fields[5],"\t";
|
|
313 print OGL $fields[10],"\t";
|
|
314 print OGL $fields[6],"..",$fields[7],"(",$fields[11],")","\t";
|
|
315 print OGL $fields[8],"..",$fields[9],"(",$fields[12],")","\t";
|
|
316 print OGL $fields[13];
|
|
317 }
|
|
318 print OGL "\n";
|
|
319 }
|
|
320 else {
|
|
321 print OGL $header[$i],"\t","No BLAST results\n";
|
|
322 print LF $gene_id," / ",$cds_id,"\n";
|
|
323 }
|
|
324 }
|
|
325 }
|
|
326 }
|
|
327
|
|
328 }
|
|
329 close(IG);
|
|
330 }
|
|
331
|
|
332
|
|
333 close (OGL);
|
|
334
|
|
335 close (LF);
|
|
336
|