ngs_server 0.1 → 0.2

data/ext/vcftools/perl/fill-aa

@@ -0,0 +1,103 @@
+#!/usr/bin/env perl
+#
+# Notes:
+#   * The AA files can be downloaded from ftp://ftp.1000genomes.ebi.ac.uk/vol1/ftp/pilot_data/technical/reference/ancestral_alignments
+#   * The program runs samtools, therefore the AA files must be gzipped (not b2zipped).
+#
+# support: pd3@sanger
+
+use strict;
+use warnings;
+use Carp;
+use Vcf;
+use FindBin;
+use lib "$FindBin::Bin";
+use FaSlice;
+
+my $opts = parse_params();
+fill_aa($opts,$$opts{aa_file});
+
+exit;
+
+#--------------------------------
+
+sub error
+{
+    my (@msg) = @_;
+    if ( scalar @msg ) { confess @msg; }
+    die
+        "Usage: fill-aa [OPTIONS] < in.vcf >out.vcf\n",
+        "Options:\n",
+        "   -a, --ancestral-allele <prefix>     Prefix to ancestral allele chromosome files.\n",
+        "   -h, -?, --help                      This help message.\n",
+        "Example:\n",
+        "   (zcat file.vcf | grep ^#; zcat file.vcf | grep -v ^# | sort -k 1,1d -k 2,2n;) | fill-aa -a human_ancestor_ 2>test.err | gzip -c >out.vcf.gz \n",
+        "\n";
+}
+
+
+sub parse_params
+{
+    my $opts = {};
+    while (my $arg=shift(@ARGV))
+    {
+        if ( $arg eq '-a' || $arg eq '--ancestral-allele' ) { $$opts{aa_file} = shift(@ARGV); next }
+        if ( $arg eq '-?' || $arg eq '-h' || $arg eq '--help' ) { error(); }
+        error("Unknown parameter \"$arg\". Run -h for help.\n");
+    }
+    if ( !exists($$opts{aa_file}) ) { error("Missing the -a option.\n") }
+    return $opts;
+}
+
+
+sub fill_aa
+{
+    my ($opts,$aa_fname) = @_;
+
+    my $n_unknown = 0;
+    my $n_filled   = 0;
+
+    my $vcf = Vcf->new(fh=>\*STDIN);
+    $vcf->parse_header();
+    $vcf->add_header_line({key=>'INFO',ID=>'AA',Number=>1,Type=>'String',
+        Description=>'Ancestral Allele, ftp://ftp.1000genomes.ebi.ac.uk/vol1/ftp/pilot_data/technical/reference/ancestral_alignments/README'});
+    print $vcf->format_header();
+
+    my $fa;
+    while (my $rec = $vcf->next_data_hash())
+    {
+        my $chr = $$rec{CHROM};
+        my $pos = $$rec{POS};
+
+        my $fname = $aa_fname;
+        if ( ! -e $fname )
+        {
+            if ( -e "$fname$chr.fa.gz" ) { $fname = "$fname$chr.fa.gz"; }
+            else { error(qq[Neither "$fname" nor "$fname$chr.fa.gz" exists.\n]); }
+        }
+        if ( !$fa or $$fa{file} ne $fname )
+        {
+            $fa = FaSlice->new(file=>$fname, size=>100_000);
+        }
+
+        my $aa = $fa->get_base($chr,$pos);
+
+        if ( $aa )
+        {
+            $$rec{$$vcf{columns}[7]}{AA} = $aa;
+            $n_filled++;
+        }
+        else
+        {
+            $$rec{$$vcf{columns}[7]}{AA} = '.';
+            $n_unknown++;
+        }
+        print $vcf->format_line($rec);
+    }
+
+    print STDERR 
+        "No AAs        .. $n_unknown\n",
+        "AAs filled    .. $n_filled\n";
+}
+
+

data/ext/vcftools/perl/fill-an-ac

