#!/usr/bin/env perl
use strict;


#############################
# load utility functions
#############################

use FindBin;
use lib "$FindBin::Bin";
use Ricopili::Utils qw(trans);

my $ploc = &trans("p2loc");

###############################################


my $version = "1.0.0";
my $progname = $0;
my $bimfile = "";


##### help message
my $usage = "
Usage : $progname [options] .bgl

version: $version

  --help        print this help message and exit

 will create a impute-readable file (haps, legend) for further processing

 created by Stephan Ripke 2012 at MGH, Boston, MA
 
";



use Getopt::Long;
GetOptions( 
    "help"=> \my $help,
    );


die $usage if $help;
die $usage if (@ARGV != 1);


###################################################
###  system call with test if successfull
###################################################
sub mysystem(){
    my ($systemstr)="@_";
    system($systemstr);
    my $status = ($? >> 8);
    die "$systemstr\n->system call failed: $status" if ($status != 0);
}




##########################################
# subroutine to split a plink-output-line with references
##########################################

sub split_line_ref {
    my ($line)=${$_[0]};
    chomp($line);
    $line =~ s/^[\s]+//g;
    my @cols=  split /\s+/, $line;
    \@cols;
}


##########################################
# begin
##########################################

my $bgl_file = $ARGV[0];
my $marker_file = $ARGV[0].".markers";
my $impute_file = $ARGV[0].".hap";
my $legend_file = $ARGV[0].".legend";





#####################################
# create phased
####################################


print "create impute_file\n";

die $!." <$bgl_file>" unless open IN, "< $bgl_file";
die $!." <$marker_file>" unless open MA, "< $marker_file";

die $! unless open OUT, "> $impute_file";
die $!." <$legend_file>" unless open LE, "> $legend_file";

print LE "rsID position a0 a1\n";
while (my $line = <IN>) {
    my @cells = @{&split_line_ref(\$line)};
    my $mline = <MA>;
    my @mcells = @{&split_line_ref(\$mline)};
    
    die "bgl and marker-file with inconsistency at $cells[1]" if ($cells[1] ne $mcells[0]);
    

    print LE "@mcells\n";
    shift (@cells);
    my $snp = shift (@cells);
    
    my $a1 = $mcells[2];
    my $a2 = $mcells[3];
    my $out_str = "";
    foreach my $an (@cells){
	if ($an eq $a1){
	    $out_str .= " 0";
	}
	elsif ($an eq $a2){
	    $out_str .= " 1";
	}
	else {
	    print "wrong allele at $snp\n";
	    exit;
	}
    }
    $out_str =~ s/^ //;
    print OUT "$out_str\n";
}
close OUT;
close IN;
close MA;
close LE;



&mysystem ("gzip -c $impute_file > $impute_file.tmp.gz");
&mysystem ("gzip -f $legend_file");
&mysystem ("mv $impute_file.tmp.gz $impute_file.gz");
&mysystem ("rm $impute_file");


