#!/usr/bin/perl
use warnings;
use strict;
use File::Basename;
my $parents = shift;
my $f1list = shift;
my $out = shift;
my $min_depth = 5;
my $min_qual = 80;
my @f1files;
open F1LIST,'<', $f1list or die "couldn't open list of F1 files\n";
while($f1list = <F1LIST>){
	my $line = "$f1list";
	chomp $line;
	push @f1files, "$line";
}
close F1LIST;
open PARENTS,'<', $parents or die "couldn't open parent file\n";
my %valid_sites = ();
while($parents=<PARENTS>){
	my $line = "$parents";
	chomp $line;
	if($line=~m/^#/){
		next;	
	}
	elsif($line=~m/INDEL/){
		next;	
	}
	else{
		my @fields = split /\t/, $line;
		my $site = $fields[0]."\t".$fields[1];
		my $reference = $fields[3];
		my $alternate = $fields[4];
		my @annuus1 = genotype($fields[9],$reference,$alternate);
		my @annuus2 = genotype($fields[10],$reference,$alternate);
		my @petiolaris1 = genotype($fields[11],$reference,$alternate);
		my @petiolaris2 = genotype($fields[12],$reference,$alternate);
		my $all_ann = "$annuus1[0]"."$annuus1[1]"."$annuus2[0]"."$annuus2[1]";
		my $all_pet = "$petiolaris1[0]"."$petiolaris1[1]"."$petiolaris2[0]"."$petiolaris2[1]";
		my $n_annuus_alleles = nUniqC($all_ann);
		my $n_petiolaris_alleles = nUniqC($all_pet);
#test_log#		print "PARENT_ALLELES_COUNTED\t$all_ann\t$all_pet\n";
#test_log#		print "N_PARENTS\t$n_annuus_alleles\t$n_petiolaris_alleles\n";
		if(($n_annuus_alleles == 1) && ($n_petiolaris_alleles == 1)){
			if($annuus1[0] ne $petiolaris1[0]){
				$valid_sites{$site}{ann} = $annuus1[0];
				$valid_sites{$site}{pet} = $petiolaris1[0];
#test_log#				print "PARENT_ALLELES_STORED\t$annuus1[0]\t$petiolaris1[0]\n";
			}	
		}
	}
}

close PARENTS;
my @names;
foreach(@f1files){

	my $in = "$_";
	my $name = basename($in, ".HA412.var.vcf");
	push @names, $name;
	open IN,'<', $in or die "couldn't open $in\n";
	while($in = <IN>){
		my $line = "$in";
		chomp $line;
		if($line =~ m/^#/){
				next;	
		}
		elsif($line=~m/INDEL/){
			next;	
		}
		else{
			my @fields = split /\t/, $line;
			my $site = $fields[0]."\t".$fields[1];
			my $reference = $fields[3];
			my $alternate = $fields[4];
			my $n_reference = 0; 
			my $n_alternate = 0;
			# DP4 = Number of 1) forward ref alleles; 2) reverse ref; 
			# 3) forward non-ref; 4) reverse non-ref alleles, used in variant calling. 
			# Sum can be smaller than DP because low-quality bases are not counted.
			if($fields[7] =~ m/DP4=(\d+),(\d+),(\d+),(\d+);/){
				$n_reference = $1 + $2;
				$n_alternate = $3 + $4;
#test_log#				print "REF_ALT\t$n_reference\t$n_alternate\n";
			}
# we might want to add a verification test to the block below, although the logic is an implicit test
			# my @genotype = genotype($fields[9],$reference,$alternate);
			if( exists $valid_sites{$site}){
#test_log#				print "SITE\t$site\n";
				if ( ($reference eq $valid_sites{$site}{ann}) && ($alternate eq $valid_sites{$site}{pet})) {
					$valid_sites{$site}{$name}{ann} = $n_reference;
					$valid_sites{$site}{$name}{pet} = $n_alternate;
				}
				elsif( ($reference eq $valid_sites{$site}{pet}) && ($alternate eq $valid_sites{$site}{ann})){
					$valid_sites{$site}{$name}{ann} = $n_alternate; 
					$valid_sites{$site}{$name}{pet} = $n_reference;
				}
			}
		}
	}
}
open OUT,'>',$out or die "couldn't open outfile\n";
print OUT "#CONTIG\tPOS\tANN\tPET";
foreach(@names){
	my $name = "$_";
	print OUT "\t$name-n_ann\t$name-n_pet";	
}
print OUT "\n";
my @sites = keys %valid_sites;
foreach(@sites){
		my $site = "$_";
		my @conpos = split /\t/, $site;
		my $contig = $conpos[0];
		my $position = sprintf("%06d", $conpos[1]);
		my $ann = $valid_sites{$site}{ann};
		my $pet = $valid_sites{$site}{pet};
		print OUT "$contig\t$position\t$ann$ann$ann$ann\t$pet$pet$pet$pet";
		foreach(@names){
			my $name = "$_";
			if (exists $valid_sites{$site}{$name}){
				my $n_ann = $valid_sites{$site}{$name}{ann};
				my $n_pet = $valid_sites{$site}{$name}{pet};
				print OUT "\t$n_ann\t$n_pet";
			}	
			else{
				print OUT "\tNN\tNN";	
			}
		}
		print OUT "\n";
}
close OUT;
system("sort -k 1,2 $out >.F1hets.tmp");
system("mv .F1hets.tmp $out");
sub genotype{
	my $callqual = shift;
	my $ref = shift;
	my $alt = shift;
	my @alleles = split /,/, $alt;
	unshift @alleles, $ref;
	my @fields = split /:/, $callqual;
	my $gt = $fields[0];
	my $dp = $fields[2];
	my $gq = $fields[3];
	if(($dp >= $min_depth) && ($gq >= $min_qual)){
		my @index = split /\//,$gt;
		my $allele1 = $alleles["$index[0]"];
		my $allele2 = $alleles["$index[1]"];
		return ($allele1, $allele2);
	}
	else{
		return ('N','n');	
	}
}
sub nUniqC{
	my @uniq; ## Updated. 
	@uniq[unpack 'U*',$_[0]] = (1)x length $_[0];
	scalar (grep defined $_, @uniq);
}