@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Carp;
+use Vcf;
+
+my $opts = parse_params();
+fill_an_ac($$opts{file});
+
+exit;
+
+#--------------------------------
+
+sub error
+{
+    my (@msg) = @_;
+    if ( scalar @msg ) { confess @msg; }
+    die
+        "Usage: fill-an-ac [OPTIONS] < in.vcf >out.vcf\n",
+        "Options:\n",
+        "   -h, -?, --help                      This help message.\n",
+        "\n";
+}
+
+
+sub parse_params
+{
+    my $opts = {};
+    while (my $arg=shift(@ARGV))
+    {
+        if ( -e $arg ) { $$opts{file} = $arg; next }
+        if ( $arg eq '-?' || $arg eq '-h' || $arg eq '--help' ) { error(); }
+        error("Unknown parameter \"$arg\". Run -h for help.\n");
+    }
+    return $opts;
+}
+
+
+sub fill_an_ac
+{
+    my ($file) = @_;
+
+    my $vcf = $file ? Vcf->new(file=>$file) : Vcf->new(fh=>\*STDIN);
+    $vcf->parse_header();
+    $vcf->add_header_line({key=>'INFO',ID=>'AC',Number=>-1,Type=>'Integer',Description=>'Allele count in genotypes'});
+    $vcf->add_header_line({key=>'INFO',ID=>'AN',Number=>1,Type=>'Integer',Description=>'Total number of alleles in called genotypes'});
+    print $vcf->format_header();
+    $vcf->recalc_ac_an(2);
+
+    while (my $rec=$vcf->next_data_hash())
+    {
+        print $vcf->format_line($rec);
+    }
+}
+

data/ext/vcftools/perl/fill-ref-md5

