annotate gfapts/gfap_r1.0_samvcf_data_parser.pl @ 0:f753b30013e6 draft

Uploaded
author rdaveau
date Fri, 29 Jun 2012 10:20:55 -0400
parents
children 028f435b6cfb
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
1 #!/usr/bin/perl
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
2
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
3 use strict;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
4 use lib 'inc/perlmod';
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
5 use ngsutil qw[ :DEFAULT &explode_varcall ];
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
6 use warnings FATAL => qw[ numeric uninitialized ];
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
7 use List::Util qw[ sum min max ];
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
8 use File::Basename;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
9 use Getopt::Long;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
10
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
11 #!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
12 # PATH TO YOUR R-bin DIRECTORY
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
13 my $rbin = '/usr/bin/R';
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
14 #!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
15
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
16 my $annovar_dir = 'inc/annovar';
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
17 my $rdep = 'inc/R';
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
18
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
19 my($varfile, $outdir, $outfile, $i, @DP4, @buffer, @Temp, @previous, @fnames, %opts, %chr);
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
20
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
21 GetOptions(\%opts, "varfile=s", "outdir=s", "outfile=s");
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
22 $varfile = $opts{varfile};
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
23 $outdir = $opts{outdir};
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
24 $outfile = $opts{outfile};
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
25
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
26 my $fname = readlink($varfile) || $varfile;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
27 $fname = basename($fname);
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
28
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
29 my %fh=(
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
30 'chr1' => *chr1, 'chr2' => *chr2, 'chr3' => *chr3, 'chr4' => *chr4, 'chr5' => *chr5,
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
31 'chr6' => *chr6, 'chr7' => *chr7, 'chr8' => *chr8, 'chr9' => *chr9, 'chr10' => *chr10,
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
32 'chr11' => *chr11, 'chr12' => *chr12, 'chr13' => *chr13, 'chr14' => *chr14, 'chr15' => *chr15,
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
33 'chr16' => *chr16, 'chr17' => *chr17, 'chr18' => *chr18, 'chr19' => *chr19, 'chr20' => *chr20,
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
34 'chr21' => *chr21, 'chr22' => *chr22, 'chrX' => *chrX, 'chrY' => *chrY, 'chrM' => *chrM
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
35 );
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
36
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
37 `${annovar_dir}/convert2annovar.pl -format vcf4 $varfile -includeinfo > ${outdir}/${fname}_Temp-00 2> /dev/null` and die $!;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
38
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
39 open($fh{$_}, ">${outdir}/${fname}_${_}.Temp-00") or die $! foreach keys %fh;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
40 open IN, "<${outdir}/${fname}_Temp-00" or die $!;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
41 while(<IN>){
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
42 /^(\S+)\s+(?:\S+\s+){2}(\S+)\s+(\S+)/;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
43 next if !exists $fh{$1};
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
44 if(min(length($2), length($3))!=1){
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
45 chomp;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
46 @buffer=split /\s+/, $_;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
47 @Temp=explode_varcall(@buffer[1,3..4]);
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
48 for($i=0; $i<$#{$Temp[0]}; $i+=2){
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
49 print{ $fh{$buffer[0]} } join("\t", $buffer[0], @{$Temp[0]}[$i..$i+1], @{$Temp[1]}[$i..$i+1], @buffer[6..$#buffer]), "\n";
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
50 }
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
51 next;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
52 }
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
53 print{ $fh{$1} } $_;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
54 $chr{$1}++;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
55 }
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
56 close IN;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
57 foreach (keys %fh){
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
58 close($fh{$_});
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
59 next if !exists $chr{$_};
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
60 `sort -k2,2n -k3,3n ${outdir}/${fname}_${_}.Temp-00 > ${outdir}/${fname}_${_}.Temp-01` and die $!;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
61 open IN, "<${outdir}/${fname}_${_}.Temp-01" or die $!;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
62 open OUT, ">${outdir}/${fname}_${_}.Temp-02" or die $!;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
63 $_=readline(IN);
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
64 /^((?:\S+\s+){7})(?:\S+\s+){8}(\S+\s+\S+)/;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
65 @buffer=split /\s+/, $1.$2;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
66 ($_=pop(@buffer))=~s/.+DP4=([^;]+).+/$1/;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
67 @DP4=split /,/, $_;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
68 push @buffer, @DP4;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
69 @previous=@buffer;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
70 MAINLOOP: while(<IN>){
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
71 /^((?:\S+\s+){7})(?:\S+\s+){8}(\S+\s+\S+)/;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
72 @buffer=split /\s+/, $1.$2;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
73 ($_=pop(@buffer))=~s/.+DP4=([^;]+).+/$1/;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
74 @DP4=split /,/, $_;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
75 push @buffer, @DP4;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
76 while(($previous[0] eq $buffer[0]) && ($buffer[2]==$previous[2]+1) && (join('', @previous[3..4]) !~ /-/) && (join('', @buffer[3..4]) !~ /-/)){
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
77 $previous[2]=$buffer[2];
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
78 $previous[$_].=$buffer[$_] for 3..4;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
79 $previous[5]='unk' if $previous[5] ne $buffer[5];
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
80 $previous[7]='SKIP' if $previous[7] ne $buffer[7];
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
81 for (6,8..11){
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
82 $previous[$_]+=$buffer[$_];
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
83 $previous[$_]/=2;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
84 }
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
85 next MAINLOOP;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
86 }
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
87 $previous[7]='NONE' if $previous[7] eq '.';
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
88 $previous[$_]=sprintf("%.0f", $previous[$_]) for (6,8..11);
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
89 print OUT join("\t", @previous[0..6,8..11,7]), "\n";
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
90 @Temp=@previous if eof;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
91 @previous=@buffer;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
92 }
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
93 $previous[7]='NONE' if $previous[7] eq '.';
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
94 $previous[$_]=sprintf("%.0f", $previous[$_]) for (6,8..11);
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
95 print OUT join("\t", @previous[0..6,8..11,7]), "\n" if(join('_', @Temp[1..2]) ne join('_', @previous[1..2]));
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
96 close IN;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
97 close OUT;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
98 }
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
99 foreach (1..22, 'X', 'Y', 'M'){
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
100 push @fnames, "${outdir}/${fname}_chr${_}.Temp-02" if exists $chr{"chr$_"};
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
101 }
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
102 system join(' ', 'cat', @fnames, '>', "${outdir}/${fname}.Temp.2R") and die $!;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
103 `${rbin} --vanilla --slave --args ${outdir}/${fname}.Temp.2R < ${rdep}/samvcf_data_parser.R` and die $!;
f753b30013e6 Uploaded
rdaveau
parents:
diff changeset
104 system "rm ${outdir}/${fname}*Temp* $outfile; ln -s ${outdir}/${fname}.var $outfile" and die $!;