bcftools/vcfutils.pl

   1 #!/usr/bin/perl -w
   2
   3 # Author: lh3
   4
   5 use strict;
   6 use warnings;
   7 use Getopt::Std;
   8
   9 &main;
  10 exit;
  11
  12 sub main {
  13   my $version = '0.1.0';
  14   &usage if (@ARGV < 1);
  15   my $command = shift(@ARGV);
  16   my %func = (subsam=>\&subsam, listsam=>\&listsam, fillac=>\&fillac, qstats=>\&qstats);
  17   die("Unknown command \"$command\".\n") if (!defined($func{$command}));
  18   &{$func{$command}};
  19 }
  20
  21 sub subsam {
  22   die(qq/Usage: vcfutils.pl subsam <in.vcf> [samples]\n/) if (@ARGV == 0);
  23   my ($fh, %h);
  24   my $fn = shift(@ARGV);
  25   my @col;
  26   open($fh, ($fn =~ /\.gz$/)? "gzip -dc $fn |" : $fn) || die;
  27   $h{$_} = 1 for (@ARGV);
  28   while (<$fh>) {
  29         if (/^##/) {
  30           print;
  31         } elsif (/^#/) {
  32           my @t = split;
  33           my @s = @t[0..8]; # all fixed fields + FORMAT
  34           for (9 .. $#t) {
  35                 if ($h{$t[$_]}) {
  36                   push(@s, $t[$_]);
  37                   push(@col, $_);
  38                 }
  39           }
  40           pop(@s) if (@s == 9); # no sample selected; remove the FORMAT field
  41           print join("\t", @s), "\n";
  42         } else {
  43           my @t = split;
  44           if (@col == 0) {
  45                 print join("\t", @t[0..7]), "\n";
  46           } else {
  47                 print join("\t", @t[0..8], map {$t[$_]} @col), "\n";
  48           }
  49         }
  50   }
  51   close($fh);
  52 }
  53
  54 sub listsam {
  55   die(qq/Usage: vcfutils.pl listsam <in.vcf>\n/) if (@ARGV == 0 && -t STDIN);
  56   while (<>) {
  57         if (/^#/ && !/^##/) {
  58           my @t = split;
  59           print join("\n", @t[9..$#t]), "\n";
  60           exit;
  61         }
  62   }
  63 }
  64
  65 sub fillac {
  66   die(qq/Usage: vcfutils.pl fillac <in.vcf>\n\nNote: The GT field MUST BE present and always appear as the first field.\n/) if (@ARGV == 0 && -t STDIN);
  67   while (<>) {
  68         if (/^#/) {
  69           print;
  70         } else {
  71           my @t = split;
  72           my @c;
  73           my $n = 0;
  74           $c[1] = 0;
  75           for (9 .. $#t) {
  76                 if ($t[$_] =~ /^(\d+).(\d+)/) {
  77                   ++$c[$1]; ++$c[$2];
  78                   $n += 2;
  79                 }
  80           }
  81           my $AC = "AC=" . join("\t", @c[1..$#c]) . ";AN=$n";
  82           my $info = $t[7];
  83           $info =~ s/(;?)AC=(\d+)//;
  84           $info =~ s/(;?)AN=(\d+)//;
  85           if ($info eq '.') {
  86                 $info = $AC;
  87           } else {
  88                 $info .= ";$AC";
  89           }
  90           $t[7] = $info;
  91           print join("\t", @t), "\n";
  92         }
  93   }
  94 }
  95
  96 sub qstats {
  97   my %opts = (r=>'', s=>0.01);
  98   getopts('r:s:', \%opts);
  99   die("Usage: vcfutils.pl qstats [-r ref.vcf] <in.vcf>\n
 100 Note: This command discards indels. Output: QUAL #non-indel #SNPs #transitions #joint ts/tv #joint/#ref #joint/#non-indel \n") if (@ARGV == 0 && -t STDIN);
 101   my %ts = (AG=>1, GA=>1, CT=>1, TC=>1);
 102   my %h = ();
 103   if ($opts{r}) { # read the reference positions
 104         my $fh;
 105         open($fh, $opts{r}) || die;
 106         while (<$fh>) {
 107           next if (/^#/);
 108           $h{$1,$2} = 1 if (/^(\S+)\s+(\d+)/);
 109         }
 110         close($fh);
 111   }
 112   my $hsize = scalar(keys %h);
 113   my @a;
 114   while (<>) {
 115         next if (/^#/);
 116         my @t = split;
 117         next if (length($t[3]) != 1 || uc($t[3]) eq 'N');
 118         my @s = split(',', $t[4]);
 119         $t[5] = 3 if ($t[5] < 0);
 120         $t[3] = uc($t[3]); $t[4] = uc($t[4]);
 121         next if (length($s[0]) != 1);
 122         push(@a, [$t[5], ($t[4] eq '.' || $t[4] eq $t[3])? 0 : 1, $ts{$t[3].$s[0]}? 1 : 0, $h{$t[0],$t[1]}? 1 : 0]);
 123   }
 124   push(@a, [-1, 0, 0, 0]); # end marker
 125   die("[qstats] No SNP data!\n") if (@a == 0);
 126   @a = sort {$b->[0]<=>$a->[0]} @a;
 127   my $next = $opts{s};
 128   my $last = $a[0];
 129   my @c = (0, 0, 0, 0);
 130   for my $p (@a) {
 131         if ($p->[0] == -1 || ($p->[0] != $last && $c[0]/@a > $next)) {
 132           my @x;
 133           $x[0] = sprintf("%.3f", $c[1]-$c[2]? $c[2] / ($c[1] - $c[2]) : 100);
 134           $x[1] = sprintf("%.3f", $hsize? $c[3] / $hsize : 0);
 135           $x[2] = sprintf("%.3f", $c[3] / $c[1]);
 136           print join("\t", $last, @c, @x), "\n";
 137           $next = $c[0]/@a + $opts{s};
 138         }
 139         ++$c[0]; $c[1] += $p->[1]; $c[2] += $p->[2]; $c[3] += $p->[3];
 140         $last = $p->[0];
 141   }
 142 }
 143
 144 sub usage {
 145   die(qq/
 146 Usage:   vcfutils.pl <command> [<arguments>]\n
 147 Command: subsam       get a subset of samples
 148          listsam      list the samples
 149          fillac       fill the allele count field
 150          qstats       SNP stats stratified by QUAL
 151 \n/);
 152 }