@@ -0,0 +1,204 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Carp;
+use IPC::Open2;
+use Vcf;
+
+my $opts = parse_params();
+fill_ref_md5($opts);
+
+exit;
+
+#--------------------------------
+
+sub error
+{
+    my (@msg) = @_;
+    if ( scalar @msg ) { confess @msg; }
+    die
+        "About: The script computes MD5 sum of the reference sequence and inserts\n",
+        "   'reference' and 'contig' tags into header as recommended by VCFv4.1.\n",
+        "   The VCF file must be compressed and tabix indexed, as it takes advantage\n",
+        "   of the lightning fast tabix reheader functionality.\n",
+        "Usage: fill-ref-md5 [OPTIONS] in.vcf.gz out.vcf.gz\n",
+        "Options:\n",
+        "   -d, --dictionary <file>             Where to read/write computed MD5s. Opened in append mode, existing records are not touched.\n",
+        "   -i, --info <AS:xx,SP:xx,TX:xx>      Optional info on reference assembly (AS), species (SP), taxonomy (TX)\n",
+        "   -r, --refseq <file>                 The reference sequence in fasta format indexed by samtools faidx\n",
+        "   -h, -?, --help                      This help message.\n",
+        "Examples:\n",
+        "   fill-ref-md5 -i AS:NCBIM37,SP:\"Mus\\ Musculus\" -r NCBIM37_um.fa  -d NCBIM37_um.fa.dict in.vcf.gz out.vcf.gz\n",
+        "\n";
+}
+
+
+sub parse_params
+{
+    my $opts = {};
+    while (my $arg=shift(@ARGV))
+    {
+        if ( $arg eq '-i' || $arg eq '--info' ) { $$opts{info}=shift(@ARGV); next; }
+        if ( $arg eq '-r' || $arg eq '--refseq' ) { $$opts{refseq}=shift(@ARGV); next; }
+        if ( $arg eq '-d' || $arg eq '--dictionary' ) { $$opts{dictionary}=shift(@ARGV); next; }
+        if ( -e $arg && !exists($$opts{file}) ) { $$opts{file} = $arg; next }
+        if ( exists($$opts{file}) && !exists($$opts{outfile}) ) { $$opts{outfile} = $arg; next }
+        if ( $arg eq '-?' || $arg eq '-h' || $arg eq '--help' ) { error(); }
+        error("Unknown parameter \"$arg\" or non-existent file. Run -h for help.\n");
+    }
+    if ( !exists($$opts{refseq}) && !exists($$opts{dictionary}) ) { error("Expected one of -d or -r options\n"); }
+    if ( !exists($$opts{file}) ) { error("No input VCF file given.\n"); }
+    if ( !exists($$opts{outfile}) ) { error("No output VCF file given.\n"); }
+    return $opts;
+}
+
+sub read_dict
+{
+    my ($dict) = @_;
+    my $out = {};
+    if ( !$dict or !-e $dict ) { return $out }
+
+    open(my $fh,'<',$dict) or error("$dict: $!");
+    my $line=<$fh>;
+    if ( $line ne "\@HD\tVN:1.0\tSO:unsorted\n" ) { error("Could not parse $dict: $line"); }
+
+    while (my $line=<$fh>)
+    {
+        chomp($line);
+
+        # @SQ SN:5    LN:152537259    UR:file:/lustre/scratch102/projects/mouse/ref/NCBIM37_um.fa M5:f90804fb8fe9cb06076d51a710fb4563
+        my @items = split(/\t/,$line);
+        if ( @items != 5 ) { error("Could not parse $dict: $line"); }
+        my $item = shift(@items);
+        if ( $item ne '@SQ' ) { next; }
+        my $rec = {};
+        for my $item (@items)
+        {
+            if ( !($item=~/^([^:]+):(.+)$/) ) { error("Could not parse $dict: [$item] [$line]"); }
+            $$rec{$1} = $2;
+        }
+        if ( !exists($$rec{SN}) ) { error("No SN in [$dict] [$line]?"); }
+        $$out{$$rec{SN}} = $rec;
+    }
+    close($fh);
+
+    return $out;
+}
+
+sub add_to_dictionary
+{
+    my ($opts,$dict,$chr) = @_;
+    if ( !exists($$opts{refseq}) ) { error("The chromosome [$chr] not present in the dictionary and no reference sequence given.\n"); }
+
+    my($md5_in,$md5_out,$ok,$len);
+    eval { open2($md5_out,$md5_in,'md5sum'); $ok=1; };
+    if ( !$ok ) { error("md5sum: $!"); }
+
+    my $cmd = "samtools faidx $$opts{refseq} $chr";
+    open(my $refseq,"$cmd |") or error("$cmd: $!");
+    # get rid of the first ">$chr" line.
+    <$refseq>;
+    while (my $line=<$refseq>)
+    {
+        chomp($line);
+        print $md5_in $line;
+        $len += length($line);
+    }
+    close($refseq);
+
+    close($md5_in);
+    my @md5 = <$md5_out>;
+    close($md5_out);
+    $md5[0] =~ s/\s+.*$//;
+    chomp($md5[0]);
+
+    if ( !$len ) { error("The sequence [$chr] not present in $$opts{refseq}\n"); }
+
+    $$dict{$chr} = { dirty=>1, SN=>$chr, LN=>$len, UR=>'file://'.$$opts{refseq}, M5=>$md5[0] };
+    $$dict{dirty} = 1;
+} 
+
+sub write_dictionary
+{
+    my ($opts,$dict) = @_;
+    if ( !$$dict{dirty} or !exists($$opts{dictionary}) ) { return }
+    
+    my $needs_header = !-e $$opts{dictionary} ? 1 : 0;
+
+    open(my $fh,'>>',$$opts{dictionary}) or error("$$opts{dictionary}: $!");
+    print $fh "\@HD\tVN:1.0\tSO:unsorted\n" unless !$needs_header;
+    for my $key (sort keys %$dict)
+    {
+        if ( ref($$dict{$key}) ne 'HASH' or !$$dict{$key}{dirty} ) { next; }
+        my $sn =  $$dict{$key}{SN};
+        my $ln =  $$dict{$key}{LN};
+        my $ur =  $$dict{$key}{UR};
+        my $m5 =  $$dict{$key}{M5};
+        print $fh "\@SQ\tSN:$sn\tLN:$ln\tUR:$ur\tM5:$m5\n";
+    }
+    close($fh);
+}
+
+sub write_header
+{
+    my ($opts,$dict,$chroms) = @_;
+
+    my %info;
+    if ( exists($$opts{info}) )
+    {
+        $$opts{info} =~ s/AS:/assembly:/;
+        $$opts{info} =~ s/SP:/species:/;
+        $$opts{info} =~ s/TX:/taxonomy:/;
+        for my $item (split(/,/,$$opts{info}))
+        {
+            my ($key,$value) = split(/:/,$item);
+            if ( !defined $value ) { error("Could not parse the info: [$item] [$$opts{info}]"); }
+            $info{$key} = $value;
+        }
+    }
+
+    my $vcf = Vcf->new(file=>$$opts{file});
+    $vcf->parse_header();
+
+    my $uri = $$opts{refseq}=~m{^[^/:]+:} ? '' : 'file:';
+    $vcf->add_header_line({key=>'reference', value=>"$uri$$opts{refseq}"});
+    for my $chrom (@$chroms)
+    {
+        my %line = 
+        (
+            key      => 'contig',
+            ID       => $$dict{$chrom}{SN},
+            length   => $$dict{$chrom}{LN},
+            md5      => $$dict{$chrom}{M5},
+            %info
+        );
+        $vcf->add_header_line(\%line);
+    }
+
+    open(my $out,'>',"$$opts{outfile}.header") or error("$$opts{outfile}.header: $!");
+    print $out $vcf->format_header();
+    close($out);
+}
+
+sub fill_ref_md5
+{
+    my ($opts) = @_;
+
+    # List chromosomes
+    my @chroms = `tabix -l $$opts{file}`;
+    if ( $? ) { error("The command failed: tabix -l $$opts{file}\n"); }
+
+    # Read dictionary
+    my $dict = read_dict($$opts{dictionary},\@chroms);
+    for my $chr (@chroms)
+    {
+        chomp($chr);
+        if ( !exists($$dict{$chr}) ) { add_to_dictionary($opts,$dict,$chr); }
+    }
+    write_dictionary($opts,$dict);
+    write_header($opts,$dict,\@chroms);
+
+    `tabix -r $$opts{outfile}.header $$opts{file} > $$opts{outfile}`;
+}
+

