#!/usr/local/bin/perl
#
# Renumber the individuals in all pedigrees to fill in the wholes.
# The pedin and pedout files are in linkage format(ped, ind, father, mother, sex, DNA, ...).
# The correspendence file format is : ped, ne-ind, old-ind
#
# Usage : renum.pl file=pedin result=pedout corres=file3
# Help  : renum.pl -h

# Contact : Department of human Genetics CNRS UPRESA8090
#           Institute of Biologie of Lille FRANCE
#           gaget@mail-good.pasteur-lille.fr

do main();

sub help {
    print("\n$0 file=pedin result=pedout corres=file3 [-v] [-h]\n");
    print "\t-v : verbose, -h : help\n\n";
    exit;
}

sub main {
    parseArgs();
    lect_in($pedin);
    trou();
    outnum($pedout);
    outcores($coresFile);
}

sub parseArgs {
    while ($arg = shift(@ARGV)) {
        $pedin        = $1  if $arg =~ /file=(.*)/;
        $pedout       = $1  if $arg =~ /result=(.*)/;
        $coresFile    = $1  if $arg =~ /corres=(.*)/;
        $help         = "Y" if $arg =~ /-h/;
        $verbose      = "-v" if $arg =~ /-v/;
    }
    help() if ($help);
    die "$0 : pedin file is required\n" unless ($pedin);
    die "$0 : pedout file is required\n" unless ($pedout);
    die "$0 : correspondence file corres is required\n" unless ($coresFile);
    die("$0 : cannot find file $pedin\n") unless (-f $pedin);
}

sub lect_in {
    local($file) = @_;
    local($fh) = 'FH';
    local($line, $tmp);
    local($cptr) = 0;
    local($ped, $ind);

    print "read $file\n" if ($verbose);
    open($fh, $file) || die("$0 : cannot open $file : $!");
    while(<$fh>) {
        chop;
        $cptr++;
        $line=$_;
        ($ped, $ind) = split(/\t/, $line);
        $all{$ped, $ind}=$line;
        $tmp = grep ($_ eq $ped, @pedList);
        push @pedList, $ped unless ( $tmp );
        $indList{$ped} .= "$ind ";
    }
    close($fh);
    print "$cptr lines read in file $file\n" if ($verbose);
}

sub trou {
    local($ped, $ind, $i);
    local($cores);
    local(@oldInd, @tmp);
    local(%transpo);
    local($father, $mother);

    for $ped (@pedList) {
       @oldInd=();
       %transpo=();
       (@oldInd) = split(/\s/, $indList{$ped});
       $i=1;
       for $ind (@oldInd) {
          $transpo{$ind}=$i;
          $cores="$ped\t$i\t$ind";
          push @coresList, $cores;
          $i++;
       }
       $transpo{0}=0;
       for $ind (@oldInd) {
          @tmp=();
          (@tmp) = split (/\t/, $all{$ped, $ind});
          $father=$transpo{$tmp[2]};
          $mother=$transpo{$tmp[3]};
          $all{$ped, $ind} = "$ped\t$transpo{$ind}\t$father\t$mother";
          for ($i=4;$i<=$#tmp;$i++) { $all{$ped, $ind} .= "\t$tmp[$i]"; }
       }
   }
}

sub outnum {
    local ($file) = @_;
    local($fh) = 'FHO';
    local($cptr) = 0;
    local($ped, $ind);
    local(@oldInd);

    print "write $file\n" if ($verbose);
    open($fh, "> $file") || die("$0 : cannot creat $file : $!");
    for $ped (@pedList) {
       @oldInd=();
       (@oldInd) = split(/\s/, $indList{$ped});
       for $ind (@oldInd) {
          print $fh "$all{$ped,$ind}\n";
          $cptr++;
       }
    }
    close($fh);
    print "$cptr lines written to $file\n" if ($verbose);
}

sub outcores {
    local ($file) = @_;
    local($fh) = 'FHO';
    local($cptr) = 0;
    local($cores);

    print "write $file\n" if ($verbose);
    open($fh, "> $file") || die("$0 : cannot creat $file : $!");
    for $cores (@coresList) {
       print $fh "$cores\n";
       $cptr++;
    }
    close($fh);
    print "$cptr lines written to $file\n\n" if ($verbose);
}