#! /usr/local/bin/perl

# genojoin.perl: convert genomap genotype data file to joinmap format
# Author: Steve DiFazio
# Date: 2-2003


if(!($ARGV[0])) { die "
converts genomap genotype data file to joinmap format

Usage:

genojoin.perl <genotypefile> > <outputfile>

where
\t<genotypefile> is the genomap output file in genotype format, and
\t<outputfile> will be in joinmap format
\n"; }



$name = $ARGV[0];
$name =~ s/\..*//;

while(<>) {
    if(/^Locus\t/) {
	($l,@samps) = split();
	foreach $i (0 .. $#samps) {
	    if($samps[$i] eq "Mother") {
		$m = $i;
	    }
	    elsif($samps[$i] eq "Father") {
		$f = $i;
	    }
	    elsif($samps[$i] eq "GM") {
		$gm = $i;
	    }
	    elsif($samps[$i] eq "GF") {
		$gf=$i;
	    }
	    elsif(!($prog{$samps[$i]})) {
		$prog++;
		$prog{$samps[$i]} = 1;
	    }
	}
    }
    else {
	if(!(/^Aneu/) && !(/^Nonpar/)) {
	    ($loc,@genos) = split();
	    if($loc && ($#samps ne $#genos)) {
		die "Samps doesn't equal genos at line $. Locus $loc\n";
	    }
	    if($loc && !($loci{$loc})) {
		$loci{$loc} = 1;
		$loci++;
	    }	 
	    foreach $i (0 .. $#genos) {
		($a,$b,$c) = split(//,$genos[$i]);
		if($c) { warn "Genotype contains 3 alleles for $samps[$i] at $loc; discarding allele $c\n"; }
		$agenos{$samps[$i].":".$loc} = $a;
		$bgenos{$samps[$i].":".$loc} = $b;
	    }
	}
    }
}
print "name = $name\n";
print "popt = CP\n";
print "nloc = $loci\n";
print "nind = $prog\n";

print ";Progeny:\n;";
foreach $prog (sort(keys(%prog))) {
    print "$prog ";
}

print "\n";
# print locus name and cross type
foreach $loc (sort(keys(%loci))) {
    print "$loc ";
    $malla = $agenos{$samps[$m].":".$loc};
    $mallb = $bgenos{$samps[$m].":".$loc};
    $falla = $agenos{$samps[$f].":".$loc};
    $fallb = $bgenos{$samps[$f].":".$loc};
    
    $momhet = $momnull = $dadhet = $dadnull = 0;
    $sameba=$sameab=$samea=$sameb=0;
    # determine segregation type and conversion for alleles
    # mother heterozygous
    if(!(same($malla,$mallb))) {
	$momhet = 1;
    }
    # mother has null
    if(same($malla,"N") || same($mallb,"N")) {
	$momnull=1;
    }
    # father heterozygous
    if(!(same($falla,$fallb))) {
	$dadhet = 1;
    }
    # father has null
    if(same($falla,"N") || same($fallb,"N")) {
	$dadnull=1;
    }
    # compare parental alleles
    if((same($malla,$fallb))) {
	$sameab=1;
    }
    if((same($mallb,$falla))) {
	$sameba=1;
    }
    if(same($malla,$falla)) {
	$samea=1;
    }
    if(same($mallb,$fallb)) {
	$sameb=1;
    }
    
    if($momhet) {
	if(!($momnull)) {
	    if($dadhet) {
		if(!($dadnull)) {
		    #ABxAB
		    if($samea && $sameb) {
			print "<hkxhk>\n";
			$all{$malla} = "h";
			$all{$mallb} = "k";
			$all{$falla} = "h";
			$all{$fallb} = "k";
		    }
		    #ABxAC
		    elsif($samea) {
			print "<efxeg>\n";
			$all{$malla} = "e";
			$all{$mallb} = "f";
			$all{$falla} = "e";
			$all{$fallb} = "g";
		    }
		    #ACxBC
		    elsif($sameb) {
			print "<efxeg>\n";
			$all{$malla} = "f";
			$all{$mallb} = "e";
			$all{$falla} = "g";
			$all{$fallb} = "e";
		    }
		    #ABxCA
		    elsif($sameab) {
			print "<efxeg>\n";
			$all{$malla} = "e";
			$all{$mallb} = "f";
			$all{$falla} = "g";
			$all{$fallb} = "e";
		    }
		    #ABxBC
		    elsif($sameba) {
			print "<efxeg>\n";
			$all{$malla} = "f";
			$all{$mallb} = "e";
			$all{$falla} = "e";
			$all{$fallb} = "g";
		    }
		    # all four alleles different and observed
		    else {
			# ABxCD
			print "<abxcd>\n";
			$all{$malla} = "a";
			$all{$mallb} = "b";
			$all{$falla} = "c";
			$all{$fallb} = "d";
		    }
		}
		else {
		    # ABxAN
		    if($samea) {
			print "<lmxll>\n";
			$all{$malla} = "l";
			$all{$mallb} = "m";
			$all{$falla} = "l";
			$all{$fallb} = "l";
		    }
		    # ABxBN
		    elsif($sameba) {
			print "<lmxll>\n";
			$all{$malla} = "m";
			$all{$mallb} = "l";
			$all{$falla} = "l";
			$all{$fallb} = "l";
		    }
		    #ABxCN
		    else {
			print "<abxcd>\n";
			$all{$malla} = "a";
			$all{$mallb} = "b";
			$all{$falla} = "c";
			$all{$fallb} = "d";
		    }
		}
	    }
	    else {
	    #dad homo
		#ABxAA
		if ($samea) {
		    print "<lmxll>\n";
		    $all{$malla} = "l";
		    $all{$mallb} = "m";
		    $all{$falla} = "l";
		    $all{$fallb} = "l";
		}
		#ABxBB;ABxNN;ABxCC throw away allele B because joinmap can't handle it
		else {
		    print "<lmxll>\n";
		    $all{$malla} = "m";
		    $all{$mallb} = "l";
		    $all{$falla} = "l";
		    $all{$fallb} = "l";
		}
    	    }
	}
	# mom AN
	else {
	    if($dadhet) {
		if(!($dadnull)) {
		    # ANxAB, treat A as second null, only follow B
		    if($samea || $sameba) {
			print "<nnxnp>\n";
			$all{$malla} = "n";
			$all{$mallb} = "n";
			$all{$falla} = "n";
			$all{$fallb} = "p";
		    }
		    # ANxBA; shouldn't have sameb here, but doesn't hurt
		    elsif($sameb || $sameab) {
			print "<nnxnp>\n";
			$all{$malla} = "n";
			$all{$mallb} = "n";
			$all{$falla} = "p";
			$all{$fallb} = "n";
		    }
		    # ANxBC; doesn't share maternal allele 
		    else {
			print "<abxcd>\n";
			$all{$malla} = "a";
			$all{$mallb} = "b";
			$all{$falla} = "c";
			$all{$fallb} = "d";
		    }
		}
		else {
		    # ANxAN
		    if($samea && $sameb) {
			print "<hkxhk> (h-,kk)\n";
			$all{$malla} = "h";
			$all{$mallb} = "k";
			$all{$falla} = "h";
			$all{$fallb} = "k";
		    }
		    # ANxBN, all genotypes distinguishable in progeny
		    else {
			print "<efxeg>\n";
			$all{$malla} = "f";
			$all{$mallb} = "e";
			$all{$falla} = "g";
			$all{$fallb} = "e";
		    }


		}
	    }
	    # ANxhomozygote
	    else {
		if($samea) {
		    die "ERROR: locus $loc not segregating. Mother: $malla$mallb Father:$falla$fallb\n";
		}
		#ANxNN;ANxBB
		else {
		    print "<lmxll>\n";
		    $all{$malla} = "m";
		    $all{$mallb} = "l";
		    $all{$falla} = "l";
		    $all{$fallb} = "l";
		}
	    }
	}
    }
    #mom homo
    else {
	if(!($momnull)) {
	    if($dadhet) {
		#AAxAB or BC
		if(!($dadnull)) {
		    print "<nnxnp>\n";
		    #AAxAB
		    if($samea) {
			$all{$malla} = "n";
			$all{$mallb} = "n";
			$all{$falla} = "n";
			$all{$fallb} = "p";
		    }
		    #AAxBA or BC
		    else {
			$all{$malla} = "n";
			$all{$mallb} = "n";
			$all{$falla} = "p";
			$all{$fallb} = "n";
		    }
		}
		#AAxhetero null
		else { 
		    #AAxAN
		    if($samea) {
			die "ERROR: locus $loc not segregating. Mother: $malla$mallb Father:$falla$fallb\n";
		    }
		    #AAxBN
		    else {
			print "<nnxnp>\n";
			$all{$malla} = "n";
			$all{$mallb} = "n";
			$all{$falla} = "p";
			$all{$fallb} = "n";
		    }
		}
	    }
	    # mom and dad homozygote observed
	    else {
		#AAxAA
		if($samea) {
		    die "ERROR: locus $loc not segregating. Mother: $malla$mallb Father:$falla$fallb\n";
		}
		#AAxBB
		else {
		    die "ERROR: locus $loc not segregating. Mother: $malla$mallb Father:$falla$fallb\n";
		}
	    }
	}
	# mom NN
	else {
	    if($dadhet) {
		#NNxAB or AN or BN
		print "<nnxnp>\n";
		$all{$malla} = "n";
		$all{$mallb} = "n";
		$all{$falla} = "p";
		$all{$fallb} = "n";
	    }
	    else {
		die "ERROR: locus $loc not segregating. Mother: $malla$mallb Father:$falla$fallb\n";
	    }
	}
    }
    foreach $prog (sort(keys(%prog))) {
	if(!($all{$agenos{$prog.":".$loc}})) { $all{$agenos{$prog.":".$loc}} = "-"; }
	if(!($all{$bgenos{$prog.":".$loc}})) { $all{$bgenos{$prog.":".$loc}} = "-"; }
	print $all{$agenos{$prog.":".$loc}},$all{$bgenos{$prog.":".$loc}}," ";
    }
    print "\n\n";
    # reset alleles
    $all{$malla} = "";
    $all{$mallb} = "";
    $all{$falla} = "";
    $all{$fallb} = "";
}


sub same {
    my ($a,$b) = @_;
    if($a ne $b) { return 0; }
    else { return 1; }
}