data/ext/vcftools/perl/tab-to-vcf

@@ -0,0 +1,92 @@
+#!/usr/bin/env perl
+#
+# Author: petr.danecek@sanger
+#
+
+use strict;
+use warnings;
+use Carp;
+use Vcf;
+use FaSlice;
+
+my $opts = parse_params();
+tab_to_vcf();
+
+exit;
+
+#--------------------------------
+
+sub error
+{
+    my (@msg) = @_;
+    if ( scalar @msg ) { confess @msg; }
+    die
+        "Usage: tab-to-vcf [OPTIONS]\n",
+        "Options:\n",
+        "   -i, --id <string>               The column ID.\n",
+        "   -r, --ref <fasta-file>          The reference sequence (optional).\n",
+        "   -h, -?, --help                  This help message.\n",
+        "\n";
+}
+
+
+sub parse_params
+{
+    my $opts = {};
+    while (my $arg=shift(@ARGV))
+    {
+        if ( $arg eq '-i' || $arg eq '--id' ) { $$opts{id} = shift(@ARGV); next }
+        if ( $arg eq '-r' || $arg eq '--ref' ) { $$opts{refseq} = shift(@ARGV); next }
+        if ( $arg eq '-?' || $arg eq '-h' || $arg eq '--help' ) { error(); }
+        error("Unknown parameter \"$arg\". Run -h for help.\n");
+    }
+    if ( !exists($$opts{id}) ) { error("Missing the -i option.\n") }
+    return $opts;
+}
+
+
+sub tab_to_vcf
+{
+    my ($data,$prefix) = @_;
+
+    my $refseq = $$opts{refseq} ? FaSlice->new(file=>$$opts{refseq},size=>1_000_000) : undef;
+
+    my $id = $$opts{id};
+
+    my $vcf_out = Vcf->new();
+    $vcf_out->add_columns($id);
+    $vcf_out->add_header_line({key=>'FORMAT',ID=>'GT',Number=>'1',Type=>'String',Description=>"Genotype"});
+    print $vcf_out->format_header();
+
+    while (my $line=<STDIN>)
+    {
+        if ( $line=~/^#/ ) { next; }
+
+        # 11      86881024        CT
+        my @items = split(/\t/,$line);
+        if ( $items[2] eq '*' ) { next; }
+
+        my $chr = $items[0];
+        my $pos = $items[1];
+        my $snp = $items[2];
+
+        if ( !($pos=~/^\d+$/) ) { error("Could not parse the line: $line"); }
+        if ( !($snp=~/^([ACGT])([ACGT])$/) ) { error("Could not parse the line: $line"); }
+        $snp = "$1/$2";
+
+        my %out;
+        $out{CHROM}  = $chr;
+        $out{POS}    = $pos;
+        $out{ID}     = '.';
+        $out{ALT}    = [];
+        $out{REF}    = $refseq->get_base($chr,$pos);
+        $out{QUAL}   = '.';
+        $out{FILTER} = ['.'];
+        $out{FORMAT} = ['GT'];
+        $out{gtypes}{$id}{GT} = $snp;
+
+        $vcf_out->format_genotype_strings(\%out);
+        print $vcf_out->format_line(\%out);
+    }
+}
+