{PROGRAM NAUSICAA}


{(C) Copyright 2009, Hervé Mulard}

{Distributed under the terms of the GNU General Public License}

{*************************************************************************************************************************************************************}



{This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.}




{*************************************************************************************************************************************************************}











{LIST OF UNITS USED BY THE PROGRAM, THE MAIN PROGRAM IS AT THE END OF THE FILE}



{*************************************************************************************************************************************************************}




unit NausicaaConstantes;

{
Unit with the main constantes of the program}

interface

const
  IndMax = 1000; {Maximum number of individuals (lines) in the genetic file}
  LocusMax = 30; {Maximum number of loci in the genetic file}
  NbAllele = 100; {Maximum number of alleles by loci}
  FamilyMax = 4000; {Maximum number of families (lines) in the family file}
  TailleFamMax = 10; {Maximum number of chicks in a family}
  NbAnnees = 50; {Maximum number of years of observations [not yet implemented]}

implementation


end.



{*************************************************************************************************************************************************************}



unit NausicaaUtilitaires;

{
Unit with the main functions, types and procedures used by the other programs
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, NausicaaConstantes, Math;

type
  Gen3Dig = array[1..2] of Word;  {Table with 2 cases for each allele in a locus}

type                      {Table with informations for an individual}
  Genot3Dig = record
    Population: String[3];
    Individual: String[10];
    Sexe: String[1];
    Status: String[1];
    Genotype: array[1..LocusMax] of Gen3Dig;
  end;

type           {General table with all informations for all individuals}
  TabGen3D = array[1..IndMax+1] of Genot3Dig;

type            {Table with informations used for permutations}
  GenotAPermDig = record
    Sexe: String[1];
    Status: String[1];
    AnnNais: ShortInt;
    Genotype: array[1..LocusMax] of Gen3Dig;
  end;

type          {General tables for permutations}
  TabGenAPerm = array[1..IndMax+1] of GenotAPermDig;

type       {Table of informations of one family used in permutations}
  FamilyPerm = record
    Male: Integer;
    Femelle: Integer;
    DistGen: Single;
    Succes: String[1];
  end;

type         {General table of all families in permutations}
  FamilyAPerm = array[1..FamilyMax+1] of FamilyPerm; 

type      {Table of allelic frequencies}
  FqzAll = record
    FAll: Single;
    FInd: Single;  {1er nombre : fréquence allélique, 2e nombre : fréquence des individus ayant cet allèle}
  end;
  NbObs = record
    NbAll: Word;
    NbInd: Word;
  end;

type   {Table of genetic distances}
  FqDist = record
    Dist: word;
    FqDi: single;
  end;

type  {General table of genetic distances}
  TabFDist = array[1..LocusMax,1..NbAllele] of FqDist;

type       {Types of alleles}
  Allele = record
    Name: Word;
    Freq: FqzAll;
  end;
  AlleleObs = record
    Obsv: NbObs;
  end;

type  {Table recording the number of observation of each allele}
  Locus = record
    Name: Byte;
    TabAll: array[1..NbAllele] of Allele;
  end;
  LocusObs = record
    TabAll: array[1..NbAllele] of AlleleObs;
  end;

type    {Type for calculations of indices for one locus}
  DonnGenetId = record
    Fait: Boolean;
    Valeurs: array[1..3] of Single;
  end;

type   {Type for calculations of indices fon one individual}
  IndGenInd = array[1..LocusMax+2] of DonnGenetId;

type   {Types of table of allelic frequencies and observations of alleles}
  TabFreqAll = array[1..LocusMax] of Locus;
  TabFreqAllObs = array[1..LocusMax] of LocusObs;

type
  StdTb = array[1..LocusMax] of Single;

type     {Family table}
  TabFamily = array[1..FamilyMax,1..TailleFamMax] of Word;

type     {Table for paternity analyses}
  ExtPatInd = array[1..3] of Single;
  ExtPat = array[1..LocusMax+1] of ExtPatInd;
  BandSharing = array[1..LocusMax+2] of Word;
  Rel = record
    Val  : Single;
  end;

type
  Related = array[1..LocusMax+2] of Rel;
  ChocAll = array[1..NbAllele+1] of Rel;

var
  Gen3Etude: TabGen3D;
  Population,Sexe,Status: Boolean;
  LoadGen: Word;
  FreqzAllEtude : TabFreqAll;
  LoadFamily: Boolean;
  Families: TabFamily;
  IndividualNb,FamilyNb: Word;
  Stat,Sexsun,Popu: string[5];

function ExtractPop3(Gn3:TabGen3D;popname:string):TabGen3D;
function ExtractSex3(Gn3:TabGen3D;sexname:string):TabGen3D;
function ExtractStt3(Gn3:TabGen3D;sttname:string):TabGen3D;
function CalcFreqzAll(Gn3:TabGen3D):TabFreqAll;
function LookMaxDist(l:word;TbCoulson:TabFDist):word;
function LookNumberForIndividual(name:string):word;
function Meanarize(ChCalcul:Byte;NmFamil:Word):IndGenInd;
function CalcGenIndiv(ChoixCalcul:Byte;NmId:word):IndGenInd;
function CalcExclusionProb(Papa,Maman,Moi:word):ExtPat;
function CalcExclusionProb2(Pere,Mere,Moi:word):BandSharing;
function ILoveYou(Choice,Fam:word):Related;
function ExtractPopTInd(Gn3:TabGen3D;popname:string):TabGenAPerm;
function ExtractSttTInd(Gn3:TabGenAPerm;sttname:string):TabGenAPerm;
function ConvertIndiv(Gn3:TabGen3D):TabGenAPerm;
function CalcFreqzAllTInd(Gn3:TabGenAPerm):TabFreqAll;
function InitialisationDesFamy:FamilyAPerm;
function EcrivainObs(GenotypeReel:TabGen3D;FamyReel:TabFamily;Calcul:integer):string;
function InitialisationIndiv(indiv:integer):GenotAPermDig;
function Sordeloeuf(GenotCree:TabGenAPerm;annee,indiv:integer):GenotAPermDig;
function OccupezLesSites(GenotCree:TabGenAPerm;FamyOld:FamilyAPerm;Sites,TotalInd,DivorcS,DivorcE:Integer):FamilyAPerm;
function CalculeDistGenet(Famy:FamilyAPerm;Calcul:integer;GenotCree:TabGenAPerm):FamilyAPerm;
function Succes(Famy:FamilyAPerm;TypScc,Echec,NbFamy:Integer):FamilyAPerm;
function Idie(GenotCree:TabGenAPerm;TxMort,indiv:integer):GenotAPermDig;
function EcrivainTableau(PermNb,AnNb:integer;Famy:FamilyAPerm):string;
function Arrondir(nombre : extended ; nbDecim : integer) : extended;
function ReportDisponibilite(GenotCree:TabGenAPerm;Famy:FamilyAPerm;IndTot:integer):TabGenAPerm;
function DoesItMatch(i,Bebe,Maman:integer):single;

implementation

function Arrondir(nombre : extended ; nbDecim : integer) : extended;
{Function that round a number according to the number of decimals nbDecim asked}
var
  p10 : extended;
begin
  { 2 étant le cas le plus fréquent, on le traite directement }
  if (nbDecim = 2) then
    result := round(nombre * 100) / 100
  else
  begin
    p10 := Power(10,nbDecim);
    result := round(nombre * p10) / p10;
  end;
end;

function InitialisationDesFamy:FamilyAPerm;
{Function that initialize the families for permutations}
var
  zeel: integer;
begin
  for zeel := 1 to FamilyMax+1 do
  begin
    InitialisationDesFamy[zeel].Male := 0;
    InitialisationDesFamy[zeel].Femelle := 0;
    InitialisationDesFamy[zeel].DistGen := 0;
    InitialisationDesFamy[zeel].Succes := '';
  end;
end;

function ExtractPop3(Gn3:TabGen3D;popname:string):TabGen3D;
{Function that extract a population from the genetic files, when asked
to restrain the calculation of allelic frequencies to one population}
var
  iw,select: Word;
begin
  select := 1;
  for iw := 1 to IndMax do
  begin
    if Gn3[iw].Population = popname then
    begin
      ExtractPop3[select] := Gn3[iw];
      select := select+1;
    end;
  end;
  for iw := select to IndMax do ExtractPop3[iw] := Gn3[IndMax+1];
end;

function ExtractSex3(Gn3:TabGen3D;sexname:string):TabGen3D;
{Function that extract a sexe from the genetic files, when asked
to restrain the calculation of allelic frequencies to one sexe}
var
  iw,select: Word;
begin
  select := 1;
  for iw := 1 to IndMax do
  begin
    if Gn3[iw].Sexe = sexname then
    begin
      ExtractSex3[select] := Gn3[iw];
      select := select+1;
    end;
  end;
  for iw := select to IndMax do ExtractSex3[iw] := Gn3[IndMax+1];
end;

function ExtractStt3(Gn3:TabGen3D;sttname:string):TabGen3D;
{Function that extract a status from the genetic files, when asked
to restrain the calculation of allelic frequencies to one status}
var
  iw,select: Word;
begin
  select := 1;
  for iw := 1 to IndMax do
  begin
    if Gn3[iw].Status = sttname then
    begin
      ExtractStt3[select] := Gn3[iw];
      select := select+1;
    end;
  end;
  for iw := select to IndMax do ExtractStt3[iw] := Gn3[IndMax+1];
end;

function ExtractPopTInd(Gn3:TabGen3D;popname:string):TabGenAPerm;
{General fucntion that extract a sub sample from the genetic files, when asked
to restrain the calculation of allelic frequencies to various variables
This function will use the 3 functions above "Extract..."
This function is used in permutations only}
var
  iw,select,j: Word;
begin
  select := 1;
  for iw := 1 to IndMax do
  begin
    if Gn3[iw].Population = popname then
    begin
      ExtractPopTInd[select].Sexe := Gn3[iw].Sexe;
      ExtractPopTInd[select].Status := Gn3[iw].Status;
      for j := 1 to LocusMax do
      begin
        ExtractPopTInd[select].Genotype[j,1] := Gn3[iw].Genotype[j,1];
        ExtractPopTInd[select].Genotype[j,2] := Gn3[iw].Genotype[j,2];
      end;
      ExtractPopTInd[select].AnnNais := 0;
      select := select+1;
    end;
  end;
  for iw := select to IndMax+1 do
  begin
      ExtractPopTInd[select].Sexe := '';
      ExtractPopTInd[select].Status := '';
      for j := 1 to LocusMax do
      begin
        ExtractPopTInd[select].Genotype[j,1] := 0;
        ExtractPopTInd[select].Genotype[j,2] := 0;
      end;
      ExtractPopTInd[select].AnnNais := 0;
  end;
end;

function ConvertIndiv(Gn3:TabGen3D):TabGenAPerm;
{Function that implementes the informations contained in a TabGen3D in a TabGenAPerm,
used to put individuals of known genotypes in a table for permutations}
var
  iw,j: Word;
begin
  for iw := 1 to IndMax+1 do
  begin
    ConvertIndiv[iw].Sexe := Gn3[iw].Sexe;
    ConvertIndiv[iw].Status := Gn3[iw].Status;
    for j := 1 to LocusMax do
    begin
      ConvertIndiv[iw].Genotype[j,1] := Gn3[iw].Genotype[j,1];
      ConvertIndiv[iw].Genotype[j,2] := Gn3[iw].Genotype[j,2];
    end;
    ConvertIndiv[iw].AnnNais := 0;
  end;
end;

function ExtractSttTInd(Gn3:TabGenAPerm;sttname:string):TabGenAPerm;
{General fucntion that extract a sub sample from the genetic files, when asked
to restrain the calculation of allelic frequencies to various variables
This function will use the 3 functions above "Extract..."}
var
  iw,select: Word;
begin
  select := 1;
  for iw := 1 to IndMax do
  begin
    if Gn3[iw].Status = sttname then
    begin
      ExtractSttTInd[select] := Gn3[iw];
      select := select+1;
    end;
  end;
  for iw := select to IndMax do ExtractSttTInd[iw] := Gn3[IndMax+1];
end;

function CalcFreqzAllTInd(Gn3:TabGenAPerm):TabFreqAll;
{Calculation of allelic frequencies in a table for permutations}
var
  ContLoc,ContAll,ComparAll,NbLoc,NbAllInd,OK: Byte;          {OK=0 si allèle ancien, 1 si nouveau}
  ContInd : Word;
  nball, compt: word;
  TransitFrAllq: Allele;
  Eliodor: TabFreqAll;
  EliodorObs: TabFreqAllObs;
begin
  ContLoc := 0;
  repeat
    ContLoc := ContLoc+1;
  until ((Gn3[1].Genotype[ContLoc,1] = Gn3[IndMax+1].Genotype[ContLoc,1]) or (ContLoc > LocusMax));
  NbLoc := ContLoc-1;

  for ContLoc := 1 to LocusMax do
  begin
    Eliodor[ContLoc].Name := 0;
    for compt := 1 to NbAllele do
    begin
      Eliodor[ContLoc].TabAll[compt].Freq.Fall := 0;
      Eliodor[ContLoc].TabAll[compt].Freq.FInd := 0;
      Eliodor[ContLoc].TabAll[compt].Name := 0;
      EliodorObs[ContLoc].TabAll[compt].Obsv.NbAll := 0;
      EliodorObs[ContLoc].TabAll[compt].Obsv.NbInd := 0;
    end;
  end;

  for ContLoc := 1 to NbLoc do
  begin
    Eliodor[ContLoc].Name := ContLoc;
    ContAll := 0;
    ContInd := 1;
    repeat
      if Gn3[ContInd].Genotype[ContLoc,1] <> 0 then
      begin
        for NbAllInd := 1 to 2 do {On regarde chaque allèle de l'individu}
        begin
          {si l'allèle est nouveau on le note, sinon on rajoute 1 au nbobs de cet allèle}
           if Gn3[ContInd].Genotype[ContLoc,NbAllInd] <> 0 then
           begin
             ComparAll := 0;
             OK := 1;
             repeat
               ComparAll := ComparAll+1;
               if Gn3[ContInd].Genotype[ContLoc,NbAllInd] = Eliodor[ContLoc].TabAll[ComparAll].Name
               then OK := 0;
             until (((OK = 0) or (ComparAll >= ContAll)) or (ComparAll > NbAllele));
             if OK = 0 then
             begin
               if ((NbAllInd = 2) and (Gn3[ContInd].Genotype[ContLoc,1] = Gn3[ContInd].Genotype[ContLoc,2])) then
               begin
                 EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbAll := EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbAll +1;
               end
               else
               begin
                 EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbAll := EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbAll +1;
                 EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbInd := EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbInd +1;
               end;
             end
             else
             begin
               ContAll := ContAll+1;
               Eliodor[ContLoc].TabAll[ContAll].Name := Gn3[ContInd].Genotype[ContLoc,NbAllInd];
               EliodorObs[ContLoc].TabAll[ContAll].Obsv.NbAll := 1;
               EliodorObs[ContLoc].TabAll[ContAll].Obsv.NbInd := 1;
             end;
           end;
        end;
      end;
      ContInd := ContInd+1;
    until ContInd > IndMax; {Arret du compteur individuel quand il n'y a plus d'individu}

    compt := 0;
    ContInd := 1;
    repeat
      if Gn3[ContInd].Genotype[ContLoc,1] <> 0 then compt := compt+1;
      ContInd := ContInd+1;
    until ContInd > IndMax;

    for ComparAll := 1 to ContAll do
    begin
      Eliodor[ContLoc].TabAll[ComparAll].Freq.FAll := EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbAll/(2*compt);
      Eliodor[ContLoc].TabAll[ComparAll].Freq.FInd := EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbInd/compt;
    end;
  end;

  ContInd := 0;
  repeat
    ContInd := ContInd+1;
  until ContInd > IndMax;
  IndividualNb := ContInd-1;

  ContLoc := 1;
  repeat
    nball := 0;
    repeat                          {Compte le nb d'allèles au locus ContLoc}
      nball := nball+1;
    until ((Eliodor[ContLoc].TabAll[nball].Name = 0) or (nball > NbAllele));
    for compt := 1 to (nball-1) do
    begin
      for ContAll := compt to (nball-1) do
      begin
        if (Eliodor[ContLoc].TabAll[ContAll].Name <= Eliodor[ContLoc].TabAll[compt].Name)
        then
        begin
          TransitFrAllq := Eliodor[ContLoc].TabAll[compt];              {inversion des deux lignes}
          Eliodor[ContLoc].TabAll[compt] := Eliodor[ContLoc].TabAll[ContAll];
          Eliodor[ContLoc].TabAll[ContAll] := TransitFrAllq;
        end;
      end;
    end;
    for compt := nball to NbAllele do
    begin
      Eliodor[ContLoc].TabAll[compt].Name := 0;
      Eliodor[ContLoc].TabAll[compt].Freq.Fall := 0;
      Eliodor[ContLoc].TabAll[compt].Freq.Find := 0;
    end;
    ContLoc := ContLoc+1;
  until ((Eliodor[ContLoc].Name = 0) or (ContLoc > LocusMax));

  for compt := ContLoc to LocusMax do    {Initialisation du reste de la matrice}
  begin
    for nball := 1 to NbAllele do
    begin
      Eliodor[ContLoc].TabAll[ContLoc].Name := 0;
      Eliodor[ContLoc].TabAll[ContLoc].Freq.Fall := 0;
      Eliodor[ContLoc].TabAll[ContLoc].Freq.Find := 0;
    end;
  end;

  CalcFreqzAllTInd := Eliodor;
end;

function CalcFreqzAll(Gn3:TabGen3D):TabFreqAll;
{Calculation of allelic frequencies in the microsatellite file}
var
  ContLoc,ContAll,ComparAll,NbLoc,NbAllInd,OK: Byte;          {OK=0 si allèle ancien, 1 si nouveau}
  ContInd : Word;
  nball, compt: word;
  TransitFrAllq: Allele;
  Eliodor: TabFreqAll;
  EliodorObs: TabFreqAllObs;
begin
  ContLoc := 0;
  repeat
    ContLoc := ContLoc+1;
  until ((Gn3[1].Genotype[ContLoc,1] = Gn3[IndMax+1].Genotype[ContLoc,1]) or (ContLoc > LocusMax));
  NbLoc := ContLoc-1;

  for ContLoc := 1 to LocusMax do
  begin
    Eliodor[ContLoc].Name := 0;
    for compt := 1 to NbAllele do
    begin
      Eliodor[ContLoc].TabAll[compt].Freq.Fall := 0;
      Eliodor[ContLoc].TabAll[compt].Freq.FInd := 0;
      Eliodor[ContLoc].TabAll[compt].Name := 0;
      EliodorObs[ContLoc].TabAll[compt].Obsv.NbAll := 0;
      EliodorObs[ContLoc].TabAll[compt].Obsv.NbInd := 0;
    end;
  end;

  for ContLoc := 1 to NbLoc do
  begin
    Eliodor[ContLoc].Name := ContLoc;
    ContAll := 0;
    ContInd := 1;
    repeat
      if Gn3[ContInd].Genotype[ContLoc,1] <> 0 then
      begin
        for NbAllInd := 1 to 2 do {On regarde chaque allèle de l'individu}
        begin
          {si l'allèle est nouveau on le note, sinon on rajoute 1 au nbobs de cet allèle}
           if Gn3[ContInd].Genotype[ContLoc,NbAllInd] <> 0 then
           begin
             ComparAll := 0;
             OK := 1;
             repeat
               ComparAll := ComparAll+1;
               if Gn3[ContInd].Genotype[ContLoc,NbAllInd] = Eliodor[ContLoc].TabAll[ComparAll].Name
               then OK := 0;
             until (((OK = 0) or (ComparAll >= ContAll)) or (ComparAll > NbAllele));
             if OK = 0 then
             begin
               if ((NbAllInd = 2) and (Gn3[ContInd].Genotype[ContLoc,1] = Gn3[ContInd].Genotype[ContLoc,2])) then
               begin
                 EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbAll := EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbAll +1;
               end
               else
               begin
                 EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbAll := EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbAll +1;
                 EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbInd := EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbInd +1;
               end;
             end
             else
             begin
               ContAll := ContAll+1;
               Eliodor[ContLoc].TabAll[ContAll].Name := Gn3[ContInd].Genotype[ContLoc,NbAllInd];
               EliodorObs[ContLoc].TabAll[ContAll].Obsv.NbAll := 1;
               EliodorObs[ContLoc].TabAll[ContAll].Obsv.NbInd := 1;
             end;
           end;
        end;
      end;
      ContInd := ContInd+1;
    until ((Gn3[ContInd].Individual = '') or (ContInd > IndMax)); {Arret du compteur individuel quand il n'y a plus d'individu}

    compt := 0;
    ContInd := 1;
    repeat
      if Gn3[ContInd].Genotype[ContLoc,1] <> 0 then compt := compt+1;
      ContInd := ContInd+1;
    until ((Gn3[ContInd].Individual = '') or (ContInd > IndMax));

    for ComparAll := 1 to ContAll do
    begin
      Eliodor[ContLoc].TabAll[ComparAll].Freq.FAll := EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbAll/(2*compt);
      Eliodor[ContLoc].TabAll[ComparAll].Freq.FInd := EliodorObs[ContLoc].TabAll[ComparAll].Obsv.NbInd/compt;
    end;
  end;

  ContInd := 0;
  repeat
    ContInd := ContInd+1;
  until ((Gn3[ContInd].Individual = '') or (ContInd > IndMax));
  IndividualNb := ContInd-1;

  ContLoc := 1;
  repeat
    nball := 0;
    repeat                          {Compte le nb d'allèles au locus ContLoc}
      nball := nball+1;
    until ((Eliodor[ContLoc].TabAll[nball].Name = 0) or (nball > NbAllele));
    for compt := 1 to (nball-1) do
    begin
      for ContAll := compt to (nball-1) do
      begin
        if (Eliodor[ContLoc].TabAll[ContAll].Name <= Eliodor[ContLoc].TabAll[compt].Name)
        then
        begin
          TransitFrAllq := Eliodor[ContLoc].TabAll[compt];              {inversion des deux lignes}
          Eliodor[ContLoc].TabAll[compt] := Eliodor[ContLoc].TabAll[ContAll];
          Eliodor[ContLoc].TabAll[ContAll] := TransitFrAllq;
        end;
      end;
    end;
    for compt := nball to NbAllele do
    begin
      Eliodor[ContLoc].TabAll[compt].Name := 0;
      Eliodor[ContLoc].TabAll[compt].Freq.Fall := 0;
      Eliodor[ContLoc].TabAll[compt].Freq.Find := 0;
    end;
    ContLoc := ContLoc+1;
  until ((Eliodor[ContLoc].Name = 0) or (ContLoc > LocusMax));

  for compt := ContLoc to LocusMax do    {Initialisation du reste de la matrice}
  begin
    for nball := 1 to NbAllele do
    begin
      Eliodor[ContLoc].TabAll[ContLoc].Name := 0;
      Eliodor[ContLoc].TabAll[ContLoc].Freq.Fall := 0;
      Eliodor[ContLoc].TabAll[ContLoc].Freq.Find := 0;
    end;
  end;

  CalcFreqzAll := Eliodor;
end;

function StdHtz:StdTb;
{Calculation of the standardized heterozygosity}
var
  iloc,iall,ii:word;
  TransitStHt:StdTb;
begin
  for iloc := 1 to LocusMax do TransitStHt[iloc] := 0;

  iloc := 1;
  repeat
    iall := 2;
    repeat
      TransitStHt[iloc] := TransitStHt[iloc]+Sqr(FreqzAllEtude[iloc].TabAll[iall].Freq.FAll);
      iall := iall+1;
    until ((FreqzAllEtude[iloc].TabAll[iall].Name = 0) or (iall > NbAllele));
    TransitStHt[iloc] := 1-TransitStHt[iloc];
    iloc := iloc+1;
  until ((FreqzAllEtude[iloc].Name = 0) or (iloc > LocusMax));

  for ii := iloc to LocusMax do
  begin
    TransitStHt[ii] := 0;
  end;

  StdHtz := TransitStHt;
end;

function IndHtz(NumL:Byte;All1,All2:Word;SdTb:StdTb):DonnGenetId;
{Calculation of the individual direc heterozygosity}
begin
  if ((All1 <> 0) and (All2 <> 0)) then
  begin
    IndHtz.Fait := True;
    if (All1 <> All2) then
    begin
      IndHtz.Valeurs[1] := 1;
      IndHtz.Valeurs[2] := 1/SdTb[NumL];
    end
    else
    begin
      IndHtz.Valeurs[1] := 0;
      IndHtz.Valeurs[2] := 0;
    end;
  end
  else
  begin
    IndHtz.Fait := False;
    IndHtz.Valeurs[1] := 99999;
    IndHtz.Valeurs[2] := 99999;
  end;
  IndHtz.Valeurs[3] := 0;
end;

function LookFreq(Locus:Byte;Allele:Word):Single;
{Function that looks in the table of allelic frequencies to give the frequency
of a specific allele}
var
  search: byte;
begin
  search := 0;
  repeat
    search := search+1;
  until ((FreqzAllEtude[Locus].TabAll[search].Name = Allele)
  or (FreqzAllEtude[Locus].TabAll[search].Name = 0) or (search > NbAllele));
  if FreqzAllEtude[Locus].TabAll[search].Name = 0
  then LookFreq := 1/(2*(IndividualNb+1))
  else LookFreq := FreqzAllEtude[Locus].TabAll[search].Freq.FAll;
end;

function StdCoulson:TabFDist;
{Calculation of the standardized d² of Coulson}
var
  iloc, ok: byte;
  iall1, iall2, compardis, distancecalc: word;
  TransitStCl: TabFDist;
begin
  for iloc := 1 to LocusMax do
  begin
    for iall1 := 1 to NbAllele do
    begin
      TransitStCl[iloc,iall1].Dist := 0;
      TransitStCl[iloc,iall1].FqDi := 0;
    end;
  end;

  iloc := 1;
  repeat
    iall1 := 1;
    repeat
      iall2 := 1;
      repeat
        compardis := 1;
        distancecalc := Sqr(FreqzAllEtude[iloc].TabAll[iall2].Name-FreqzAllEtude[iloc].TabAll[iall1].Name);
        ok := 0;
        if distancecalc <> 0 then
        begin
          repeat
            compardis := compardis+1;
            if TransitStCl[iloc,compardis].Dist = distancecalc then ok := 1;
          until ((ok = 1) or (TransitStCl[iloc,compardis].Dist = 0) or (compardis > NbAllele));
          TransitStCl[iloc,compardis].Dist := distancecalc;
          TransitStCl[iloc,compardis].FqDi := TransitStCl[iloc,compardis].FqDi+LookFreq(iloc,FreqzAllEtude[iloc].TabAll[iall1].Name)*LookFreq(iloc,FreqzAllEtude[iloc].TabAll[iall2].Name);
        end
        else TransitStCl[iloc,1].FqDi := TransitStCl[iloc,1].FqDi+LookFreq(iloc,FreqzAllEtude[iloc].TabAll[iall1].Name)*LookFreq(iloc,FreqzAllEtude[iloc].TabAll[iall2].Name);
        iall2 := iall2+1;
      until ((FreqzAllEtude[iloc].TabAll[iall2].Name = 0) or (iall2 > NbAllele));
      iall1 := iall1+1;
    until ((FreqzAllEtude[iloc].TabAll[iall1].Name = 0) or (iall1 > NbAllele));
    iall1 := 1;
    repeat
      iall1 := iall1+1;
    until ((TransitStCl[iloc,iall1].Dist = 0) or (iall1 > NbAllele));
    for iall2 := iall1 to NbAllele do
    begin
      TransitStCl[iloc,iall2].Dist := 0;
      TransitStCl[iloc,iall2].FqDi := 0;
    end;
    iloc := iloc+1;
  until ((FreqzAllEtude[iloc].Name = 0) or (iloc > LocusMax));

  for compardis := iloc to LocusMax do
  begin
    for iall1 := 1 to NbAllele do
    begin
      TransitStCl[compardis,iall1].Dist := 0;
      TransitStCl[compardis,iall1].FqDi := 0;
    end;
  end;

  StdCoulson := TransitStCl;
end;

function LookFDis(TabDis:TabFDist;Locus:Byte;Distance:Word):Single;
{Function that looks in the table of distance to give the frequency of observation
of a specific genetic distance}
var
  search: byte;
begin
  search := 0;
  repeat
    search := search+1;
  until ((TabDis[Locus,search].Dist = Distance) or
  ((TabDis[Locus,search].Dist = 0) and (search <> 1)) or (search > NbAllele));
  if (((TabDis[Locus,search].Dist = 0) and (search <> 1)) or (search > NbAllele))
  then LookFDis := 1/(IndividualNb+1)
  else LookFDis := TabDis[Locus,search].FqDi;
end;


function LookMaxDist(l:word;TbCoulson:TabFDist):word;
{Function that looks in the table of distance to give the maximal genetic distance
observed}
var
  maxencours,dis: word;
begin
  maxencours := 0;
  dis := 1;
  repeat
    if maxencours < TbCoulson[l,dis].Dist then maxencours := TbCoulson[l,dis].Dist;
    dis := dis+1;
  until ((TbCoulson[l,dis].Dist = 0) or (dis > NbAllele));
  LookMaxDist := maxencours;
end;

function IndCoul(NumL,All1,All2:Word;SdTb:TabFDist):DonnGenetId;
{Calculation of the direct d² of Coulson}
var
  Val1:word;
begin
  if ((All1 <> 0) and (All2 <> 0)) then
  begin
    IndCoul.Fait := True;
    IndCoul.Valeurs[1] := Sqr(All1-All2);
    Val1 := Sqr(All1-All2);
    IndCoul.Valeurs[2] := LookFDis(SdTb,NumL,Sqr(All1-All2));
    IndCoul.Valeurs[3] := Val1/LookMaxDist(NumL,SdTb);
  end
  else
  begin
    IndCoul.Fait := False;
    IndCoul.Valeurs[1] := 99999;
    IndCoul.Valeurs[2] := 99999;
    IndCoul.Valeurs[3] := 99999;
  end;
end;

function LookNumberForIndividual(name:string):word;
{Function that looks in the microsatellite table to give back the number in the table of a
an individual for which we know the code}
var
  researcher: word;
begin
  researcher := 0;
  repeat
    researcher := researcher+1;
  until ((researcher > IndMax) or (Gen3Etude[researcher].Individual = name));
  if researcher > IndMax then LookNumberForIndividual := 0 else LookNumberForIndividual := researcher;
  if name = '' then LookNumberForIndividual := 0
end;

function CalcGenIndiv(ChoixCalcul:Byte;NmId:word):IndGenInd;
{Function that calculation the individual genetic quality}
var
  TotalLoc,LocusEnCours: Byte;
  NmAl,NbLocFait: Word;
  Somfreq,Ponderat: Single;
  TransitIdGId: IndGenInd;
  SdTb: StdTb;
  TbCoulson: TabFDist;
begin
  NbLocFait := 0;                 {Initialisation des petites variables}

  for LocusEnCours := 1 to LocusMax do      {Initialisation des tables de distance}
  begin
    for NmAL := 1 to NbAllele do
    begin
      TbCoulson[LocusEnCours,NmAl].Dist := 0;
      TbCoulson[LocusEnCours,NmAl].FqDi := 0;
    end;
    SdTb[LocusEnCours] := 0;
  end;
  
  for LocusEnCours := 1 to LocusMax+2 do    {Initialisation de la table d'indice}
  begin
    TransitIdGId[LocusEnCours].Fait := False;
    TransitIdGId[LocusEnCours].Valeurs[1] := 0;
    TransitIdGId[LocusEnCours].Valeurs[2] := 0;
    TransitIdGId[LocusEnCours].Valeurs[3] := 0;
  end;

  LocusEnCours := 0;                     {Comptage du nombre de loci}
  repeat
    LocusEnCours := LocusEnCours+1;
  until ((Gen3Etude[1].Genotype[LocusEnCours,1] = Gen3Etude[IndMax+1].Genotype[LocusEnCours,1]) or (LocusEnCours > LocusMax));
  TotalLoc := LocusEnCours-1;

  if NmId <> 0 then                    {L'individu existe ??}
  begin

  if ((ChoixCalcul = 0) or (ChoixCalcul = 1)) then         {Calcul des indices suivant le choix de calcul}
  begin
    SdTb := StdHtz;
    Ponderat := 0;
    for LocusEnCours := 1 to TotalLoc do
    begin
      TransitIdGId[LocusEnCours] := IndHtz(LocusEnCours,Gen3Etude[NmId].Genotype[LocusEnCours,1],Gen3Etude[NmId].Genotype[LocusEnCours,2],SdTb);
      if TransitIdGId[LocusEnCours].Fait = true then
      begin
        TransitIdGId[TotalLoc+1].Valeurs[1] := TransitIdGId[TotalLoc+1].Valeurs[1]+TransitIdGId[LocusEnCours].Valeurs[1];
        if ChoixCalcul = 0 then
        begin
          TransitIdGId[TotalLoc+1].Valeurs[2] := TransitIdGId[TotalLoc+1].Valeurs[2]+TransitIdGId[LocusEnCours].Valeurs[2];
          Ponderat := Ponderat+1/SdTb[LocusEnCours];
        end;
        NbLocFait := NbLocFait+1;
      end;
    end;

    if ChoixCalcul = 1 then
    begin
      Somfreq := 0;
      for LocusEnCours := 1 to TotalLoc do
      begin
        for NmAl := 1 to 2 do
        begin
          if Gen3Etude[NmId].Genotype[LocusEnCours,NmAl] <> 0
          then Somfreq := Somfreq+LookFreq(LocusEnCours,Gen3Etude[NmId].Genotype[LocusEnCours,NmAl]);
        end;
      end;
      TransitIdGId[TotalLoc+1].Valeurs[2] := 0;
      TransitIdGId[TotalLoc+1].Valeurs[2] :=
       ((2*(NbLocFait-TransitIdGId[TotalLoc+1].Valeurs[1]))-Somfreq)/
       ((2*NbLocFait)-Somfreq);
    end;
    TransitIdGId[TotalLoc+1].Valeurs[3] := 0;
  end;

  if (ChoixCalcul = 2) then
  begin
    TbCoulson := StdCoulson;
    for LocusEnCours := 1 to TotalLoc do
    begin
      TransitIdGId[LocusEnCours] := IndCoul(LocusEnCours,Gen3Etude[NmId].Genotype[LocusEnCours,1],Gen3Etude[NmId].Genotype[LocusEnCours,2],TbCoulson);
      if TransitIdGId[LocusEnCours].Fait = True then
      begin
        TransitIdGId[TotalLoc+1].Valeurs[1] := TransitIdGId[TotalLoc+1].Valeurs[1]+TransitIdGId[LocusEnCours].Valeurs[1];
        TransitIdGId[TotalLoc+1].Valeurs[2] := TransitIdGId[TotalLoc+1].Valeurs[2]+TransitIdGId[LocusEnCours].Valeurs[2];
        TransitIdGId[TotalLoc+1].Valeurs[3] := TransitIdGId[TotalLoc+1].Valeurs[3]+TransitIdGId[LocusEnCours].Valeurs[3];
        NbLocFait := NbLocFait+1;
      end;
    end;
  end;

  if ChoixCalcul = 3 then
  begin
    for LocusEnCours := 1 to TotalLoc do
    begin
      if Gen3Etude[NmId].Genotype[LocusEnCours,1] <> 0 then
      begin
        if Gen3Etude[NmId].Genotype[LocusEnCours,1] <> Gen3Etude[NmId].Genotype[LocusEnCours,2] then
        TransitIdGId[LocusEnCours].Valeurs[1] := 2*LookFreq(LocusEnCours,Gen3Etude[NmId].Genotype[LocusEnCours,1])*LookFreq(LocusEnCours,Gen3Etude[NmId].Genotype[LocusEnCours,2])
        else TransitIdGId[LocusEnCours].Valeurs[1] := Sqr(LookFreq(LocusEnCours,Gen3Etude[NmId].Genotype[LocusEnCours,1]));
        TransitIdGId[TotalLoc+1].Valeurs[1] := TransitIdGId[TotalLoc+1].Valeurs[1]+TransitIdGId[LocusEnCours].Valeurs[1];
        TransitIdGId[LocusEnCours].Fait := True;
      end;
      TransitIdGId[LocusEnCours].Valeurs[2] := 0;
      TransitIdGId[LocusEnCours].Valeurs[3] := 0;
      if TransitIdGId[LocusEnCours].Fait = True
      then NbLocFait := NbLocFait+1
      else TransitIdGId[LocusEnCours].Valeurs[1] := 99999;
    end;
    TransitIdGId[TotalLoc+1].Valeurs[2] := 0;
    TransitIdGId[TotalLoc+1].Valeurs[3] := 0;
  end;

  if ChoixCalcul <> 1 then                       {Calcul des indices totaux : pour l'IR c'est déjà fait}
  begin
    TransitIdGId[TotalLoc+1].Valeurs[1] := TransitIdGId[TotalLoc+1].Valeurs[1]/NbLocFait;
    if ChoixCalcul = 0 then TransitIdGId[TotalLoc+1].Valeurs[2] := TransitIdGId[TotalLoc+1].Valeurs[2]/Ponderat
    else TransitIdGId[TotalLoc+1].Valeurs[2] := TransitIdGId[TotalLoc+1].Valeurs[2]/NbLocFait;
    TransitIdGId[TotalLoc+1].Valeurs[3] := TransitIdGId[TotalLoc+1].Valeurs[3]/NbLocFait;
  end;
  TransitIdGId[TotalLoc+1].Fait := True;

  CalcGenIndiv := TransitIdGId;

  end
  else                                {S'il n'existe pas, rien ne peut être calculé}
  begin
    for LocusEnCours := 1 to (TotalLoc+1) do
    begin
      TransitIdGId[LocusEnCours].Fait := False;
      TransitIdGId[LocusEnCours].Valeurs[1] := 99999;
      TransitIdGId[LocusEnCours].Valeurs[2] := 99999;
      TransitIdGId[LocusEnCours].Valeurs[3] := 99999;
    end;
  end;
  
end;

function Meanarize(ChCalcul:Byte;NmFamil:Word):IndGenInd;
{Function that calculate the mean of genetic quality of the male and female}
var
  loc,EndLoc,NLFait: word;
  TransitMeans: IndGenInd;
  femelle,male: IndGenInd;
  SomfreqM,SomfreqF: Single;
begin
  for Loc := 1 to (LocusMax+2) do
  begin                                       {Initialisation de male, femelle et moyenne}
    TransitMeans[loc].Fait := False;
    TransitMeans[loc].Valeurs[1] := 0;
    TransitMeans[loc].Valeurs[2] := 0;
    TransitMeans[loc].Valeurs[3] := 0;
    Male[loc].Fait := False;
    Male[loc].Valeurs[1] := 0;
    Male[loc].Valeurs[2] := 0;
    Male[loc].Valeurs[3] := 0;
    Femelle[loc].Fait := False;
    Femelle[loc].Valeurs[1] := 0;
    Femelle[loc].Valeurs[2] := 0;
    Femelle[loc].Valeurs[3] := 0;
  end;
  SomFreqM := 0;
  SomFreqF := 0;
  NLFait := 0;

  Loc := 0;                              {Comptage du nombre de locus}
  repeat
    Loc := Loc+1;
  until ((Gen3Etude[1].Genotype[Loc,1] = Gen3Etude[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
  EndLoc := Loc;

  if ((Families[NmFamil,1] <> 0) and (Families[NmFamil,2] <> 0)) then
  begin                                   {Calcul de Male et Femelle s'ils existent}
    Male := CalcGenIndiv(ChCalcul,Families[NmFamil,1]);
    Femelle := CalcGenIndiv(ChCalcul,Families[NmFamil,2]);
    for Loc := 1 to EndLoc do                   {Calcul des moyenne}
    begin
      if ((Male[loc].Fait = True) and (Femelle[loc].Fait = True)) then
      begin
        TransitMeans[loc].Fait := True;
        TransitMeans[loc].Valeurs[1] := (Male[loc].Valeurs[1]+Femelle[loc].Valeurs[1])/2;
        TransitMeans[loc].Valeurs[2] := (Male[loc].Valeurs[2]+Femelle[loc].Valeurs[2])/2;
        TransitMeans[loc].Valeurs[3] := (Male[loc].Valeurs[3]+Femelle[loc].Valeurs[3])/2;
        if Loc <> EndLoc then
        begin
          NLFait := NLFait+1;
          SomfreqM := SomfreqM+LookFreq(Loc,Gen3Etude[Families[NmFamil,1]].Genotype[Loc,1])+LookFreq(Loc,Gen3Etude[Families[NmFamil,1]].Genotype[Loc,2]);
          SomfreqF := SomfreqF+LookFreq(Loc,Gen3Etude[Families[NmFamil,2]].Genotype[Loc,1])+LookFreq(Loc,Gen3Etude[Families[NmFamil,2]].Genotype[Loc,2]);
          TransitMeans[EndLoc+1].Fait := True;
          TransitMeans[EndLoc+1].Valeurs[1] := TransitMeans[EndLoc+1].Valeurs[1]+TransitMeans[loc].Valeurs[1];
          TransitMeans[EndLoc+1].Valeurs[2] := TransitMeans[EndLoc+1].Valeurs[2]+TransitMeans[loc].Valeurs[2];
          TransitMeans[EndLoc+1].Valeurs[3] := TransitMeans[EndLoc+1].Valeurs[3]+TransitMeans[loc].Valeurs[3];
        end;
      end
      else
      begin
        TransitMeans[loc].Valeurs[1] := 99999;
        TransitMeans[loc].Valeurs[2] := 99999;
        TransitMeans[loc].Valeurs[3] := 99999;
      end;
    end;
  end
  else
  begin
    for Loc := 1 to (EndLoc+1) do
    begin
      TransitMeans[Loc].Valeurs[1] := 99999;
      TransitMeans[Loc].Valeurs[2] := 99999;
      TransitMeans[Loc].Valeurs[3] := 99999;
    end;
  end;

  if TransitMeans[EndLoc+1].Fait = True then
  begin
    if ChCalcul <> 1 then TransitMeans[EndLoc+1].Valeurs[1] := TransitMeans[EndLoc+1].Valeurs[1]/NLFait;
    TransitMeans[EndLoc+1].Valeurs[2] := TransitMeans[EndLoc+1].Valeurs[2]/NLFait;
    TransitMeans[EndLoc+1].Valeurs[3] := TransitMeans[EndLoc+1].Valeurs[3]/NLFait;
    if ChCalcul = 1 then TransitMeans[EndLoc+1].Valeurs[2] := (1/2)*
     (((2*(NLFait-Male[EndLoc].Valeurs[1]))-SomfreqM)/((2*NLFait)-SomfreqM)
     +((2*(NLFait-Femelle[EndLoc].Valeurs[1]))-SomfreqF)/((2*NLFait)-SomfreqF));
  end;

  TransitMeans[EndLoc+2].Valeurs[1] := Male[EndLoc].Valeurs[1];
  TransitMeans[EndLoc+2].Valeurs[2] := Male[EndLoc].Valeurs[2];
  TransitMeans[EndLoc+2].Valeurs[3] := Male[EndLoc].Valeurs[3];

  TransitMeans[EndLoc+3].Valeurs[1] := Femelle[EndLoc].Valeurs[1];
  TransitMeans[EndLoc+3].Valeurs[2] := Femelle[EndLoc].Valeurs[2];
  TransitMeans[EndLoc+3].Valeurs[3] := Femelle[EndLoc].Valeurs[3];

  Meanarize := TransitMeans;
end;

function LookFreqInd(Locus:Byte;Allele:Word):Single;
{Function that gives back the frequency of individuals sharing a specific allele}
var
  search: byte;
begin
  search := 0;
  repeat
    search := search+1;
  until ((FreqzAllEtude[Locus].TabAll[search].Name = Allele)
  or (FreqzAllEtude[Locus].TabAll[search].Name = 0) or (search > NbAllele));
  if FreqzAllEtude[Locus].TabAll[search].Name = 0
  then LookFreqInd := 1/(IndividualNb+1)
  else LookFreqInd := FreqzAllEtude[Locus].TabAll[search].Freq.FInd;
end;

function Maternoster(Loc:byte;c1,c2,m1,m2:word):single;
{Calculation of exclusion probability of the mother}
begin
  if ((c1 = m1) or (c1 = m2) or (c2 = m1) or (c2 = m2))
  then
  begin
    if c1 = c2 then Maternoster := LookFreqInd(Loc,c1)
    else Maternoster := LookFreqInd(Loc,c1)+LookFreqInd(Loc,c2)-LookFreqInd(Loc,c1)*LookFreqInd(Loc,c2);
  end
  else Maternoster := 0;
end;

function Paternoster(Loc:byte;c1,c2,p1,p2:word):single;
{Calculation of exclusion probability of the father}
begin
  if ((c1 = p1) or (c1 = p2) or (c2 = p1) or (c2 = p2))
  then
  begin
    if c1 = c2 then Paternoster := LookFreqInd(Loc,c1)
    else Paternoster := LookFreqInd(Loc,c1)+LookFreqInd(Loc,c2)-LookFreqInd(Loc,c1)*LookFreqInd(Loc,c2);
  end
  else Paternoster := 0;
end;

function Patermaternoster(Loc:byte;c1,c2,m1,m2,p1,p2:word):single;
{Calculation of exclusion probability of the father knowing the mother}
var
  both: byte;
  Patermaternostert: single;
begin
  Patermaternostert := 0;
  both := 0;
  if Maternoster(Loc,c1,c2,m1,m2) = 0 then Patermaternostert := Paternoster(Loc,c1,c2,p1,p2)
  else
  begin
    if Paternoster(Loc,c1,c2,p1,p2) = 0 then Patermaternostert := 0
    else
    begin
      if (((c1 = m1) or (c1 = m2)) and ((c2 = p1) or (c2 = p2)))
      then
      begin
        Patermaternostert := Patermaternostert+LookFreqInd(Loc,c2);
        both := both+1;
      end;
      if (((c2 = m1) or (c2 = m2)) and ((c1 = p1) or (c1 = p2)))
      then
      begin
        Patermaternostert := Patermaternostert+LookFreqInd(Loc,c1);
        both := both+1;
      end;
      if both = 2 then Patermaternostert := Paternoster(Loc,c1,c2,p1,p2);
    end;
  end;
  Patermaternoster := Patermaternostert;
end;

function AreYouMyChild(Maman,Papa,Moi:word;Loc:byte):ExtPatInd;
{General function for calculation of exclusion probabilities, that uses the
3 functions above, for one family}
begin
  AreYouMyChild[1] := 0;
  AreYouMyChild[2] := 0;
  AreYouMyChild[3] := 0;

  if ((Maman <> 0) and (Papa <> 0)) then
  begin
  if Gen3Etude[Moi].Genotype[Loc,1] <> 0 then
  begin
    if Gen3Etude[Maman].Genotype[Loc,1] <> 0 then
    begin
      if Gen3Etude[Papa].Genotype[Loc,1] <> 0 then
      begin
        AreYouMyChild[2] := Maternoster(Loc,Gen3Etude[Moi].Genotype[Loc,1],Gen3Etude[Moi].Genotype[Loc,2],
        Gen3Etude[Maman].Genotype[Loc,1],Gen3Etude[Maman].Genotype[Loc,2]);
        AreYouMyChild[1] := Paternoster(Loc,Gen3Etude[Moi].Genotype[Loc,1],Gen3Etude[Moi].Genotype[Loc,2],
        Gen3Etude[Papa].Genotype[Loc,1],Gen3Etude[Papa].Genotype[Loc,2]);
        AreYouMyChild[3] := Patermaternoster(Loc,Gen3Etude[Moi].Genotype[Loc,1],Gen3Etude[Moi].Genotype[Loc,2],
        Gen3Etude[Maman].Genotype[Loc,1],Gen3Etude[Maman].Genotype[Loc,2],Gen3Etude[Papa].Genotype[Loc,1],Gen3Etude[Papa].Genotype[Loc,2]);
      end
      else
      begin
        AreYouMyChild[2] := Maternoster(Loc,Gen3Etude[Moi].Genotype[Loc,1],Gen3Etude[Moi].Genotype[Loc,2],
        Gen3Etude[Maman].Genotype[Loc,1],Gen3Etude[Maman].Genotype[Loc,2]);
      end;
    end
    else
    begin
      if Gen3Etude[Papa].Genotype[Loc,1] <> 0 then
      begin
        AreYouMyChild[1] := Paternoster(Loc,Gen3Etude[Moi].Genotype[Loc,1],Gen3Etude[Moi].Genotype[Loc,2],
        Gen3Etude[Papa].Genotype[Loc,1],Gen3Etude[Papa].Genotype[Loc,2]);
      end;
    end;
  end;
  end
  else
  begin
  if Maman <> 0 then
  begin
    AreYouMyChild[2] := Maternoster(Loc,Gen3Etude[Moi].Genotype[Loc,1],Gen3Etude[Moi].Genotype[Loc,2],
    Gen3Etude[Maman].Genotype[Loc,1],Gen3Etude[Maman].Genotype[Loc,2]);
  end;

  if Papa <> 0 then
  begin
    AreYouMyChild[1] := Paternoster(Loc,Gen3Etude[Moi].Genotype[Loc,1],Gen3Etude[Moi].Genotype[Loc,2],
    Gen3Etude[Papa].Genotype[Loc,1],Gen3Etude[Papa].Genotype[Loc,2]);
  end;
  end;
end;

function CalcExclusionProb(Papa,Maman,Moi:word):ExtPat;
{General function for exclusion probabilities}
var
  Loc,EndLoc: byte;
  CalcExclusion: ExtPat;
begin
  Loc := 0;                              {Comptage du nombre de locus}
  repeat
    Loc := Loc+1;
  until ((Gen3Etude[1].Genotype[Loc,1] = Gen3Etude[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
  EndLoc := Loc-1;

  for Loc := 1 to LocusMax+1 do          {Initialisation}
  begin
    CalcExclusion[Loc,1] := 0;
    CalcExclusion[Loc,2] := 0;
    CalcExclusion[Loc,3] := 0;
  end;

  CalcExclusion[EndLoc+1,1] := 1;
  CalcExclusion[EndLoc+1,2] := 1;
  CalcExclusion[EndLoc+1,3] := 1;

  for Loc := 1 to EndLoc do
  begin
    CalcExclusion[Loc] := AreYouMyChild(Maman,Papa,Moi,Loc);
    if CalcExclusion[Loc,1] <> 0 then CalcExclusion[EndLoc+1,1] := CalcExclusion[EndLoc+1,1]*CalcExclusion[Loc,1];
    if CalcExclusion[Loc,2] <> 0 then CalcExclusion[EndLoc+1,2] := CalcExclusion[EndLoc+1,2]*CalcExclusion[Loc,2];
    if CalcExclusion[Loc,3] <> 0 then CalcExclusion[EndLoc+1,3] := CalcExclusion[EndLoc+1,3]*CalcExclusion[Loc,3];
  end;

  CalcExclusionProb := CalcExclusion;

end;

function CalcExclusionProb2(Pere,Mere,Moi:word):BandSharing;
{General function for band sharing coefficients}
var
  Loc,EndLoc: byte;
  CalcExclusion: BandSharing;
begin
  Loc := 0;                              {Comptage du nombre de locus}
  repeat
    Loc := Loc+1;
  until ((Gen3Etude[1].Genotype[Loc,1] = Gen3Etude[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
  EndLoc := Loc-1;

  for Loc := 1 to LocusMax+2 do          {Initialisation}
  begin
    CalcExclusion[Loc] := 0;
  end;

  for Loc := 1 to EndLoc do
  begin
    if ((Pere <> 0) and (Mere <> 0)) then
    begin
    if (((Gen3Etude[Mere].Genotype[Loc,1] <> 0) or (Gen3Etude[Pere].Genotype[Loc,1] <> 0)) and (Gen3Etude[Moi].Genotype[Loc,1] <> 0)) then
    begin
      CalcExclusion[EndLoc+2] := CalcExclusion[EndLoc+2] + 1;
      if ((Gen3Etude[Mere].Genotype[Loc,1] <> 0) and (Gen3Etude[Pere].Genotype[Loc,1] <> 0)) then CalcExclusion[EndLoc+2] := CalcExclusion[EndLoc+2]+1;

      if (((Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Mere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Mere].Genotype[Loc,2]))
      or ((Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Pere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Pere].Genotype[Loc,2]))
      or ((Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Mere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Mere].Genotype[Loc,2]))
      or ((Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Pere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Pere].Genotype[Loc,2])))
      then CalcExclusion[Loc] := 1;

      if ((((Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Mere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Mere].Genotype[Loc,2]))
      and ((Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Pere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Pere].Genotype[Loc,2])))
      or (((Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Mere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Mere].Genotype[Loc,2]))
      and ((Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Pere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Pere].Genotype[Loc,2]))))
      then CalcExclusion[Loc] := 2;

      CalcExclusion[EndLoc+1] := CalcExclusion[EndLoc+1] + CalcExclusion[Loc];

    end
    else
    begin
      CalcExclusion[Loc] := 999;
    end;
    end
    else
    begin
    if Mere <> 0 then
    begin
    if ((Gen3Etude[Mere].Genotype[Loc,1] <> 0) and (Gen3Etude[Moi].Genotype[Loc,1] <> 0)) then
    begin
      CalcExclusion[EndLoc+2] := CalcExclusion[EndLoc+2] + 1;

      if (((Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Mere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Mere].Genotype[Loc,2]))
      or ((Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Mere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Mere].Genotype[Loc,2])))
      then CalcExclusion[Loc] := 1;

      CalcExclusion[EndLoc+1] := CalcExclusion[EndLoc+1] + CalcExclusion[Loc];

    end
    else
    begin
      CalcExclusion[Loc] := 999;
    end;
    end;
    if Pere <> 0 then
    if ((Gen3Etude[Pere].Genotype[Loc,1] <> 0) and (Gen3Etude[Moi].Genotype[Loc,1] <> 0)) then
    begin
      CalcExclusion[EndLoc+2] := CalcExclusion[EndLoc+2] + 1;

      if (((Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Pere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,2] = Gen3Etude[Pere].Genotype[Loc,2]))
      or ((Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Pere].Genotype[Loc,1]) or (Gen3Etude[Moi].Genotype[Loc,1] = Gen3Etude[Pere].Genotype[Loc,2])))
      then CalcExclusion[Loc] := 1;

      CalcExclusion[EndLoc+1] := CalcExclusion[EndLoc+1] + CalcExclusion[Loc];

    end
    else
    begin
      CalcExclusion[Loc] := 999;
    end;
      begin
      end;
    end;

  end;

  CalcExclusionProb2 := CalcExclusion;

end;

function Queller(x,y:word):single;
{Calculation of Queller index for one individual}
var
  pxm,pym,pmetoile,num,den: single;
  Loc,Endloc,All,cobs,call,Ind2,All2: word;
begin
  Loc := 0;                              {Comptage du nombre de locus}
  repeat
    Loc := Loc+1;
  until ((Gen3Etude[1].Genotype[Loc,1] = Gen3Etude[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
  EndLoc := Loc-1;

  den := 0;
  num := 0;

  for Loc := 1 to Endloc do
  begin
    if ((Gen3Etude[x].Genotype[Loc,1] <> 0) and (Gen3Etude[y].Genotype[Loc,1] <> 0)) then
    begin
      for All := 1 to 2 do
      begin
        if Gen3Etude[x].Genotype[Loc,1] = Gen3Etude[x].Genotype[Loc,2] then pxm := 1 else pxm := 1/2;
        pym := 0;
        if Gen3Etude[y].Genotype[Loc,1] = Gen3Etude[x].Genotype[Loc,All] then pym := pym+1/2;
        if Gen3Etude[y].Genotype[Loc,2] = Gen3Etude[x].Genotype[Loc,All] then pym := pym+1/2;
        {Calcul des fréquences pmetoile}
        call := 0;
        cobs := 0;
        for Ind2 := 1 to IndividualNb do
        begin
          for All2 := 1 to 2 do
          begin
            if ((Ind2 <> x) and (Ind2 <> y)) then  {calcul hors x et y}
            begin
              if ((Gen3Etude[Ind2].Genotype[Loc,All2] <> 0)
              and ((Gen3Etude[Ind2].Population <> Popu) or (Popu = ''))
              and ((Gen3Etude[Ind2].Status <> Stat) or (Stat = ''))
              and ((Gen3Etude[Ind2].Sexe <> Sexsun) or (Sexsun = ''))) then
              begin
                cobs := cobs+1;
                if Gen3Etude[Ind2].Genotype[Loc,All2] = Gen3Etude[x].Genotype[Loc,All] then call := call+1;
              end;
            end;
          end;
        end;
        if cobs <> 0 then pmetoile := call/cobs else pmetoile := 0;

        num := num+(pym-pmetoile);
        den := den+(pxm-pmetoile);

      end;
    end;
  end;

  if den <> 0 then Queller := Num/Den else Queller := 99999;

end;

function QuellerL(x,y,loc:word):single;
{Calculation of Queller index for one locus}
var
  pxm,pym,pmetoile,num,den: single;
  All,cobs,call,Ind2,All2: word;
begin

  den := 0;
  num := 0;

  if ((Gen3Etude[x].Genotype[Loc,1] <> 0) and (Gen3Etude[y].Genotype[Loc,1] <> 0)) then
  begin
    for All := 1 to 2 do
    begin
      if Gen3Etude[x].Genotype[Loc,1] = Gen3Etude[x].Genotype[Loc,2] then pxm := 1 else pxm := 1/2;
      pym := 0;
      if Gen3Etude[y].Genotype[Loc,1] = Gen3Etude[x].Genotype[Loc,All] then pym := pym+1/2;
      if Gen3Etude[y].Genotype[Loc,2] = Gen3Etude[x].Genotype[Loc,All] then pym := pym+1/2;
      {Calcul des fréquences pmetoile}
      call := 0;
      cobs := 0;
      for Ind2 := 1 to IndividualNb do
      begin
        for All2 := 1 to 2 do
        begin
          if ((Ind2 <> x) and (Ind2 <> y)) then  {calcul hors x et y}
          begin
            if ((Gen3Etude[Ind2].Genotype[Loc,All2] <> 0)
            and ((Gen3Etude[Ind2].Population <> Popu) or (Popu = ''))
            and ((Gen3Etude[Ind2].Status <> Stat) or (Stat = ''))
            and ((Gen3Etude[Ind2].Sexe <> Sexsun) or (Sexsun = ''))) then
            begin
              cobs := cobs+1;
              if Gen3Etude[Ind2].Genotype[Loc,All2] = Gen3Etude[x].Genotype[Loc,All] then call := call+1;
            end;
          end;
        end;
      end;
      if cobs <> 0 then pmetoile := call/cobs else pmetoile := 0;
      num := num+(pym-pmetoile);
      den := den+(pxm-pmetoile);
    end;
  end;
  if den <> 0 then QuellerL := Num/Den else QuellerL := 99999;
end;


function ILoveYou(Choice,Fam:word):Related;
{General function for calculation of relatedness indices}
var
  loc,EndLoc: word;
  Uncle: Related;
  NLFait,sab,sbc,sbd,sac,sad,scd: word;
  rxy,ryx,wxy,wyx,pa,pb,pc,pd,grandwyx,grandwxy,grandrxy,grandryx: single;
begin
  for Loc := 1 to (LocusMax+2) do
  begin                                       {Initialisation de male, femelle et moyenne}
    Uncle[loc].Val := 0;
  end;

  Loc := 0;                              {Comptage du nombre de locus}
  repeat
    Loc := Loc+1;
  until ((Gen3Etude[1].Genotype[Loc,1] = Gen3Etude[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
  EndLoc := Loc;

  grandrxy := 0;
  grandryx := 0;
  grandwxy := 0;
  grandwyx := 0;

  if Choice = 0 then
  begin
    for Loc := 1 to EndLoc-1 do
    begin
      if ((Families[Fam,1] <> 0) and (Families[Fam,2] <> 0)) then
      begin
        if ((Gen3Etude[Families[Fam,1]].Genotype[Loc,1] <> 0) and (Gen3Etude[Families[Fam,2]].Genotype[Loc,1] <> 0)) then
        begin

          if Gen3Etude[Families[Fam,1]].Genotype[Loc,1] = Gen3Etude[Families[Fam,1]].Genotype[Loc,2] then sab := 1 else sab := 0;
          if Gen3Etude[Families[Fam,1]].Genotype[Loc,1] = Gen3Etude[Families[Fam,2]].Genotype[Loc,1] then sac := 1 else sac := 0;
          if Gen3Etude[Families[Fam,1]].Genotype[Loc,1] = Gen3Etude[Families[Fam,2]].Genotype[Loc,2] then sad := 1 else sad := 0;
          if Gen3Etude[Families[Fam,1]].Genotype[Loc,2] = Gen3Etude[Families[Fam,2]].Genotype[Loc,1] then sbc := 1 else sbc := 0;
          if Gen3Etude[Families[Fam,1]].Genotype[Loc,2] = Gen3Etude[Families[Fam,2]].Genotype[Loc,2] then sbd := 1 else sbd := 0;
          if Gen3Etude[Families[Fam,2]].Genotype[Loc,1] = Gen3Etude[Families[Fam,2]].Genotype[Loc,2] then scd := 1 else scd := 0;

          pa := LookFreq(loc,Gen3Etude[Families[Fam,1]].Genotype[Loc,1]);
          pb := LookFreq(loc,Gen3Etude[Families[Fam,1]].Genotype[Loc,2]);
          pc := LookFreq(loc,Gen3Etude[Families[Fam,2]].Genotype[Loc,1]);
          pd := LookFreq(loc,Gen3Etude[Families[Fam,2]].Genotype[Loc,2]);

          if ((((1+sab)*(pa+pb)-4*pa*pb) <> 0) and (((1+scd)*(pc+pd)-4*pc*pd) <> 0)) then
          begin                {il faut que les dénominateurs soient non nuls}

            rxy := (pa*(sbc+sbd)+pb*(sac+sad)-4*pa*pb)/((1+sab)*(pa+pb)-4*pa*pb);
            ryx := (pc*(sad+sbd)+pd*(sac+sbc)-4*pc*pd)/((1+scd)*(pc+pd)-4*pc*pd);

            wxy := ((1+sab)*(pa+pb)-4*pa*pb)/(2*pa*pb);
            wyx := ((1+scd)*(pc+pd)-4*pc*pd)/(2*pc*pd);

            Uncle[Loc].Val := (rxy*wxy+ryx*wyx)/(2*(wxy+wyx));

            grandrxy := grandrxy+wxy*rxy;
            grandryx := grandryx+wyx*ryx;
            grandwxy := grandwxy+wxy;
            grandwyx := grandwyx+wyx;

          end
          else
          begin          {sinon le calcul est indéfini}
            Uncle[Loc].Val := 99999;
          end;
        end
        else
        begin
          Uncle[Loc].Val := 99999;
        end;

      end
      else
      begin
        Uncle[Loc].Val := 99999;
      end;

      if ((grandwxy <> 0) and (grandwyx <> 0)) then Uncle[EndLoc].Val := ((grandrxy/grandwxy) + (grandryx/grandwyx))/2
      else Uncle[EndLoc].Val := 99999;

    end;
  end;

  if Choice = 1 then
  begin
    if ((Families[Fam,1] <> 0) and (Families[Fam,2] <> 0)) then
    begin
      Uncle[EndLoc].Val := (Queller(Families[Fam,1],Families[Fam,2])+Queller(Families[Fam,2],Families[Fam,1]))/2;
      for Loc := 1 to EndLoc-1 do
      begin
        if ((Gen3Etude[Families[Fam,1]].Genotype[Loc,1] <> 0) and (Gen3Etude[Families[Fam,2]].Genotype[Loc,1] <> 0)) then
        begin
          rxy := QuellerL(Families[Fam,1],Families[Fam,2],Loc);
          ryx := QuellerL(Families[Fam,2],Families[Fam,1],Loc);
          if ((rxy <> 99999) and (ryx <> 99999)) then Uncle[Loc].Val := (rxy+ryx)/2
          else Uncle[Loc].Val := 99999
        end
        else
        begin
          Uncle[Loc].Val := 99999;
        end;
      end;
    end
    else
    begin
      for Loc := 1 to EndLoc do Uncle[Loc].Val := 99999;
    end;
  end;

  if Choice = 2 then
  begin
    if ((Families[Fam,1] <> 0) and (Families[Fam,2] <> 0)) then
    begin
      NLFait := 0;
      for Loc := 1 to EndLoc-1 do
      begin
        if ((Gen3Etude[Families[Fam,1]].Genotype[Loc,1] <> 0) and (Gen3Etude[Families[Fam,2]].Genotype[Loc,1] <> 0)) then
        begin
          {Coulson : pa, pb, pc et pd sont les distances 2 à 2 des allèles}
          pa := Sqr(Gen3Etude[Families[Fam,1]].Genotype[Loc,1]-Gen3Etude[Families[Fam,2]].Genotype[Loc,1]);
          pb := Sqr(Gen3Etude[Families[Fam,1]].Genotype[Loc,1]-Gen3Etude[Families[Fam,2]].Genotype[Loc,2]);
          pc := Sqr(Gen3Etude[Families[Fam,1]].Genotype[Loc,2]-Gen3Etude[Families[Fam,2]].Genotype[Loc,1]);
          pd := Sqr(Gen3Etude[Families[Fam,1]].Genotype[Loc,2]-Gen3Etude[Families[Fam,2]].Genotype[Loc,2]);
          Uncle[Loc].Val := (pa+pb+pc+pd)/4;
          Uncle[EndLoc].Val := Uncle[Endloc].Val + Uncle[Loc].Val;
          NLFait := NLFait+1;
        end
        else
        begin
          Uncle[Loc].Val := 99999;
        end;
      end;
      if NLFait = 0 then Uncle[EndLoc].Val := 99999 else Uncle[EndLoc].Val := Uncle[Endloc].Val/NLFait;
    end
    else
    begin
      for Loc := 1 to EndLoc do Uncle[Loc].Val := 99999;
    end;
  end;

  if Choice = 3 then
  begin
    if ((Families[Fam,1] <> 0) and (Families[Fam,2] <> 0)) then
    begin
      for Loc := 1 to EndLoc-1 do
      begin
        if ((Gen3Etude[Families[Fam,1]].Genotype[Loc,1] <> 0) and (Gen3Etude[Families[Fam,2]].Genotype[Loc,1] <> 0)) then
        begin
          {Probabilité d'avoir un petit homozygote}
          if (Gen3Etude[Families[Fam,1]].Genotype[Loc,1] = Gen3Etude[Families[Fam,1]].Genotype[Loc,2]) then
          begin
            if ((Gen3Etude[Families[Fam,1]].Genotype[Loc,1] = Gen3Etude[Families[Fam,2]].Genotype[Loc,1])
            or (Gen3Etude[Families[Fam,1]].Genotype[Loc,1] = Gen3Etude[Families[Fam,2]].Genotype[Loc,2]))
            then
            begin
              if (Gen3Etude[Families[Fam,2]].Genotype[Loc,1] = Gen3Etude[Families[Fam,2]].Genotype[Loc,2])
              then rxy := 1
              else rxy := 1/2;
            end
            else rxy := 0;
          end
          else
          begin
            if (Gen3Etude[Families[Fam,2]].Genotype[Loc,1] = Gen3Etude[Families[Fam,2]].Genotype[Loc,2])
            then
            begin
              if ((Gen3Etude[Families[Fam,1]].Genotype[Loc,1] = Gen3Etude[Families[Fam,2]].Genotype[Loc,1])
              or (Gen3Etude[Families[Fam,1]].Genotype[Loc,2] = Gen3Etude[Families[Fam,2]].Genotype[Loc,1]))
              then rxy := 1/2
              else rxy := 0
            end
            else
            begin
              rxy := 0;
              if ((Gen3Etude[Families[Fam,1]].Genotype[Loc,1] = Gen3Etude[Families[Fam,2]].Genotype[Loc,1])
              or (Gen3Etude[Families[Fam,1]].Genotype[Loc,1] = Gen3Etude[Families[Fam,2]].Genotype[Loc,2]))
              then rxy := rxy+1/4;
              if ((Gen3Etude[Families[Fam,1]].Genotype[Loc,2] = Gen3Etude[Families[Fam,2]].Genotype[Loc,1])
              or (Gen3Etude[Families[Fam,1]].Genotype[Loc,2] = Gen3Etude[Families[Fam,2]].Genotype[Loc,2]))
              then rxy := rxy+1/4;
            end;
          end;

          NLFait := 1;
          wxy := 0;
          repeat
            wxy := wxy+Sqr(FreqzAllEtude[Loc].TabAll[NLFait].Freq.FAll);
            NLFait := NLFait+1;
          until ((FreqzAllEtude[Loc].TabAll[NLFait].Name = 0) or (NLFait > NbAllele));
          wxy := 1/wxy;

          Uncle[Loc].Val := rxy;

          grandrxy := grandrxy+rxy*wxy;
          grandwxy := grandwxy+wxy;

        end
        else
        begin
          Uncle[Loc].Val := 99999;
        end;
      end;
      if (grandwxy <> 0) then Uncle[EndLoc].Val := grandrxy/grandwxy else Uncle[EndLoc].Val := 99999;
    end
    else
    begin
      for Loc := 1 to EndLoc do Uncle[Loc].Val := 99999;
    end;
  end;

  ILoveYou := Uncle;
end;

function EcrivainObs(GenotypeReel:TabGen3D;FamyReel:TabFamily;Calcul:integer):string;
{Function that writes the results in the output file}
var
  Distances : array[1..183] of integer;
  CFam,EndLoc,Loc,Eol,FamFait : integer;
  FarAway : Single;
  Jerkins: String;
  Moyenne: Real;
begin
  if Calcul = 2 then Calcul := 3;
  Moyenne := 0;
  Loc := 0;                              {Comptage du nombre de locus}
  repeat
    Loc := Loc+1;
  until ((Gen3Etude[1].Genotype[Loc,1] = Gen3Etude[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
  EndLoc := Loc;

  for Eol := 1 to 183 do Distances[Eol] := 0;

  FamFait := 0;
  CFam := 1;
  repeat
    FarAway := ILoveYou(Calcul,CFam)[EndLoc].Val;
    if ((FarAway <> 99999) and (FarAway < 1)) then
    begin
      if Arrondir(FarAway,2) > 0.905 then Distances[183] := Distances[183]+1;
      if Arrondir(FarAway,2) < -0.905 then Distances[1] := Distances[1]+1;
      for Eol := 2 to 182 do
      begin
        if Arrondir(FarAway,2) = Arrondir((-0.9+(Eol-2)*0.01),2) then Distances[Eol] := Distances[Eol]+1;
      end;
      Moyenne := Moyenne+FarAway;
      FamFait := FamFait+1;
    end;
    CFam := CFam+1;
  until ((FamyReel[CFam,1] = 0) and (FamyReel[CFam,2] = 0));
  Moyenne := Moyenne/FamFait;
  Jerkins := 'Observed Families'+#$9+'0'+#$9;
  for Loc := 1 to 183 do Jerkins := Jerkins+IntToStr(Distances[Loc])+#$9;
  Jerkins := Jerkins+FloatToStr(Moyenne);
  EcrivainObs := Jerkins;
end;

function ToiTuSeras(CLoc:integer):word;
{Function that creates an individual according to allelic frequencies, for permutations}
var
  NAllTot,AllChoisi : integer;
  Organa : ChocAll;
  Alix : real;
begin
  NAllTot := 0;         {Combien d'allèles chez les locus CLoc}
  repeat
    NAllTot := NAllTot+1;
    if NAllTot <> 1 then Organa[NAllTot].Val := Organa[NAllTot-1].Val+FreqzAllEtude[CLoc].TabAll[NAllTot].Freq.FAll
    else Organa[NAllTot].Val := FreqzAllEtude[CLoc].TabAll[NAllTot].Freq.FAll;
  until FreqzAllEtude[CLoc].TabAll[NAllTot].Name = 0;
  NAllTot := NAllTot-1;

  Alix := Random;
  AllChoisi := 0;
  repeat
    AllChoisi := AllChoisi+1;
  until ((AllChoisi >= NAllTot) or (Alix <= Organa[AllChoisi].Val));

  ToiTuSeras := FreqzAllEtude[CLoc].TabAll[AllChoisi].Name;
end;

function InitialisationIndiv(indiv:integer):GenotAPermDig;
{Function that initialize all invented individuals for permutations}
var
  NLocTot,i : integer;
begin
  InitialisationIndiv.Status := '';
  InitialisationIndiv.Status := '';
  InitialisationIndiv.AnnNais := 0;

  NLocTot := 1;         {Combien de locus au total}
  repeat
    NLocTot := NLocTot+1;
  until FreqzAllEtude[NLocTot].Name = 0;
  NLocTot := NLocTot-1;
  for i := 1 to NLocTot do
  begin
    InitialisationIndiv.Genotype[i,1] := 0;
    InitialisationIndiv.Genotype[i,2] := 0;
  end;
end;

function Sordeloeuf(GenotCree:TabGenAPerm;annee,indiv:integer):GenotAPermDig;
{Function that create the genotype of a chick according to the genotypes of its parents}
var
  NLocTot,i : integer;
begin
  Sordeloeuf := GenotCree[indiv];
  if ((GenotCree[indiv].Status = '') or (GenotCree[indiv].Sexe = ''))then
  begin
    Sordeloeuf.Status := 'D';
    Sordeloeuf.AnnNais := annee;
    if Random > 0.5 then Sordeloeuf.Sexe := 'M' else Sordeloeuf.Sexe := 'F';

    NLocTot := 1;         {Combien de locus au total}
    repeat
      NLocTot := NLocTot+1;
    until FreqzAllEtude[NLocTot].Name = 0;
    NLocTot := NLocTot-1;
    for i := 1 to NLocTot do
    begin
      Sordeloeuf.Genotype[i,1] := ToiTuSeras(i);
      Sordeloeuf.Genotype[i,2] := ToiTuSeras(i);
    end;
  end;
end;

function LookForFemelle(GenotCre:TabGenAPerm;NbIndiv:integer):integer;
{Function that looks for a random female in the table}
var
  NbFemelles, CInd, Arsinoe: integer;
begin
  NbFemelles := 1;
  CInd := 1;
  repeat
    if ((GenotCre[CInd].Sexe = 'F') and (GenotCre[Cind].Status = 'D')) then NbFemelles := NbFemelles+1;
    CInd := CInd+1;
  until ((CInd > IndMax) or (CInd > NbIndiv));
  Arsinoe := Round(Random*NbFemelles+1);
  CInd := 1;
  NbFemelles := 0;
  repeat
    if ((GenotCre[CInd].Sexe = 'F') and (GenotCre[Cind].Status = 'D')) then NbFemelles := NbFemelles+1;
    CInd := CInd+1;
  until ((CInd > IndMax) or (GenotCre[CInd].Sexe = '') or (NbFemelles >= Arsinoe));
  if ((GenotCre[CInd-1].Status = 'D') and (GenotCre[CInd-1].Sexe = 'F')) then LookforFemelle := CInd-1 else LookforFemelle := 0;
end;

function LookForMale(GenotCre:TabGenAPerm;NbIndiv:integer):integer;
{Function that looks for a random male in the table}
var
  NbMales, CInd, Arsinoe: integer;
begin
  NbMales := 1;
  CInd := 1;
  repeat
    if ((GenotCre[CInd].Sexe = 'M') and (GenotCre[Cind].Status = 'D')) then NbMales := NbMales+1;
    CInd := CInd+1;
  until ((CInd > IndMax) or (CInd > NbIndiv));
  Arsinoe := Round(Random*NbMales+1);
  CInd := 1;
  NbMales := 0;
  repeat
    if ((GenotCre[CInd].Sexe = 'M') and (GenotCre[Cind].Status = 'D')) then NbMales := NbMales+1;
    CInd := CInd+1;
  until ((CInd > IndMax) or (GenotCre[CInd].Sexe = '') or (NbMales >= Arsinoe));
  if ((GenotCre[CInd-1].Status = 'D') and (GenotCre[CInd-1].Sexe = 'M')) then LookforMale := CInd-1 else LookforMale := 0;
end;

function OccupezLesSites(GenotCree:TabGenAPerm;FamyOld:FamilyAPerm;Sites,TotalInd,DivorcS,DivorcE:Integer):FamilyAPerm;
{For permutations only: occupation of the different sites and formation of families}
var
  NbCpl, CFam, FemelleTrouvee, MaleTrouve,ErrorC : integer;
begin
  NbCpl := 0;
  {Qui va divorcer ?}
  CFam := 1;
  repeat
    {Pour chaque couple, on regarde si les 2 individus matchés l'an passé sont
    1) Encore vivants - sinon le partenaire encore vivant est indiqué comme disponible
    2) Suivant leur succès l'an passé, ils divorcent ou non}
    if ((FamyOld[CFam].Male <> 0) and (FamyOld[CFam].Femelle <> 0)) then
    begin
      if ((GenotCree[FamyOld[CFam].Male].Status = 'I') and (GenotCree[FamyOld[CFam].Femelle].Status = 'I')) then
      begin
        if FamyOld[CFam].Succes = 'S' then
        begin
          if Random(100) < DivorcS then
          begin
            GenotCree[FamyOld[CFam].Male].Status  := 'D';
            GenotCree[FamyOld[CFam].Femelle].Status := 'D';
          end
          else
          begin
            NbCpl := NbCpl+1;
            OccupezLesSites[NbCpl].Male := FamyOld[CFam].Male;
            OccupezLesSites[NbCpl].Femelle := FamyOld[CFam].Femelle;
          end;
        end;
        if FamyOld[CFam].Succes = 'E' then
        begin
          if Random(100) < DivorcE then
          begin
            GenotCree[FamyOld[CFam].Male].Status  := 'D';
            GenotCree[FamyOld[CFam].Femelle].Status := 'D';
          end
          else
          begin
            NbCpl := NbCpl+1;
            OccupezLesSites[NbCpl].Male := FamyOld[CFam].Male;
            OccupezLesSites[NbCpl].Femelle := FamyOld[CFam].Femelle;
          end;
        end;
      end
      else
      begin
        if GenotCree[FamyOld[CFam].Male].Status = 'D' then GenotCree[FamyOld[CFam].Femelle].Status := 'D';
        if GenotCree[FamyOld[CFam].Femelle].Status = 'D' then GenotCree[FamyOld[CFam].Male].Status := 'D';
      end;
    end;
    CFam := CFam+1;
  until ((FamyOld[CFam].Male = 0) and (FamyOld[CFam].Femelle = 0));

  ErrorC := 0;
  repeat
    MaleTrouve := LookForMale(GenotCree,TotalInd);
    FemelleTrouvee := LookForFemelle(GenotCree,TotalInd);
    if ((MaleTrouve <> 0) and (FemelleTrouvee <> 0)) then
    begin
      NbCpl := NbCpl+1;
      OccupezLesSites[NbCpl].Male := MaleTrouve;
      OccupezLesSites[NbCpl].Femelle := FemelleTrouvee;
      GenotCree[MaleTrouve].Status := 'I';
      GenotCree[FemelleTrouvee].Status := 'I';
    end
    else ErrorC := ErrorC+1;
  until ((NbCpl >= Sites) or (ErrorC > 10));
end;

function ILoveYouToo(Choice:word;Male,Femelle:integer;GenotCree:TabGenAPerm):Real;
{Function that calculates relatedness of invented individuals in permutations}
var
  loc,EndLoc: word;
  Uncle: Related;
  NLFait,sab,sbc,sbd,sac,sad,scd: word;
  rxy,ryx,wxy,wyx,pa,pb,pc,pd,grandwyx,grandwxy,grandrxy,grandryx: single;
begin
  for Loc := 1 to (LocusMax+2) do
  begin                                       {Initialisation de male, femelle et moyenne}
    Uncle[loc].Val := 0;
  end;

  Loc := 0;                              {Comptage du nombre de locus}
  repeat
    Loc := Loc+1;
  until ((GenotCree[1].Genotype[Loc,1] = GenotCree[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
  EndLoc := Loc;

  grandrxy := 0;
  grandryx := 0;
  grandwxy := 0;
  grandwyx := 0;

  if Choice = 0 then
  begin
    for Loc := 1 to EndLoc-1 do
    begin
      if ((Male <> 0) and (Femelle <> 0)) then
      begin
        if ((GenotCree[Male].Genotype[Loc,1] <> 0) and (GenotCree[Femelle].Genotype[Loc,1] <> 0)) then
        begin

          if GenotCree[Male].Genotype[Loc,1] = GenotCree[Male].Genotype[Loc,2] then sab := 1 else sab := 0;
          if GenotCree[Male].Genotype[Loc,1] = GenotCree[Femelle].Genotype[Loc,1] then sac := 1 else sac := 0;
          if GenotCree[Male].Genotype[Loc,1] = GenotCree[Femelle].Genotype[Loc,2] then sad := 1 else sad := 0;
          if GenotCree[Male].Genotype[Loc,2] = GenotCree[Femelle].Genotype[Loc,1] then sbc := 1 else sbc := 0;
          if GenotCree[Male].Genotype[Loc,2] = GenotCree[Femelle].Genotype[Loc,2] then sbd := 1 else sbd := 0;
          if GenotCree[Femelle].Genotype[Loc,1] = GenotCree[Femelle].Genotype[Loc,2] then scd := 1 else scd := 0;

          pa := LookFreq(loc,GenotCree[Male].Genotype[Loc,1]);
          pb := LookFreq(loc,GenotCree[Male].Genotype[Loc,2]);
          pc := LookFreq(loc,GenotCree[Femelle].Genotype[Loc,1]);
          pd := LookFreq(loc,GenotCree[Femelle].Genotype[Loc,2]);

          if ((((1+sab)*(pa+pb)-4*pa*pb) <> 0) and (((1+scd)*(pc+pd)-4*pc*pd) <> 0)) then
          begin                {il faut que les dénominateurs soient non nuls}

            rxy := (pa*(sbc+sbd)+pb*(sac+sad)-4*pa*pb)/((1+sab)*(pa+pb)-4*pa*pb);
            ryx := (pc*(sad+sbd)+pd*(sac+sbc)-4*pc*pd)/((1+scd)*(pc+pd)-4*pc*pd);

            wxy := ((1+sab)*(pa+pb)-4*pa*pb)/(2*pa*pb);
            wyx := ((1+scd)*(pc+pd)-4*pc*pd)/(2*pc*pd);

            Uncle[Loc].Val := (rxy*wxy+ryx*wyx)/(2*(wxy+wyx));

            grandrxy := grandrxy+wxy*rxy;
            grandryx := grandryx+wyx*ryx;
            grandwxy := grandwxy+wxy;
            grandwyx := grandwyx+wyx;

          end
          else
          begin          {sinon le calcul est indéfini}
            Uncle[Loc].Val := 99999;
          end;
        end
        else
        begin
          Uncle[Loc].Val := 99999;
        end;

      end
      else
      begin
        Uncle[Loc].Val := 99999;
      end;

      if ((grandwxy <> 0) and (grandwyx <> 0)) then Uncle[EndLoc].Val := ((grandrxy/grandwxy) + (grandryx/grandwyx))/2
      else Uncle[EndLoc].Val := 99999;

    end;
  end;

  if Choice = 1 then
  begin
    if ((Male <> 0) and (Femelle <> 0)) then
    begin
      Uncle[EndLoc].Val := (Queller(Male,Femelle)+Queller(Femelle,Male))/2;
      for Loc := 1 to EndLoc-1 do
      begin
        if ((GenotCree[Male].Genotype[Loc,1] <> 0) and (GenotCree[Femelle].Genotype[Loc,1] <> 0)) then
        begin
          rxy := QuellerL(Male,Femelle,Loc);
          ryx := QuellerL(Femelle,Male,Loc);
          if ((rxy <> 99999) and (ryx <> 99999)) then Uncle[Loc].Val := (rxy+ryx)/2
          else Uncle[Loc].Val := 99999
        end
        else
        begin
          Uncle[Loc].Val := 99999;
        end;
      end;
    end
    else
    begin
      for Loc := 1 to EndLoc do Uncle[Loc].Val := 99999;
    end;
  end;

  if Choice = 2 then
  begin
    if ((Male <> 0) and (Femelle <> 0)) then
    begin
      for Loc := 1 to EndLoc-1 do
      begin
        if ((GenotCree[Male].Genotype[Loc,1] <> 0) and (GenotCree[Femelle].Genotype[Loc,1] <> 0)) then
        begin
          {Probabilité d'avoir un petit homozygote}
          if (GenotCree[Male].Genotype[Loc,1] = GenotCree[Male].Genotype[Loc,2]) then
          begin
            if ((GenotCree[Male].Genotype[Loc,1] = GenotCree[Femelle].Genotype[Loc,1])
            or (GenotCree[Male].Genotype[Loc,1] = GenotCree[Femelle].Genotype[Loc,2]))
            then
            begin
              if (GenotCree[Femelle].Genotype[Loc,1] = GenotCree[Femelle].Genotype[Loc,2])
              then rxy := 1
              else rxy := 1/2;
            end
            else rxy := 0;
          end
          else
          begin
            if (GenotCree[Femelle].Genotype[Loc,1] = GenotCree[Femelle].Genotype[Loc,2])
            then
            begin
              if ((GenotCree[Male].Genotype[Loc,1] = GenotCree[Femelle].Genotype[Loc,1])
              or (GenotCree[Male].Genotype[Loc,2] = GenotCree[Femelle].Genotype[Loc,1]))
              then rxy := 1/2
              else rxy := 0
            end
            else
            begin
              rxy := 0;
              if ((GenotCree[Male].Genotype[Loc,1] = GenotCree[Femelle].Genotype[Loc,1])
              or (GenotCree[Male].Genotype[Loc,1] = GenotCree[Femelle].Genotype[Loc,2]))
              then rxy := rxy+1/4;
              if ((GenotCree[Male].Genotype[Loc,2] = GenotCree[Femelle].Genotype[Loc,1])
              or (GenotCree[Male].Genotype[Loc,2] = GenotCree[Femelle].Genotype[Loc,2]))
              then rxy := rxy+1/4;
            end;
          end;

          NLFait := 1;
          wxy := 0;
          repeat
            wxy := wxy+Sqr(FreqzAllEtude[Loc].TabAll[NLFait].Freq.FAll);
            NLFait := NLFait+1;
          until ((FreqzAllEtude[Loc].TabAll[NLFait].Name = 0) or (NLFait > NbAllele));
          wxy := 1/wxy;

          Uncle[Loc].Val := rxy;

          grandrxy := grandrxy+rxy*wxy;
          grandwxy := grandwxy+wxy;

        end
        else
        begin
          Uncle[Loc].Val := 99999;
        end;
      end;
      if (grandwxy <> 0) then Uncle[EndLoc].Val := grandrxy/grandwxy else Uncle[EndLoc].Val := 99999;
    end
    else
    begin
      for Loc := 1 to EndLoc do Uncle[Loc].Val := 99999;
    end;
  end;

  ILoveYouToo := Uncle[EndLoc].Val;
end;

function CalculeDistGenet(Famy:FamilyAPerm;Calcul:integer;GenotCree:TabGenAPerm):FamilyAPerm;
{Calculation of genetic distance in permutations}
var
  CFam : integer;
begin
  CFam := 1;
  repeat
    CalculeDistGenet[CFam] := Famy[CFam];
    CalculeDistGenet[CFam].DistGen := ILoveYouToo(Calcul,Famy[CFam].Male,Famy[CFam].Femelle,GenotCree);
    CFam := CFam+1;
  until ((Famy[CFam].Male = 0) and (Famy[CFam].Femelle = 0))
end;

function LookForTheWorst(Famy:FamilyAPerm;NbFamy:Integer):integer;
{Looks for the pairs with the worst genetic quality}
var
  CFam,Bad : integer;
  ValBad : real;
begin
  Bad := 1;
  ValBad := -2;
  for CFam := 1 to NbFamy do
  begin
    if ((Famy[CFam].DistGen >= ValBad) and (Famy[CFam].Succes = '') and (Famy[CFam].Male <> 0)) then
    begin
      ValBad := Famy[CFam].DistGen;
      Bad := CFam;
    end;
  end;
  LookForTheWorst := Bad;
end;

function Succes(Famy:FamilyAPerm;TypScc,Echec,NbFamy:Integer):FamilyAPerm;
{According to their genetic distances, each pair will succeed or fail its reproduction}
var
  CoEchec, CFam, Worst : integer;
begin
  if TypScc = 0 then
  begin       {Succès aléatoire}
    CoEchec := 0;
    CFam := 1;
    repeat
      if Random(100) < NbFamy*Echec/100 then
      begin
        Famy[CFam].Succes := 'E';
        CoEchec := CoEchec+1;
      end
      else Famy[CFam].Succes := 'S';
      CFam := CFam+1;
    until ((CFam >= NbFamy) or (CoEchec > ((NbFamy*Echec)/100)));
  end
  else        {Les mauvais ratent}
  begin
    CoEchec := 0;
    repeat
      Worst := LookForTheWorst(Famy,NbFamy);
      if Worst <> 0 then
      begin
        Famy[Worst].Succes := 'E';
        CoEchec := CoEchec+1;
      end;
    until CoEchec > NbFamy*Echec/100
  end;

  for CFam := 1 to NbFamy do if Famy[CFam].Succes = '' then Famy[CFam].Succes := 'S';

  Succes := Famy;
end;

function Idie(GenotCree:TabGenAPerm;TxMort,indiv:integer):GenotAPermDig;
{Randomly, some individuals will die each year}
var
  NLocTot,i : integer;
begin
  Idie := GenotCree[indiv];
  if Random(100) < TxMort then
  begin
    Idie.Status := '';
    Idie.AnnNais := 0;
    Idie.Sexe := '';

    NLocTot := 1;         {Combien de locus au total}
    repeat
      NLocTot := NLocTot+1;
    until FreqzAllEtude[NLocTot].Name = 0;
    NLocTot := NLocTot-1;
    for i := 1 to NLocTot do
    begin
      Idie.Genotype[i,1] := 0;
      Idie.Genotype[i,2] := 0;
    end;
  end;
end;

function ReportDisponibilite(GenotCree:TabGenAPerm;Famy:FamilyAPerm;IndTot:integer):TabGenAPerm;
{Function that re-make the permutation table according to dead individuals and unsuccessful
pairs, that may then be available for a new reproduction attempt}
var
  CFam : integer;
begin
  ReportDisponibilite := GenotCree;
  for CFam := 1 to IndTot do ReportDisponibilite[CFam].Status := 'D';
  for CFam := 1 to FamilyMax do if Famy[CFam].Male <> 0 then ReportDisponibilite[Famy[CFam].Male].Status := 'I';
  for CFam := 1 to FamilyMax do if Famy[CFam].Femelle <> 0 then ReportDisponibilite[Famy[CFam].Femelle].Status := 'I';
end;

function EcrivainTableau(PermNb,AnNb:integer;Famy:FamilyAPerm):string;
{Writes the results in the output file}
var
  Distances : array[1..183] of integer;
  CFam,Eol,FamFait : integer;
  FarAway : Single;
  Jerkins: String;
  Moyenne: Real;
begin
  for Eol := 1 to 183 do Distances[Eol] := 0;
  FamFait := 0;
  CFam := 1;
  repeat
    FarAway := Famy[CFam].DistGen;
    if ((FarAway <> 99999) and (FarAway < 1)) then
    begin
      if Arrondir(FarAway,2) > 0.905 then Distances[183] := Distances[183]+1;
      if Arrondir(FarAway,2) < -0.905 then Distances[1] := Distances[1]+1;
      for Eol := 2 to 182 do
      begin
        if Arrondir(FarAway,2) = Arrondir((-0.9+(Eol-2)*0.01),2) then Distances[Eol] := Distances[Eol]+1;
      end;
      Moyenne := Moyenne+FarAway;
      FamFait := FamFait+1;
    end;
    CFam := CFam+1;
  until ((Famy[CFam].Male = 0) and (Famy[CFam].Femelle = 0));
  Moyenne := Moyenne/FamFait;
  Jerkins := IntToStr(PermNb)+#$9+IntToStr(AnNb)+#$9;
  for Eol := 1 to 183 do Jerkins := Jerkins+IntToStr(Distances[Eol])+#$9;
  Jerkins := Jerkins+FloatToStr(Moyenne);
  EcrivainTableau := Jerkins;
end;

function DoesItMatch(i,Bebe,Maman:integer):single;
{Function that looks if an individual can be the father of a given chick}
var
  Loc,Endloc : integer;
  LocMatch,LocDone,Match,j : integer;
begin
  Loc := 0;                              {Comptage du nombre de locus}
  repeat
    Loc := Loc+1;
  until ((Gen3Etude[1].Genotype[Loc,1] = Gen3Etude[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
  EndLoc := Loc-1;

  LocMatch := 0;
  LocDone := 0;

  if ((i <> Bebe) and (i <> Maman) and (Bebe <> 0)) then
  begin
    for j := 1 to EndLoc do
    begin
      Match := 0;
      if ((Gen3Etude[i].Genotype[j,1] <> 0) and (Gen3Etude[Bebe].Genotype[j,1] <> 0)) then
      begin
        LocDone := LocDone+1;
        if Maman <> 0 then
        begin
          if Gen3Etude[Maman].Genotype[j,1] <> 0 then
          begin
            if ((Gen3Etude[Bebe].Genotype[j,1] = Gen3Etude[Maman].Genotype[j,1]) or (Gen3Etude[Bebe].Genotype[j,1] = Gen3Etude[Maman].Genotype[j,2])) then
            begin
              if ((Gen3Etude[Bebe].Genotype[j,2] = Gen3Etude[i].Genotype[j,1]) or (Gen3Etude[Bebe].Genotype[j,2] = Gen3Etude[i].Genotype[j,2]))
              then Match := 1;
            end;
            if ((Gen3Etude[Bebe].Genotype[j,2] = Gen3Etude[Maman].Genotype[j,1]) or (Gen3Etude[Bebe].Genotype[j,2] = Gen3Etude[Maman].Genotype[j,2])) then
            begin
              if ((Gen3Etude[Bebe].Genotype[j,1] = Gen3Etude[i].Genotype[j,1]) or (Gen3Etude[Bebe].Genotype[j,1] = Gen3Etude[i].Genotype[j,2]))
              then Match := 1;
            end;
          end
          else
          begin
            if ((Gen3Etude[Bebe].Genotype[j,1] = Gen3Etude[i].Genotype[j,1]) or (Gen3Etude[Bebe].Genotype[j,1] = Gen3Etude[i].Genotype[j,2])
            or (Gen3Etude[Bebe].Genotype[j,2] = Gen3Etude[i].Genotype[j,1]) or (Gen3Etude[Bebe].Genotype[j,2] = Gen3Etude[i].Genotype[j,2]))
            then Match := 1;
          end
        end
        else
        begin
          if ((Gen3Etude[Bebe].Genotype[j,1] = Gen3Etude[i].Genotype[j,1]) or (Gen3Etude[Bebe].Genotype[j,1] = Gen3Etude[i].Genotype[j,2])
          or (Gen3Etude[Bebe].Genotype[j,2] = Gen3Etude[i].Genotype[j,1]) or (Gen3Etude[Bebe].Genotype[j,2] = Gen3Etude[i].Genotype[j,2]))
          then Match := 1;
        end;
      end;
      LocMatch := LocMatch+Match;
    end;
    if LocDone <> 0 then DoesItMatch := 100*LocMatch/LocDone else DoesItMatch := 0;
  end
  else DoesItMatch := 0;
end;

end.



{*************************************************************************************************************************************************************}



unit Relatedness;

{
This unity is related to the window Relatedness.
In this one, you can calculate the relatedness between the male and the female inside
a pair, according to 4 different indices (Queller&Goodnight, Lynch&Ritland, the mean d² of
Coulson, and the probability of having an homozygous offspring. This last index is
described in the article linked to this program.
For the calculation of this indices, you need to have the allelic frequencies. However,
in order to have good estimates of these frequencies, you may need to restrain the calculation
of this frequencies by population, by sex, by time of observation (not yet computed) or by status(breeder or not,
adult or chick, etc.).
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, NausicaaUtilitaires, NausicaaConstantes,
  StdCtrls, ExtCtrls;

type
  TForm9 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    RadioGroup3: TRadioGroup;
    RadioGroup4: TRadioGroup;
    Errors: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Button2: TButton;
    RadioGroup5: TRadioGroup;
    SaveDialog1: TSaveDialog;
    procedure ExitProcIndH(Sender: TObject);
    procedure SaveIndivHtz(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form9: TForm9;

implementation

{$R *.DFM}

procedure Erreurwriteln(s : string); {ecrire dans la boite erreur}
begin
  with Form9 do Errors.Lines.Append(s);
end;

procedure CalculGeneralFreqChoisies;
var
  Gen3EtInt1: TabGen3D;
begin
  Gen3EtInt1 := Gen3Etude;
  if Form9.RadioGroup1.ItemIndex = 1 then Gen3EtInt1 := ExtractPop3(Gen3EtInt1,Form9.Edit1.Text);
  if Form9.RadioGroup2.ItemIndex = 1 then Gen3EtInt1 := ExtractSex3(Gen3EtInt1,Form9.Edit2.Text);
  if Form9.RadioGroup3.ItemIndex = 1 then Gen3EtInt1 := ExtractStt3(Gen3EtInt1,Form9.Edit4.Text);
  FreqzAllEtude := CalcFreqzAll(Gen3EtInt1);
end;

procedure TForm9.SaveIndivHtz(Sender: TObject);
var
  Ligne: Related;
  droitdecalcul: Word;
  i,j,nbloc: Word;
  Wonder: TStringList;
  AAjout: String;
  ChCalcul: Byte;
begin
  droitdecalcul := 0;
  nbloc := 0;

  if ((LoadGen = 0) or (LoadFamily = False))         {Regarde si tout a bien été entré}
  then
  begin
    droitdecalcul := 1;
    if LoadGen = 0 then Erreurwriteln('No genotypes file loaded');
    if LoadFamily = False then Erreurwriteln('No family file loaded');
  end
  else
  begin
    if ((RadioGroup1.ItemIndex = 1) and ((Population = False) or (Form9.Edit1.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no population entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup2.ItemIndex = 1) and ((Sexe = False) or (Form9.Edit2.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no sexe entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup3.ItemIndex = 1) and ((Status = False) or (Form9.Edit4.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no status entered');
      droitdecalcul := 1;
    end;
  end;

  if ((droitdecalcul = 0) and (RadioGroup1.ItemIndex = 1))
  then                      {Regarde si les entrées existent}
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Population = Form9.Edit1.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This population does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup2.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Sexe = Form9.Edit2.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This sexe does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup3.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Status = Form9.Edit4.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This status does not exist');
  end;

  if droitdecalcul = 0 then   {Lance le calcul}
  begin
    CalculGeneralFreqChoisies;
    ChCalcul := RadioGroup5.ItemIndex;
    if (SaveDialog1.Execute) then
    begin
    Wonder := TStringList.Create;
    if ChCalcul = 0 then
    begin
      AAjout := 'Table of estimator of Lynch & Ritland';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form9.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form9.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form9.Edit4.Text;
      Wonder.Add(AAjout);
      AAjout := 'Male'+#$9+'Femelle'+#$9;
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := AAjout+'Lynch''s Estimator'+#$9;
      Wonder.Add(AAjout);
    end;

    if ChCalcul = 1 then
    begin
      AAjout := 'Table of relatedness coefficient of Queller & Goodnight';
      Stat := '';
      Sexsun := '';
      Popu := '';
      if RadioGroup1.ItemIndex = 1 then Popu := Form9.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then Sexsun := Form9.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then Stat := Form9.Edit4.Text;
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form9.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form9.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form9.Edit4.Text;
      Wonder.Add(AAjout);
      AAjout := 'Male'+#$9+'Femelle'+#$9;
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := AAjout+'Queller''s Estimator'+#$9;
      Wonder.Add(AAjout);
    end;

    if ChCalcul = 2 then
    begin
      AAjout := 'Table of d² of Coulson and Otter';
      Wonder.Add(AAjout);
      AAjout := 'Male'+#$9+'Femelle'+#$9;
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := AAjout+'Mean d²';
      Wonder.Add(AAjout);
    end;

    if ChCalcul = 3 then
    begin
      AAjout := 'Table of probabilities of having an homozygous offspring.';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form9.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form9.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form9.Edit4.Text;
      Wonder.Add(AAjout);
      AAjout := 'Male'+#$9+'Femelle'+#$9;
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := AAjout+'Ixy';
      Wonder.Add(AAjout);
    end;

    i := 1;
    nbloc := nbloc;

    repeat

      Ligne := ILoveYou(ChCalcul,i);

      if ChCalcul = 0 then
      begin
        AAjout := '';
        if Families[i,1] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,1]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        if Families[i,2] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,2]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        for j := 1 to nbloc do
        begin
          AAjout := AAjout+FloatToStr(Ligne[j].Val)+#$9;
        end;
        Wonder.Add(AAjout);
      end;

      if ChCalcul = 1 then
      begin
        AAjout := '';
        if Families[i,1] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,1]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        if Families[i,2] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,2]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        for j := 1 to nbloc do
        begin
          AAjout := AAjout+FloatToStr(Ligne[j].Val)+#$9;
        end;
        Wonder.Add(AAjout);;
      end;

      if ChCalcul = 2 then
      begin
        AAjout := '';
        if Families[i,1] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,1]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        if Families[i,2] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,2]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        for j := 1 to nbloc do
        begin
          AAjout := AAjout+FloatToStr(Ligne[j].Val)+#$9;
        end;
        Wonder.Add(AAjout);
      end;

      if ChCalcul = 3 then
      begin
        AAjout := '';
        if Families[i,1] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,1]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        if Families[i,2] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,2]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        for j := 1 to nbloc do
        begin
          AAjout := AAjout+FloatToStr(Ligne[j].Val)+#$9;
        end;
        Wonder.Add(AAjout);
      end;

      i := i+1;
    until ((i > FamilyNb) or (i > FamilyMax));

    if ChCalcul = 0 then
    begin
      Wonder.Add('Lynch & Ritland''s coefficient is estimated by rxy=(Pa(Sbc+Sbd)+Pb(Sac+Sad)-4*Pa*Pb)/((1+Sab)*(Pa+Pb)-4*Pa*Pb).');
      Wonder.Add('For multi-loci, each locus estimator is weighted by Wxy=((1+Sab)(Pa+Pb)-4Pa*Pb)/(2Pa*Pb)');
      Wonder.Add('Symetrical estimator is given by 0,5*(rxy+ryx)');
      Wonder.Add('a&b, c&d are the alleles for individual x and y respectively,');
      Wonder.Add('Pa is the frequency of allele a, and Sab=1 if a=b and 0 otherwise.');
    end;

    if ChCalcul = 1 then
    begin
      Wonder.Add('Queller & Goodnight''s coefficient at one locus is estimated by rxy=(0,5(Sab+Sad+Sbc+Sbd)-Pa-Pb)/(1+Sab-Pa-Pb)');
      Wonder.Add('a&b, c&d are the alleles for individual x and y respectively,');
      Wonder.Add('Pa is the frequency of allele a, and Sab=1 if a=b and 0 otherwise.');
      Wonder.Add('Queller & Goodnight''s coefficient at all loci is estimated by rxy=(Sum on x of (pym-pm*))/(Sum on x of (pxm-pm*))');
      Wonder.Add('where pym is frequence of allele m in individual y, pxm the same in individual x, pm* the frequence of m in whole population excluding x and y.');
      Wonder.Add('Symetrical estimator is given by 0,5*(rxy+ryx)');
    end;

    if ChCalcul = 2 then
    begin
      Wonder.Add('d² : size differences between the two alleles.');
      Wonder.Add('Mean d² is the sum of the d² obtained for each locus divided by the number of loci');
    end;

    if ChCalcul = 3 then
    begin
      Wonder.Add('This estimates the probability of having an homozygous offspring given the genotype of both parents.');
      Wonder.Add('Multiloci estimates are obtained by weighting by 1/Sum of pj², pj being the frequence of allele j.');
    end;

    Wonder.Add('99999 means that the calculation was impossible because of lacks in the dataset, or because the formula used gave an undefined value');

    Wonder.SaveToFile(SaveDialog1.FileName);
    Wonder.Free;
    Form9.Close;

  end;
  end;
end;

procedure TForm9.ExitProcIndH(Sender: TObject);
begin
  Form9.Close;
end;

end.




{*************************************************************************************************************************************************************}




unit SParent;

{
This unity is related to the window Search 1 or 2 parent.
In this one, you give the name of an offspring and eventually the name of one of his parents,
and the minimum percentage of matching alleles you want.
The program will display all the potential adults that could be the second (or the
two parents) of the chick}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, NausicaaUtilitaires, NausicaaConstantes;

type
  TForm11 = class(TForm)
    Errors: TMemo;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    Label2: TLabel;
    Edit3: TEdit;
    procedure ExitSParent(Sender: TObject);
    procedure SearchParent(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form11: TForm11;

implementation

{$R *.DFM}

procedure Erreurwriteln(s : string); {ecrire dans la boite erreur}
begin
  with Form11 do Errors.Lines.Append(s);
end;

procedure TForm11.ExitSParent(Sender: TObject);
begin
  Form11.Close;
end;

procedure TForm11.SearchParent(Sender: TObject);
var
  droitderecherche,Offspring,ParentConnu,i,Percent,NbIndiv : Integer;
  Result: Single;
  Wonder : TStringList;
begin
  droitderecherche := 0;
  Offspring := 0;
  ParentConnu := 0;

  if ((Form11.Edit1.Text = '') or (LookNumberForIndividual(Form11.Edit1.Text) = 0))
  then Erreurwriteln('This offspring does not exist in genotype database')
  else
  begin
    droitderecherche := 1;
    Offspring := LookNumberForIndividual(Form11.Edit1.Text);
  end;

  if ((CheckBox1.Checked = True) and ((Form11.Edit2.Text = '') or (LookNumberForIndividual(Form11.Edit2.Text) = 0)))
  then
  begin
    Erreurwriteln('This parent does not exist in genotype database');
    droitderecherche := 0;
  end
  else
  begin
    droitderecherche := 1;
    ParentConnu := LookNumberForIndividual(Form11.Edit2.Text);
  end;

  if Form11.Edit3.Text = '' then
  begin
    Erreurwriteln('Invalide percentage number');
    droitderecherche := 0;
  end
  else
  begin
    droitderecherche := 1;
    Percent := StrToInt(Form11.Edit3.Text);
  end;

  if droitderecherche = 1 then   {Lance le calcul}
  begin
    if (SaveDialog1.Execute) then
    begin
      Wonder := TStringList.Create;
      Wonder.Add ('Offspring : '+#$9+Gen3Etude[Offspring].Individual);
      If CheckBox1.Checked = True then Wonder.Add('Known parent : '+#$9+Gen3Etude[ParentConnu].individual);
      Wonder.Add('Possible Parent :');
      Erreurwriteln('Possible parents :');

      i := 0;
      repeat
        i := i+1;
      until Gen3Etude[i].Individual = '';
      NbIndiv := i-1;

      for i := 1 to NbIndiv do
      begin
        Result := DoesItMatch(i,Offspring,ParentConnu);
        if Result > Percent then
        begin
          Erreurwriteln(Gen3Etude[i].Individual+' '+FloatToStr(Result));
          Wonder.Add(Gen3Etude[i].Individual+#$9+FloatToStr(Result))
        end;
      end;

      Wonder.SaveToFile(SaveDialog1.FileName);
      Wonder.Free;
    end;
  end;
end;

end.



{*************************************************************************************************************************************************************}




unit AllelicFreqz;

{
This unity is related to the window Allelic Frequency.
In this one, you can calculate the allelic frequencies of each locus.
However, in order to have good estimates of these frequencies, you may need to restrain the calculation
of this frequencies by population, by sex, by time of observation (not yet computed) or by status(breeder or not,
adult or chick, etc.).
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, NausicaaUtilitaires, NausicaaConstantes;

type
  TForm3 = class(TForm)
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    RadioGroup3: TRadioGroup;
    RadioGroup4: TRadioGroup;
    Button1: TButton;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    Errors: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    procedure SaveFreqAll(Sender: TObject);
    procedure ExitProc(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form3: TForm3;

implementation

{$R *.DFM}

procedure Erreurwriteln(s : string); {ecrire dans la boite erreur}
begin
  with Form3 do Errors.Lines.Append(s);
end;

procedure TForm3.SaveFreqAll(Sender: TObject);
var
  droitdecalcul: Word;
  i,EncAllImpr,nbloc,numall: Word;
  Wonder: TStringList;
  AAjout,AAjout2: String;
  Gen3EtInt1: TabGen3D;
begin
  droitdecalcul := 0;

  if LoadGen = 0         {Regarde si tout a bien été entré}
  then
  begin
    Erreurwriteln('No genotypes file loaded');
    droitdecalcul := 1;
  end
  else
  begin
    Gen3EtInt1 := Gen3Etude;
    if ((RadioGroup1.ItemIndex = 1) and ((Population = False) or (Form3.Edit1.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no population entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup2.ItemIndex = 1) and ((Sexe = False) or (Form3.Edit2.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no sexe entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup3.ItemIndex = 1) and ((Status = False) or (Form3.Edit4.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no status entered');
      droitdecalcul := 1;
    end;
  end;

  if ((droitdecalcul = 0) and (RadioGroup1.ItemIndex = 1))
  then                      {Regarde si les entrées existent}
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Population = Form3.Edit1.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This population does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup2.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Sexe = Form3.Edit2.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This sexe does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup3.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Status = Form3.Edit4.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This status does not exist');
  end;

  if droitdecalcul = 0 then   {Lance le calcul}
  begin
    if RadioGroup1.ItemIndex = 1 then Gen3EtInt1 := ExtractPop3(Gen3EtInt1,Form3.Edit1.Text);
    if RadioGroup2.ItemIndex = 1 then Gen3EtInt1 := ExtractSex3(Gen3EtInt1,Form3.Edit2.Text);
    if RadioGroup3.ItemIndex = 1 then Gen3EtInt1 := ExtractStt3(Gen3EtInt1,Form3.Edit4.Text);
    FreqzAllEtude := CalcFreqzAll(Gen3EtInt1);
    if SaveDialog1.Execute then
    begin
      Wonder := TStringList.Create;
      AAjout := 'Table of allelic frequences';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', for the population '+Form3.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', for the sexe '+Form3.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', for the status '+Form3.Edit4.Text;
      Wonder.Add(AAjout);
      AAjout := '';
      AAjout2 := '';
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9+#$9+#$9;
        AAjout2 := AAjout2+'Allele'+#$9+'Allelic frequence'+#$9+'Individual frequence'+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      nbloc := nbloc-1;
      Wonder.Add(AAjout);
      Wonder.Add(AAjout2);
      numall := 1;
      EncAllImpr := 0;
      while EncAllImpr = 0 do
      begin
        AAjout := '';
        EncAllImpr := 1;
        for i := 1 to nbloc do
        begin
          if FreqzAllEtude[i].TabAll[numall].Name <> 0 then EncAllImpr := 0;
        end;
        if EncAllImpr = 0 then
        begin
          for i := 1 to nbloc do
          begin
            if FreqzAllEtude[i].TabAll[numall].Name = 0 then AAjout := AAjout+#$9+#$9+#$9
            else AAjout := AAjout+IntToStr(FreqzAllEtude[i].TabAll[numall].Name)+#$9+FloatToStr(100*FreqzAllEtude[i].TabAll[numall].Freq.Fall)
            +#$9+FloatToStr(100*FreqzAllEtude[i].TabAll[numall].Freq.FInd)+#$9;
          end;
          Wonder.Add(AAjout);
        end;
        numall := numall+1;
      end;
      Wonder.Add('Allelic frequence is the number of occurences of this allele divided by the total number of alleles');
      Wonder.Add('Individual frequence is the number of individuals dispatching this allele divided by the total number of alleles');
      Wonder.SaveToFile(SaveDialog1.FileName);
      Wonder.Free;
      Form3.Close;
    end;
  end;
end;

procedure TForm3.ExitProc(Sender: TObject);
begin
  Form3.Close;
end;

end.



{*************************************************************************************************************************************************************}




unit ExclProb;

{
This unity is related to the window Exclusion probability of loci.
This gives an idea of the level of information given by one locus.
For the calculation of this probabilities, you need to have the allelic frequencies. However,
in order to have good estimates of these frequencies, you may need to restrain the calculation
of this frequencies by population, by sex, by time of observation (not yet computed) or by status(breeder or not,
adult or chick, etc.).
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, NausicaaUtilitaires, NausicaaConstantes;

type
  TForm8 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    RadioGroup3: TRadioGroup;
    RadioGroup4: TRadioGroup;
    Errors: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    procedure SaveExP(Sender: TObject);
    procedure Exit(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form8: TForm8;

implementation

{$R *.DFM}

function CalcExclP(ye : integer):single;
var
  two : integer;
  carre, cube, tetra, penta,y : single;
begin
  carre := 0;
  cube := 0;
  tetra := 0;
  penta := 0;

  two := 1;

  repeat
    y := FreqzAllEtude[ye].TabAll[two].Freq.FAll;
    carre := carre+y*y;
    cube := cube+y*y*y;
    tetra := tetra+y*y*y*y;
    penta := penta+y*y*y*y*y;
    two := two+1;
  until FreqzAllEtude[ye].TabAll[two].Name = 0;

  CalcExclP := 1-2*carre+cube+2*tetra-3*penta-2*carre*carre+3*carre*cube;

end;

procedure Erreurwriteln(s : string); {ecrire dans la boite erreur}
begin
  with Form8 do Errors.Lines.Append(s);
end;

procedure CalculGeneralFreqChoisies;
var
  Gen3EtInt1: TabGen3D;
begin
  Gen3EtInt1 := Gen3Etude;
  if Form8.RadioGroup1.ItemIndex = 1 then Gen3EtInt1 := ExtractPop3(Gen3EtInt1,Form8.Edit1.Text);
  if Form8.RadioGroup2.ItemIndex = 1 then Gen3EtInt1 := ExtractSex3(Gen3EtInt1,Form8.Edit2.Text);
  if Form8.RadioGroup3.ItemIndex = 1 then Gen3EtInt1 := ExtractStt3(Gen3EtInt1,Form8.Edit4.Text);
  FreqzAllEtude := CalcFreqzAll(Gen3EtInt1);
end;

procedure TForm8.SaveExP(Sender: TObject);
var
  droitdecalcul: Word;
  Loc,EndLoc:Word;
  Wonder: TStringList;
  AAjout: String;
  ExlLoc,Exclusion: Single;
begin
  droitdecalcul := 0;

  if LoadGen = 0         {Regarde si tout a bien été entré}
  then
  begin
    Erreurwriteln('No genotypes file loaded');
    droitdecalcul := 1;
  end
  else
  begin
    if ((RadioGroup1.ItemIndex = 1) and ((Population = False) or (Form8.Edit1.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no population entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup2.ItemIndex = 1) and ((Sexe = False) or (Form8.Edit2.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no sexe entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup3.ItemIndex = 1) and ((Status = False) or (Form8.Edit4.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no status entered');
      droitdecalcul := 1;
    end;
  end;

  if ((droitdecalcul = 0) and (RadioGroup1.ItemIndex = 1))
  then                      {Regarde si les entrées existent}
  begin
    droitdecalcul := 1;
    for Loc := 1 to IndMax do
    begin
      if (Gen3Etude[Loc].Population = Form8.Edit1.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This population does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup2.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for Loc := 1 to IndMax do
    begin
      if (Gen3Etude[Loc].Sexe = Form8.Edit2.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This sexe does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup3.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for Loc := 1 to IndMax do
    begin
      if (Gen3Etude[Loc].Status = Form8.Edit4.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This status does not exist');
  end;

  if droitdecalcul = 0 then   {Lance le calcul}
  begin
    CalculGeneralFreqChoisies;
    if (SaveDialog1.Execute) then
    begin
      Wonder := TStringList.Create;
      AAjout := 'Table of exclusion probabilities for loci';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form8.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form8.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form8.Edit4.Text;
      Wonder.Add(AAjout);
      Loc := 0;                              {Comptage du nombre de locus}
      repeat
        Loc := Loc+1;
      until ((Gen3Etude[1].Genotype[Loc,1] = Gen3Etude[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
      EndLoc := Loc-1;


      AAjout := ('Locus'+#$9+'False inclusion Probability'+#$9+'Cummulative Exclusion Probability');
      Wonder.Add(AAjout);

      Exclusion := 1;

      for Loc := 1 to EndLoc do
      begin
        ExlLoc := CalcExclP(Loc);
        Exclusion := Exclusion*(1-ExlLoc);
        AAjout := IntToStr(Loc)+#$9+FloatToStr(100*(1-ExlLoc))+#$9+FloatToStr(100*(1-Exclusion));
        Wonder.Add(AAjout);
      end;

      Wonder.Add('The last item in cummulative probabilities is the total exclusion probability for the whole set of loci studied');

      Wonder.SaveToFile(SaveDialog1.FileName);
      Wonder.Free;
      Form8.Close;

    end;
  end;
end;

procedure TForm8.Exit(Sender: TObject);
begin
  Form8.Close;
end;

end.



{*************************************************************************************************************************************************************}




unit IndivHtz;

{
This unity is related to the window Individual Heterozygosity.
In this one, you can calculate the individual heterozygosity according to 4 different indices
(Direct heterozygosity, Standardized heterozygosity, Intern relatedness, and
Probability of having this genotype given the allelic frequencies).
For the calculation of this indices, you need to have the allelic frequencies. However,
in order to have good estimates of these frequencies, you may need to restrain the calculation
of this frequencies by population, by sex, by time of observation (not yet computed) or by status(breeder or not,
adult or chick, etc.).
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, NausicaaUtilitaires, NausicaaConstantes;

type
  TForm4 = class(TForm)
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    RadioGroup3: TRadioGroup;
    RadioGroup4: TRadioGroup;
    Errors: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    RadioGroup5: TRadioGroup;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure SaveIndivHtz(Sender: TObject);
    procedure ExitProcIndH(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form4: TForm4;


implementation

{$R *.DFM}

procedure Erreurwriteln(s : string); {ecrire dans la boite erreur}
begin
  with Form4 do Errors.Lines.Append(s);
end;

procedure CalculGeneralFreqChoisies;
var
  Gen3EtInt1: TabGen3D;
begin
  Gen3EtInt1 := Gen3Etude;
  if Form4.RadioGroup1.ItemIndex = 1 then Gen3EtInt1 := ExtractPop3(Gen3EtInt1,Form4.Edit1.Text);
  if Form4.RadioGroup2.ItemIndex = 1 then Gen3EtInt1 := ExtractSex3(Gen3EtInt1,Form4.Edit2.Text);
  if Form4.RadioGroup3.ItemIndex = 1 then Gen3EtInt1 := ExtractStt3(Gen3EtInt1,Form4.Edit4.Text);
  FreqzAllEtude := CalcFreqzAll(Gen3EtInt1);
end;

procedure TForm4.SaveIndivHtz(Sender: TObject);
var
  droitdecalcul: Word;
  i,j,nbloc: Word;
  Wonder: TStringList;
  AAjout,AAjout2: String;
  ChCalcul: Byte;
  Ligne: IndGenInd;
begin
  droitdecalcul := 0;
  nbloc := 0;

  if LoadGen = 0         {Regarde si tout a bien été entré}
  then
  begin
    Erreurwriteln('No genotypes file loaded');
    droitdecalcul := 1;
  end
  else
  begin
    if ((RadioGroup1.ItemIndex = 1) and ((Population = False) or (Form4.Edit1.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no population entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup2.ItemIndex = 1) and ((Sexe = False) or (Form4.Edit2.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no sexe entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup3.ItemIndex = 1) and ((Status = False) or (Form4.Edit4.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no status entered');
      droitdecalcul := 1;
    end;
  end;

  if ((droitdecalcul = 0) and (RadioGroup1.ItemIndex = 1))
  then                      {Regarde si les entrées existent}
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Population = Form4.Edit1.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This population does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup2.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Sexe = Form4.Edit2.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This sexe does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup3.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Status = Form4.Edit4.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This status does not exist');
  end;

  if droitdecalcul = 0 then   {Lance le calcul}
  begin
    CalculGeneralFreqChoisies;
    ChCalcul := RadioGroup5.ItemIndex;
    if (SaveDialog1.Execute) then
    begin
    Wonder := TStringList.Create;
    if ChCalcul = 0 then
    begin
      AAjout := 'Table of individual heterozygosity indexes';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form4.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form4.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form4.Edit4.Text;
      Wonder.Add(AAjout);
      AAjout := 'Individual'+#$9;
      AAjout2 := #$9;
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9+#$9;
        AAjout2 := AAjout2+'Heterozygosity'+#$9+'Standardized heterozygosity'+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := AAjout+'Total'+#$9;
      AAjout2 := AAjout2+'Mean heterozygosity'+#$9+'Mean standardized heterozygosity'+#$9;
      Wonder.Add(AAjout);
      Wonder.Add(AAjout2);
    end;

    if ChCalcul = 1 then
    begin
      AAjout := 'Table of individual intern relatedness';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form4.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form4.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form4.Edit4.Text;
      Wonder.Add(AAjout);
      nbloc := 1;
      repeat
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := 'Individual'+#$9+'Heterozygosity'+#$9+'Intern Relatedness';
      Wonder.Add(AAjout);
    end;

    if ChCalcul = 2 then
    begin
      AAjout := 'Table of individual distances (d²) indexes';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form4.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form4.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form4.Edit4.Text;
      Wonder.Add(AAjout);
      AAjout := 'Individual'+#$9;
      AAjout2 := #$9;
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9+#$9+#$9;
        AAjout2 := AAjout2+'d²'+#$9+'Probability of having this d²'+#$9+'Standardized d²'+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := AAjout+'Total';
      AAjout2 := AAjout2+'Total d²'+#$9+'Mean of d² probabilities'+#$9+'Mean standardized d²';
      Wonder.Add(AAjout);
      Wonder.Add(AAjout2);
    end;

    if ChCalcul = 3 then
    begin
      AAjout := 'Table of probabilities of having this genotype';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form4.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form4.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form4.Edit4.Text;
      Wonder.Add(AAjout);
      AAjout := 'Individual'+#$9;
      AAjout2 := #$9;
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9;
        AAjout2 := AAjout2+'Genotype probability'+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := AAjout+'Total';
      AAjout2 := AAjout2+'Mean of probabilities';
      Wonder.Add(AAjout);
      Wonder.Add(AAjout2);
    end;

    i := 1;

    repeat

      Ligne := CalcGenIndiv(ChCalcul,i);

      if ChCalcul = 0 then
      begin
        AAjout := '';
        AAjout := Gen3Etude[i].Individual+#$9;
        for j := 1 to nbloc do
        begin
          AAjout := AAjout+FloatToStr(Ligne[j].Valeurs[1])+#$9+FloatToStr(Ligne[j].Valeurs[2])+#$9;
        end;
        Wonder.Add(AAjout);
      end;

      if ChCalcul = 1 then
      begin
        AAjout := '';
        AAjout := Gen3Etude[i].Individual+#$9+FloatToStr(Ligne[nbloc].Valeurs[1])+#$9+FloatToStr(Ligne[nbloc].Valeurs[2]);
        Wonder.Add(AAjout);
      end;

      if ChCalcul = 2 then
      begin
        AAjout := '';
        AAjout := Gen3Etude[i].Individual+#$9;
        for j := 1 to nbloc do
        begin
          AAjout := AAjout+FloatToStr(Ligne[j].Valeurs[1])+#$9
          +FloatToStr(Ligne[j].Valeurs[2])+#$9+FloatToStr(Ligne[j].Valeurs[3])+#$9;
        end;
        Wonder.Add(AAjout);
      end;

      if ChCalcul = 3 then
      begin
        AAjout := '';
        AAjout := Gen3Etude[i].Individual+#$9;
        for j := 1 to nbloc do
        begin
          AAjout := AAjout+FloatToStr(Ligne[j].Valeurs[1])+#$9;
        end;
        Wonder.Add(AAjout);
      end;

      i := i+1;
    until ((Gen3Etude[i].Individual = '') or (i > IndMax));

    if ChCalcul = 0 then
    begin
      Wonder.Add('Heterozygosity : 1 if locus is heterozygous, 0 if not.');
      Wonder.Add('Standardized Heterozygosity : Heterozygosity divided by the probability of beeing heterozygous at this locus.');
      Wonder.Add('Total : First column is the total number of heterozygous loci divided by the number of loci done, and the second the mean of standardized heterozygosities.');
    end;

    if ChCalcul = 1 then
    begin
      Wonder.Add('Heterozygosity : 1 if locus is heterozygous, 0 if not.');
      Wonder.Add('Intern relatedness is the quotient (2H-Sfi)/(2N-Sfi) where H is the number of homozygous loci, N the number of loci, and Sfi the sum of allelic frequences in individual i.');
    end;

    if ChCalcul = 2 then
    begin
      Wonder.Add('d² : size differences between the two alleles.');
      Wonder.Add('Total d² is the sum of the d² obtained for each locus');
      Wonder.Add('Standardized d² is the d² divided by the maximum distance obtained at this locus.');
    end;

    if ChCalcul = 3 then Wonder.Add('These probabilities are calculated according to the allelic frequences table.');

    Wonder.Add('99999 means that the calculation was impossible because of lacks in the dataset');

    Wonder.SaveToFile(SaveDialog1.FileName);
    Wonder.Free;
    Form4.Close;

  end;
  end;
end;

procedure TForm4.ExitProcIndH(Sender: TObject);
begin
  Form4.Close;
end;

end.



{*************************************************************************************************************************************************************}




unit LoadFamilFile;

{
This unity is related to the window Load Family File.
The program will ask if data is separated by tabulations or by spaces.
The file should have the following format (in text .txt) :
Male     Female      Chick1        Chick2     Chick3
There should be no "first line" with column titles, and no blank line at the
end of the file.
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, NausicaaUtilitaires, NausicaaConstantes;

type
  TForm5 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    RadioGroup1: TRadioGroup;
    Label4: TLabel;
    Label5: TLabel;
    procedure ExitP(Sender: TObject);
    procedure LoadFfile(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form5: TForm5;

implementation

uses ProgPrinc;

{$R *.DFM}


procedure TForm5.ExitP(Sender: TObject);
begin
  Form5.Close;
end;

procedure LectureFamily(Linea:String;sep:Shortstring;ligne:Word);
var
  colonne,contmot: Word;
  caractlu: shortstring;
  mot: string;
begin
  colonne := 1;
  contmot := 1;
  mot := '';
  repeat
    caractlu := '';
    caractlu := Linea[colonne];
    if caractlu = sep then
    begin
      Families[ligne,contmot] := LookNumberForIndividual(mot);
      mot := '';
      contmot := contmot+1;
    end
    else
    begin
      mot := mot+caractlu;
    end;
    colonne := colonne+1;
  until colonne>Length(Linea);
  Families[ligne,contmot] := LookNumberForIndividual(mot);
end;

procedure TForm5.LoadFfile(Sender: TObject);
var
  separateur: string[1];
  i,j: Word;
  Family: TStringList;
begin
  if OpenDialog1.Execute then          { Affichage de la boîte de dialogue d'ouverture }
  begin

    for i := 1 to FamilyMax do
    begin
      for j := 1 to TailleFamMax do
      begin
        Families[i,j] := 0;
      end;
    end;
    
    Family := TStringList.Create;
    Family.LoadFromFile(OpenDialog1.FileName);
    if Form5.RadioGroup1.ItemIndex = 0 then separateur := #$9 else separateur := ' ';
    for i := 0 to Family.Count-1 do LectureFamily(Family[i],separateur,i+1);
    FamilyNb := Family.Count;
    Family.free;
  end;
  LoadFamily := True;
  Form5.Close;
  Form1.CheckBox2.Checked := True;
end;

end.




{*************************************************************************************************************************************************************}




unit LoadGenFile;

{
This unity is related to the window Load Microsatellite File.
The program will ask if data is separated by tabulations or by spaces.
The file should have the following format (in text .txt) :
Individual      OtherInfo          Micro1    Micro2      Micro3
There should be no "first line" with column titles, and no blank line at the
end of the file.
Micro1 should be in the format 124126 for an individual with bands 124 and 126,
and 000000 if unknown. The first line should not have any empty field (no 000000)
because the program will use this line to calculate the number of loci.
Other information can be populations, sexe (1 letter) or
status (1 letter).
}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, NausicaaUtilitaires, NausicaaConstantes;

type
  TForm2 = class(TForm)
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure LoadFileGen(Sender: TObject);
    procedure ExitProc(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form2: TForm2;

implementation

uses ProgPrinc;

{$R *.DFM}

procedure LectureGenotypes3(Linea:String;sep:Shortstring;ligne:Word);
var
  colonne,contmot,lastlocus: Word;
  caractlu: shortstring;
  mot: string;
begin
  colonne := 1;
  contmot := 1;
  mot := '';
  repeat
    caractlu := '';
    caractlu := Linea[colonne];
    if caractlu = sep then
    begin
      if Form2.CheckBox1.Checked = True then
      begin
        if Form2.CheckBox2.Checked = True then
        begin
          if Form2.CheckBox3.Checked = True then
          begin
            if contmot = 1 then Gen3Etude[ligne].Population := mot;
            if contmot = 2 then Gen3Etude[ligne].Individual := mot;
            if contmot = 3 then Gen3Etude[ligne].Sexe := mot;
            if contmot = 4 then Gen3Etude[ligne].Status := mot;
            if contmot > 4 then
            begin
              Gen3Etude[ligne].Genotype[contmot-4,1] := StrToInt(mot[1]+mot[2]+mot[3]);
              Gen3Etude[ligne].Genotype[contmot-4,2] := StrToInt(mot[4]+mot[5]+mot[6]);
            end;
          end
          else
          begin
            if contmot = 1 then Gen3Etude[ligne].Population := mot;
            if contmot = 2 then Gen3Etude[ligne].Individual := mot;
            if contmot = 3 then Gen3Etude[ligne].Sexe := mot;
            if contmot > 3 then
            begin
              Gen3Etude[ligne].Genotype[contmot-3,1] := StrToInt(mot[1]+mot[2]+mot[3]);
              Gen3Etude[ligne].Genotype[contmot-3,2] := StrToInt(mot[4]+mot[5]+mot[6]);
            end;
          end;
        end
        else
        begin
          if Form2.CheckBox3.Checked = True then
          begin
            if contmot = 1 then Gen3Etude[ligne].Population := mot;
            if contmot = 2 then Gen3Etude[ligne].Individual := mot;
            if contmot = 3 then Gen3Etude[ligne].Status := mot;
            if contmot > 3 then
            begin
              Gen3Etude[ligne].Genotype[contmot-3,1] := StrToInt(mot[1]+mot[2]+mot[3]);
              Gen3Etude[ligne].Genotype[contmot-3,2] := StrToInt(mot[4]+mot[5]+mot[6]);
            end;
          end
          else
          begin
            if contmot = 1 then Gen3Etude[ligne].Population := mot;
            if contmot = 2 then Gen3Etude[ligne].Individual := mot;
            if contmot > 2 then
            begin
              Gen3Etude[ligne].Genotype[contmot-2,1] := StrToInt(mot[1]+mot[2]+mot[3]);
              Gen3Etude[ligne].Genotype[contmot-2,2] := StrToInt(mot[4]+mot[5]+mot[6]);
            end;
          end;
        end;
      end
      else
      begin
        if Form2.CheckBox2.Checked = True then
        begin
          if Form2.CheckBox3.Checked = True then
          begin
            if contmot = 1 then Gen3Etude[ligne].Individual := mot;
            if contmot = 2 then Gen3Etude[ligne].Sexe := mot;
            if contmot = 3 then Gen3Etude[ligne].Status := mot;
            if contmot > 3 then
            begin
              Gen3Etude[ligne].Genotype[contmot-3,1] := StrToInt(mot[1]+mot[2]+mot[3]);
              Gen3Etude[ligne].Genotype[contmot-3,2] := StrToInt(mot[4]+mot[5]+mot[6]);
            end;
          end
          else
          begin
            if contmot = 1 then Gen3Etude[ligne].Individual := mot;
            if contmot = 2 then Gen3Etude[ligne].Sexe := mot;
            if contmot > 2 then
            begin
              Gen3Etude[ligne].Genotype[contmot-2,1] := StrToInt(mot[1]+mot[2]+mot[3]);
              Gen3Etude[ligne].Genotype[contmot-2,2] := StrToInt(mot[4]+mot[5]+mot[6]);
            end;
          end;
        end
        else
        begin
          if Form2.CheckBox3.Checked = True then
          begin
            if contmot = 1 then Gen3Etude[ligne].Individual := mot;
            if contmot = 2 then Gen3Etude[ligne].Status := mot;
            if contmot > 2 then
            begin
              Gen3Etude[ligne].Genotype[contmot-2,1] := StrToInt(mot[1]+mot[2]+mot[3]);
              Gen3Etude[ligne].Genotype[contmot-2,2] := StrToInt(mot[4]+mot[5]+mot[6]);
            end;
          end
          else
          begin
            if contmot = 1 then Gen3Etude[ligne].Individual := mot;
            if contmot > 1 then
            begin
              Gen3Etude[ligne].Genotype[contmot-1,1] := StrToInt(mot[1]+mot[2]+mot[3]);
              Gen3Etude[ligne].Genotype[contmot-1,2] := StrToInt(mot[4]+mot[5]+mot[6]);
            end;
          end;
        end;
      end;
      mot := '';
      contmot := contmot+1;
    end
    else
    begin
      mot := mot+caractlu;
    end;
    colonne := colonne+1;
  until colonne>Length(Linea);
  lastlocus := 1;
  if Form2.CheckBox1.Checked = True then lastlocus := lastlocus+1;
  if Form2.CheckBox2.Checked = True then lastlocus := lastlocus+1;
  if Form2.CheckBox3.Checked = True then lastlocus := lastlocus+1;
  Gen3Etude[ligne].Genotype[contmot-lastlocus,1] := StrToInt(mot[1]+mot[2]+mot[3]);
  Gen3Etude[ligne].Genotype[contmot-lastlocus,2] := StrToInt(mot[4]+mot[5]+mot[6]);
end;

procedure TForm2.LoadFileGen(Sender: TObject);
var
  separateur: string[1];
  i,j: Word;
  Genotypes: TStringList;
begin
  if OpenDialog1.Execute then          { Affichage de la boîte de dialogue d'ouverture }
  begin
    for i := 1 to IndMax do
    begin
      Gen3Etude[i].Population := '';
      Gen3Etude[i].Individual := '';
      Gen3Etude[i].Sexe := '';
      Gen3Etude[i].Status := '';
      for j := 1 to LocusMax do
      begin
        Gen3Etude[i].Genotype[j,1] := 0;
        Gen3Etude[i].Genotype[j,2] := 0;
      end;
    end;

    Genotypes := TStringList.Create;
    Genotypes.LoadFromFile(OpenDialog1.FileName);
    if Form2.RadioGroup1.ItemIndex = 0 then separateur := #$9 else separateur := ' ';
    for i := 0 to Genotypes.Count-1 do LectureGenotypes3(Genotypes[i],separateur,i+1);
    Genotypes.free;
  end;
  Population := False;
  Sexe := False;
  Status := False;
  if Form2.CheckBox1.Checked = True then Population := True;
  if Form2.CheckBox2.Checked = True then Sexe := True;
  if Form2.CheckBox3.Checked = True then Status := True;
  LoadGen := 1;
  Form2.Close;
  Form1.CheckBox1.Checked := True;
end;

procedure TForm2.ExitProc(Sender: TObject);
begin
  Form2.Close;
end;

end.



{*************************************************************************************************************************************************************}




unit MeanQualitGenet;

{
This unity is related to the window Mean Genetic quality.
In this one, you can calculate the mean between the individual heterozygosity of
the male and the female for each pari. Individual heterozygosity is calculated according to 4 different indices
(Direct heterozygosity, Standardized heterozygosity, Intern relatedness, and
Probability of having this genotype given the allelic frequencies).
For the calculation of this indices, you need to have the allelic frequencies. However,
in order to have good estimates of these frequencies, you may need to restrain the calculation
of this frequencies by population, by sex, by time of observation (not yet computed) or by status(breeder or not,
adult or chick, etc.).
}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, NausicaaUtilitaires, NausicaaConstantes;

type
  TForm6 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    RadioGroup3: TRadioGroup;
    RadioGroup4: TRadioGroup;
    Errors: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Button2: TButton;
    RadioGroup5: TRadioGroup;
    SaveDialog1: TSaveDialog;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure ExitProcIndH(Sender: TObject);
    procedure SaveIndivHtz(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form6: TForm6;

implementation

{$R *.DFM}

procedure Erreurwriteln(s : string); {ecrire dans la boite erreur}
begin
  with Form6 do Errors.Lines.Append(s);
end;

procedure CalculGeneralFreqChoisies;
var
  Gen3EtInt1: TabGen3D;
begin
  Gen3EtInt1 := Gen3Etude;
  if Form6.RadioGroup1.ItemIndex = 1 then Gen3EtInt1 := ExtractPop3(Gen3EtInt1,Form6.Edit1.Text);
  if Form6.RadioGroup2.ItemIndex = 1 then Gen3EtInt1 := ExtractSex3(Gen3EtInt1,Form6.Edit2.Text);
  if Form6.RadioGroup3.ItemIndex = 1 then Gen3EtInt1 := ExtractStt3(Gen3EtInt1,Form6.Edit4.Text);
  FreqzAllEtude := CalcFreqzAll(Gen3EtInt1);
end;

procedure TForm6.SaveIndivHtz(Sender: TObject);
var
  droitdecalcul: Word;
  i,j,nbloc: Word;
  Wonder: TStringList;
  AAjout,AAjout2: String;
  ChCalcul: Byte;
  Ligne: IndGenInd;
begin
  droitdecalcul := 0;
  nbloc := 0;

  if ((LoadGen = 0) or (LoadFamily = False))         {Regarde si tout a bien été entré}
  then
  begin
    droitdecalcul := 1;
    if LoadGen = 0 then Erreurwriteln('No genotypes file loaded');
    if LoadFamily = False then Erreurwriteln('No family file loaded');
  end
  else
  begin
    if ((RadioGroup1.ItemIndex = 1) and ((Population = False) or (Form6.Edit1.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no population entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup2.ItemIndex = 1) and ((Sexe = False) or (Form6.Edit2.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no sexe entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup3.ItemIndex = 1) and ((Status = False) or (Form6.Edit4.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no status entered');
      droitdecalcul := 1;
    end;
  end;

  if ((droitdecalcul = 0) and (RadioGroup1.ItemIndex = 1))
  then                      {Regarde si les entrées existent}
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Population = Form6.Edit1.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This population does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup2.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Sexe = Form6.Edit2.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This sexe does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup3.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Status = Form6.Edit4.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This status does not exist');
  end;

  if droitdecalcul = 0 then   {Lance le calcul}
  begin
    CalculGeneralFreqChoisies;
    ChCalcul := RadioGroup5.ItemIndex;
    if (SaveDialog1.Execute) then
    begin
    Wonder := TStringList.Create;
    if ChCalcul = 0 then
    begin
      AAjout := 'Table of mean individual heterozygosity indexes for pairs of individuals';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form6.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form6.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form6.Edit4.Text;
      Wonder.Add(AAjout);
      AAjout := 'Male'+#$9+'Femelle'+#$9;
      AAjout2 := #$9+#$9;
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9+#$9;
        AAjout2 := AAjout2+'Heterozygosity'+#$9+'Standardized heterozygosity'+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := AAjout+'Total'+#$9;
      AAjout2 := AAjout2+'Mean heterozygosity'+#$9+'Mean standardized heterozygosity'+#$9+
      'Unbiased mean heterozygosity'+#$9+'Unbiased Mean Standardized heterozygosity'
      +#$9+'Male heterozygosity'+#$9+'Male standardized heterozygosity'
      +#$9+'Female heterozygosity'+#$9+'Female standardized heterozygosity'
      ;
      Wonder.Add(AAjout);
      Wonder.Add(AAjout2);
    end;

    if ChCalcul = 1 then
    begin
      AAjout := 'Table of mean individual intern relatedness for pairs of individuals';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form6.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form6.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form6.Edit4.Text;
      Wonder.Add(AAjout);
      nbloc := 1;
      repeat
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := 'Male'+#$9+'Femelle'+#$9+'Mean number of heterozygous loci'+#$9+'Mean Intern Relatedness'+#$9+'Male IR'+#$9+'Female IR';
      Wonder.Add(AAjout);
    end;

    if ChCalcul = 2 then
    begin
      AAjout := 'Table of mean individual distances (d²) indexes for pairs of individuals';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form6.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form6.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form6.Edit4.Text;
      Wonder.Add(AAjout);
      AAjout := 'Male'+#$9+'Femelle'+#$9;
      AAjout2 := #$9+#$9;
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9+#$9+#$9;
        AAjout2 := AAjout2+'Mean d²'+#$9+'Mean Probability of having this d²'+#$9+'Mean Standardized d²'+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := AAjout+'Total';
      AAjout2 := AAjout2+'Total d²'+#$9+'Mean of d² probabilities'+#$9+'Mean standardized d²'
      +#$9+'Unbiased Total d²'+#$9+'Unbiased Mean of d² probabilities'+#$9+'Unbiased Mean standardized d²';
      Wonder.Add(AAjout);
      Wonder.Add(AAjout2);
    end;

    if ChCalcul = 3 then
    begin
      AAjout := 'Table of mean probabilities of having this genotype for pairs of individuals';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form6.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form6.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form6.Edit4.Text;
      Wonder.Add(AAjout);
      AAjout := 'Male'+#$9+'Femelle'+#$9;
      AAjout2 := #$9+#$9;
      nbloc := 1;
      repeat
        AAjout := AAjout+'Locus '+IntToStr(nbloc)+#$9;
        AAjout2 := AAjout2+'Mean Genotype probability'+#$9;
        nbloc := nbloc+1
      until ((FreqzAllEtude[nbloc].Name = 0) or (nbloc > LocusMax));
      AAjout := AAjout+'Total';
      AAjout2 := AAjout2+'Mean of probabilities'+#$9+'Unbiased mean of probabilities';
      Wonder.Add(AAjout);
      Wonder.Add(AAjout2);
    end;

    i := 1;
    nbloc := nbloc;

    repeat

      Ligne := Meanarize(ChCalcul,i);

      if ChCalcul = 0 then
      begin
        AAjout := '';
        if Families[i,1] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,1]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        if Families[i,2] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,2]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        for j := 1 to nbloc+3 do
        begin
          AAjout := AAjout+FloatToStr(Ligne[j].Valeurs[1])+#$9+FloatToStr(Ligne[j].Valeurs[2])+#$9;
        end;
        Wonder.Add(AAjout);
      end;

      if ChCalcul = 1 then
      begin
        AAjout := '';
        if Families[i,1] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,1]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        if Families[i,2] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,2]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        AAjout := AAjout+FloatToStr(Ligne[nbloc].Valeurs[1])+#$9+FloatToStr(Ligne[nbloc].Valeurs[2])
        +#$9+FloatToStr(Ligne[nbloc+2].Valeurs[2])+#$9+FloatToStr(Ligne[nbloc+3].Valeurs[2]);
        Wonder.Add(AAjout);
      end;

      if ChCalcul = 2 then
      begin
        AAjout := '';
        if Families[i,1] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,1]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        if Families[i,2] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,2]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        for j := 1 to nbloc+1 do
        begin
          AAjout := AAjout+FloatToStr(Ligne[j].Valeurs[1])+#$9
          +FloatToStr(Ligne[j].Valeurs[2])+#$9+FloatToStr(Ligne[j].Valeurs[3])+#$9;
        end;
        Wonder.Add(AAjout);
      end;

      if ChCalcul = 3 then
      begin
        AAjout := '';
        if Families[i,1] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,1]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        if Families[i,2] <> 0 then AAjout := AAjout+Gen3Etude[Families[i,2]].Individual+#$9
        else AAjout := AAjout+'Unknown'+#$9;
        for j := 1 to nbloc+1 do
        begin
          AAjout := AAjout+FloatToStr(Ligne[j].Valeurs[1])+#$9;
        end;
        Wonder.Add(AAjout);
      end;

      i := i+1;
    until ((i > FamilyNb) or (i > FamilyMax));

    if ChCalcul = 0 then
    begin
      Wonder.Add('Heterozygosity : 1 if locus is heterozygous, 0 if not.');
      Wonder.Add('Standardized Heterozygosity : Heterozygosity divided by the probability of beeing heterozygous at this locus.');
      Wonder.Add('Total : First column is the mean heterozygosity and the second the mean of standardized heterozygosities.');
    end;

    if ChCalcul = 1 then
    begin
      Wonder.Add('Heterozygosity : 1 if locus is heterozygous, 0 if not.');
      Wonder.Add('Intern relatedness is the quotient (2H-Sfi)/(2N-Sfi) where H is the number of homozygous loci, N the number of loci, and Sfi the sum of allelic frequences in individual i.');
    end;

    if ChCalcul = 2 then
    begin
      Wonder.Add('d² : size differences between the two alleles.');
      Wonder.Add('Total d² is the sum of the d² obtained for each locus');
      Wonder.Add('Standardized d² is the d² divided by the maximum distance obtained at this locus.');
    end;

    if ChCalcul = 3 then Wonder.Add('These probabilities are calculated according to the allelic frequences table.');

    Wonder.Add('Unbiased means that the calculation has been limited for loci where genotype is known for both female and male');
    Wonder.Add('99999 means that the calculation was impossible because of lacks in the dataset');

    Wonder.SaveToFile(SaveDialog1.FileName);
    Wonder.Free;
    Form6.Close;

  end;
  end;
end;

procedure TForm6.ExitProcIndH(Sender: TObject);
begin
  Form6.Close;
end;

end.



{*************************************************************************************************************************************************************}




unit Paternite;

{
This unity is related to the window Exclusion probability of children.
For a given chick (with a given genotype) you can calculate the probability that its mother
is not its mother, and the probability that its father is not its father (knowing its mother).
This is related to the exclusion probabilities, used commonly in paternity analyses.
For the calculation of this probabilities, you need to have the allelic frequencies. However,
in order to have good estimates of these frequencies, you may need to restrain the calculation
of this frequencies by population, by sex, by time of observation (not yet computed) or by status(breeder or not,
adult or chick, etc.).
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, NausicaaUtilitaires, NausicaaConstantes;

type
  TForm7 = class(TForm)
    Button3: TButton;
    SaveDialog1: TSaveDialog;
    Label3: TLabel;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    RadioGroup3: TRadioGroup;
    RadioGroup4: TRadioGroup;
    Errors: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    procedure Exit(Sender: TObject);
    procedure ExclusionSave(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form7: TForm7;

implementation

{$R *.DFM}



procedure TForm7.Exit(Sender: TObject);
begin
  Form7.Close;
end;

procedure Erreurwriteln(s : string); {ecrire dans la boite erreur}
begin
  with Form7 do Errors.Lines.Append(s);
end;

procedure CalculGeneralFreqChoisies;
var
  Gen3EtInt1: TabGen3D;
begin
  Gen3EtInt1 := Gen3Etude;
  if Form7.RadioGroup1.ItemIndex = 1 then Gen3EtInt1 := ExtractPop3(Gen3EtInt1,Form7.Edit1.Text);
  if Form7.RadioGroup2.ItemIndex = 1 then Gen3EtInt1 := ExtractSex3(Gen3EtInt1,Form7.Edit2.Text);
  if Form7.RadioGroup3.ItemIndex = 1 then Gen3EtInt1 := ExtractStt3(Gen3EtInt1,Form7.Edit4.Text);
  FreqzAllEtude := CalcFreqzAll(Gen3EtInt1);
end;

procedure TForm7.ExclusionSave(Sender: TObject);
var
  droitdecalcul: Word;
  loc,endloc,fam,enf: Word;
  Wonder: TStringList;
  AAjout: String;
  Elix: ExtPat;
begin
  droitdecalcul := 0;

  if ((LoadGen = 0) or (LoadFamily = False))         {Regarde si tout a bien été entré}
  then
  begin
    droitdecalcul := 1;
    if LoadGen = 0 then Erreurwriteln('No genotypes file loaded');
    if LoadFamily = False then Erreurwriteln('No family file loaded');
  end
  else
  begin
    if ((RadioGroup1.ItemIndex = 1) and ((Population = False) or (Form7.Edit1.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no population entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup2.ItemIndex = 1) and ((Sexe = False) or (Form7.Edit2.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no sexe entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup3.ItemIndex = 1) and ((Status = False) or (Form7.Edit4.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no status entered');
      droitdecalcul := 1;
    end;
  end;

  if ((droitdecalcul = 0) and (RadioGroup1.ItemIndex = 1))
  then                      {Regarde si les entrées existent}
  begin
    droitdecalcul := 1;
    for loc := 1 to IndMax do
    begin
      if (Gen3Etude[loc].Population = Form7.Edit1.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This population does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup2.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for loc := 1 to IndMax do
    begin
      if (Gen3Etude[loc].Sexe = Form7.Edit2.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This sexe does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup3.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for loc := 1 to IndMax do
    begin
      if (Gen3Etude[loc].Status = Form7.Edit4.Text)
      then droitdecalcul := 0;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This status does not exist');
  end;

  if droitdecalcul = 0 then   {Lance le calcul}
  begin
    CalculGeneralFreqChoisies;
    if (SaveDialog1.Execute) then
    begin
      Wonder := TStringList.Create;

      Loc := 0;                              {Comptage du nombre de locus}
      repeat
        Loc := Loc+1;
      until ((Gen3Etude[1].Genotype[Loc,1] = Gen3Etude[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
      EndLoc := Loc-1;

      Wonder := TStringList.Create;
      AAjout := 'Table of exclusion probabilities for loci';
      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form7.Edit1.Text;
      if RadioGroup2.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the sexe '+Form7.Edit2.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form7.Edit4.Text;
      Wonder.Add(AAjout);

      Wonder.Add('---- ---- ----');

      AAjout := #$9;

      for Loc := 1 to EndLoc do
      begin
        AAjout := AAjout+'Locus '+IntToStr(Loc)+#$9;
      end;
      AAjout := AAjout+'Exclusion probability';

      for fam := 1 to FamilyNb do
      begin
        enf := 0;
        if ((Families[fam,1] <> 0) and (Families[fam,2] <> 0)) then
        begin
          repeat
            if enf <> 0 then
            begin
              Elix := CalcExclusionProb(Families[fam,1],Families[fam,2],Families[fam,enf+2]);

              AAjout := 'Father: '+Gen3Etude[Families[fam,1]].Individual;
              for Loc := 1 to EndLoc do
              begin
                AAjout := AAjout+#$9+IntToStr(Gen3Etude[Families[fam,1]].Genotype[Loc,1])+'/'+IntToStr(Gen3Etude[Families[fam,1]].Genotype[Loc,2]);
              end;
              AAjout := AAjout+#$9+FloatToStr(Elix[EndLoc+1,1]);
              Wonder.Add(AAjout);

              AAjout := 'Mother: '+Gen3Etude[Families[fam,2]].Individual;
              for Loc := 1 to EndLoc do
              begin
                AAjout := AAjout+#$9+IntToStr(Gen3Etude[Families[fam,2]].Genotype[Loc,1])+'/'+IntToStr(Gen3Etude[Families[fam,2]].Genotype[Loc,2]);
              end;
              AAjout := AAjout+#$9+FloatToStr(Elix[EndLoc+1,2]);
              Wonder.Add(AAjout);

              AAjout := 'Child: '+Gen3Etude[Families[fam,enf+2]].Individual;
              for Loc := 1 to EndLoc do
              begin
                AAjout := AAjout+#$9+IntToStr(Gen3Etude[Families[fam,enf+2]].Genotype[Loc,1])+'/'+IntToStr(Gen3Etude[Families[fam,enf+2]].Genotype[Loc,2]);
              end;
              AAjout := AAjout+#$9+FloatToStr(Elix[EndLoc+1,3]);
              Wonder.Add(AAjout);

              Wonder.Add('---- ---- ----');

            end;
            enf := enf+1;
          until Families[fam,enf+2] = 0;
        end
        else
        begin
        if Families[fam,1] <> 0 then
        begin
          repeat
            if enf <> 0 then
            begin
              Elix := CalcExclusionProb(Families[fam,1],Families[fam,2],Families[fam,enf+2]);

              AAjout := 'Father: '+Gen3Etude[Families[fam,1]].Individual;
              for Loc := 1 to EndLoc do
              begin
                AAjout := AAjout+#$9+IntToStr(Gen3Etude[Families[fam,1]].Genotype[Loc,1])+'/'+IntToStr(Gen3Etude[Families[fam,1]].Genotype[Loc,2]);
              end;
              AAjout := AAjout+#$9+FloatToStr(Elix[EndLoc+1,1]);
              Wonder.Add(AAjout);

              AAjout := 'Child: '+Gen3Etude[Families[fam,enf+2]].Individual;
              for Loc := 1 to EndLoc do
              begin
                AAjout := AAjout+#$9+IntToStr(Gen3Etude[Families[fam,enf+2]].Genotype[Loc,1])+'/'+IntToStr(Gen3Etude[Families[fam,enf+2]].Genotype[Loc,2]);
              end;
              Wonder.Add(AAjout);

              Wonder.Add('---- ---- ----');

            end;
            enf := enf+1;
          until Families[fam,enf+2] = 0;
        end;

        if Families[fam,2] <> 0 then
        begin
          repeat
            if enf <> 0 then
            begin
              Elix := CalcExclusionProb(Families[fam,1],Families[fam,2],Families[fam,enf+2]);

              AAjout := 'Mother: '+Gen3Etude[Families[fam,2]].Individual;
              for Loc := 1 to EndLoc do
              begin
                AAjout := AAjout+#$9+IntToStr(Gen3Etude[Families[fam,2]].Genotype[Loc,1])+'/'+IntToStr(Gen3Etude[Families[fam,2]].Genotype[Loc,2]);
              end;
              AAjout := AAjout+#$9+FloatToStr(Elix[EndLoc+1,2]);
              Wonder.Add(AAjout);

              AAjout := 'Child: '+Gen3Etude[Families[fam,enf+2]].Individual;
              for Loc := 1 to EndLoc do
              begin
                AAjout := AAjout+#$9+IntToStr(Gen3Etude[Families[fam,enf+2]].Genotype[Loc,1])+'/'+IntToStr(Gen3Etude[Families[fam,enf+2]].Genotype[Loc,2]);
              end;
              Wonder.Add(AAjout);

              Wonder.Add('---- ---- ----');

            end;
            enf := enf+1;
          until Families[fam,enf+2] = 0;
        end;
        end;

      end;

      Wonder.Add('The first number in exclusion column is the probability of false inclusion for mother');
      Wonder.Add('The first number in exclusion column is the probability of false inclusion for father');
      Wonder.Add('The first number in exclusion column is the probability of false inclusion for father knowing the genotype of the mother');

      Wonder.SaveToFile(SaveDialog1.FileName);
      Wonder.Free;
      Form7.Close;
    end;
  end;

end;

end.



{*************************************************************************************************************************************************************}




unit Pairing;

{
Unit related to permutations.
This one will ask the user to give different constants (mortality rate,
success rate, etc.
and then will run the number of permutations asked, during the number of years
asked
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, NausicaaUtilitaires, NausicaaConstantes;
  
type
  TForm10 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    RadioGroup3: TRadioGroup;
    RadioGroup4: TRadioGroup;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit4: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    RadioGroup5: TRadioGroup;
    Label6: TLabel;
    Label7: TLabel;
    Edit7: TEdit;
    Edit8: TEdit;
    Label8: TLabel;
    Edit9: TEdit;
    Button2: TButton;
    RadioGroup6: TRadioGroup;
    Label9: TLabel;
    Edit3: TEdit;
    Label10: TLabel;
    Edit10: TEdit;
    Button1: TButton;
    RadioGroup7: TRadioGroup;
    Errors: TMemo;
    SaveDialog1: TSaveDialog;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Permutations(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form10: TForm10;


implementation

{$R *.DFM}

procedure Erreurwriteln(s : string); {ecrire dans la boite erreur}
begin
  with Form10 do Errors.Lines.Append(s);
end;

procedure TForm10.Permutations(Sender: TObject); {Lancements des permutations}
var
  Ligne: Related;
  droitdecalcul: Word;
  i,j,k,cptclass: Word;
  Wonder: TStringList;
  AAjout: String;
  ChCalcul: Byte;
  Mort, NbSites, Celibat: Integer;
  TxEchec, DivSiS, DivSiE: Integer;
  NbPerm, NbAnnee: Integer;
  Relais: Integer;
  TableDIndiv: TabGenAPerm;
  TabFamy1, TabFamy2: FamilyAPerm;
  NbTotalIndiv: Integer;
begin
  droitdecalcul := 0;
  NbSites := 100;
  Celibat := 0;
  NbPerm := 1000;
  NbAnnee := 1;
  Celibat := 0;
  Mort := 0;
  TxEchec := 0;
  DivSiS := 0;
  DivSiE := 100;
  
  {Regarde si tout a bien été entré}
  if ((LoadGen = 0) or (LoadFamily = False))
  then
  begin
    droitdecalcul := 1;
    if LoadGen = 0 then Erreurwriteln('No genotypes file loaded');
    if LoadFamily = False then Erreurwriteln('No family file loaded');
  end
  else
  begin
    if ((RadioGroup1.ItemIndex = 1) and ((Population = False) or (Form10.Edit1.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no population entered');
      droitdecalcul := 1;
    end;
    if ((RadioGroup6.ItemIndex = 1) and (Sexe = False))
    then
    begin
      Erreurwriteln('Invalide format : no sexe entered for observed individuals');
      droitdecalcul := 1;
    end;
    if ((RadioGroup3.ItemIndex = 1) and ((Status = False) or (Form10.Edit4.Text = '')))
    then
    begin
      Erreurwriteln('Invalide format : no status entered');
      droitdecalcul := 1;
    end;

    { Lecture du nombre de permutations }
    Relais := 1000;
    if Form10.Edit9.Text <> '' then Relais := StrToInt(Form10.Edit9.Text);
    if ((Relais < 1) or (Relais > 10000)) then
    begin
      Erreurwriteln('Invalid number of permutations');
      droitdecalcul := 1;
    end
    else NbPerm := Relais;

    { Lecture du pourcentage de célibataires }
    if ((Form10.RadioGroup2.ItemIndex = 1) and (Form10.Edit2.Text = '')) then
    begin
      Erreurwriteln('No percentage of unmated individuals entered');
      droitdecalcul := 1;
    end
    else
    begin
      Relais := 0;
      if Form10.Edit2.Text <> '' then Relais := StrToInt(Form10.Edit2.Text);
      if ((Form10.RadioGroup2.ItemIndex = 1) and ((Relais < 0) or (Relais > 100)))
      then
      begin
        Erreurwriteln('Invalid percentage of unmated individuals');
        droitdecalcul := 1;
      end
      else
      begin
        if (Form10.RadioGroup2.ItemIndex = 1) then Celibat := Relais;
      end;
    end;

    { Lecture du nombre de sites }
    if ((droitdecalcul = 0) and (Form10.Edit3.Text <> '')) then
    begin
      if ((StrToInt(Form10.Edit3.Text) > 0) and (StrToInt(Form10.Edit3.Text) < 500))
      then NbSites := StrToInt(Form10.Edit3.Text)
      else
      begin
        Erreurwriteln('Invalid number of pairs');
        droitdecalcul := 1;
      end;
    end;

    { Lecture du nombre d'années }
    if ((droitdecalcul = 0) and (Form10.Edit5.Text <> '')) then
    begin
      if ((StrToInt(Form10.Edit5.Text) > 0) and (StrToInt(Form10.Edit5.Text) < NbAnnees))
      then NbAnnee := StrToInt(Form10.Edit5.Text)
      else
      begin
        Erreurwriteln('Invalid number of years');
        droitdecalcul := 1;
      end;
    end;
    if ((droitdecalcul = 0) and (NbAnnee <> 1)) then
    { Si plus d'une année, il faut mort, divorce et failure}
    begin
      Relais := 0;
      if Form10.Edit6.Text <> '' then Relais := StrToInt(Form10.Edit6.Text);
      if ((Relais >= 0) and (Relais <= 100))
      then Mort := Relais
      else
      begin
        Erreurwriteln('Invalid mortality percentage');
        droitdecalcul := 1;
      end;
      Relais := 0;
      if Form10.Edit10.Text <> '' then Relais := StrToInt(Form10.Edit10.Text);
      if ((Relais >= 0) and (Relais <= 100))
      then TxEchec := Relais
      else
      begin
        Erreurwriteln('Invalid failure percentage');
        droitdecalcul := 1;
      end;
      Relais := 0;
      if Form10.Edit8.Text <> '' then Relais := StrToInt(Form10.Edit8.Text);
      if ((Relais >= 0) and (Relais <= 100))
      then DivSiS := Relais
      else
      begin
        Erreurwriteln('Invalid divorce after success percentage');
        droitdecalcul := 1;
      end;
      Relais := 0;
      if Form10.Edit7.Text <> '' then Relais := StrToInt(Form10.Edit7.Text);
      if ((Relais >= 0) and (Relais <= 100))
      then DivSiE := Relais
      else
      begin
        Erreurwriteln('Invalid divorce after failure percentage');
        droitdecalcul := 1;
      end;
    end;
  end;

  {A ce niveau, toutes les caractéristiques du modèle ont été rentrées
  Il faut encore regarder si les entrées de pop et de statut existent bien sur le fichier
  de génotype}
  if ((droitdecalcul = 0) and (RadioGroup1.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Population = Form10.Edit1.Text)
      then
      begin
        droitdecalcul := 0;
        Popu := Form10.Edit1.Text;
      end;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This population does not exist');
  end;
  if ((droitdecalcul = 0) and (RadioGroup3.ItemIndex = 1))
  then
  begin
    droitdecalcul := 1;
    for i := 1 to IndMax do
    begin
      if (Gen3Etude[i].Status = Form10.Edit4.Text)
      then
      begin
        droitdecalcul := 0;
        Stat := Form10.Edit4.Text;
      end;
    end;
    if droitdecalcul = 1 then Erreurwriteln('This status does not exist');
  end;

  {Si après avoir tout regarder, droitdecalcul=0, alors on peut lancer le
  calcul}

  if droitdecalcul = 0 then   {Lance le calcul}
  
  begin
    ChCalcul := Form10.RadioGroup7.ItemIndex;
    
    if (SaveDialog1.Execute) then
    begin
    Wonder := TStringList.Create;

      if ChCalcul = 0 then AAjout := 'Table of estimator of Lynch & Ritland';
      if ChCalcul = 1 then AAjout := 'Table of estimator of Queller & Goodnight';
      if ChCalcul = 2 then AAjout := 'Table of estimator of Probability of having an homozygous child';

      if RadioGroup1.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the population '+Form10.Edit1.Text;
      if RadioGroup3.ItemIndex = 1 then AAjout := AAjout+', the allelic frequences table is calculated for the status '+Form10.Edit4.Text;
      Wonder.Add(AAjout);
      Wonder.Add((IntToStr(NbPerm)+' permutations were made, with '+IntToStr(NbSites)+' sites available, and during '+IntToStr(NbAnnee)+' years'));
      if RadioGroup2.ItemIndex = 1 then Wonder.Add(('For each permutation, '+IntToStr(Celibat)+' % of individuals were unmated'));
      if NbAnnee > 1 then
      begin
        AAjout := 'Each year, '+IntToStr(Mort)+' % of individuals died, and ';
        if RadioGroup2.ItemIndex = 0 then AAjout := AAjout+' all individuals mate together ' else AAjout := AAjout + 'old individuals mate first';
        Wonder.Add(AAjout);
        if RadioGroup5.ItemIndex = 1 then AAjout := 'Low quality pairs failed their reproduction ; ' else AAjout := 'Reproductive success was random ; ';
        AAjout := AAjout+'Failure affected '+IntToStr(TxEchec)+' % of pairs';
        Wonder.Add(AAjout);
        Wonder.Add((IntToStr(DivSiE)+' % of failed pairs divorced and '+IntToStr(DivSiS)+' % of successful pairs divorced'));
      end;
      Wonder.Add(#$9+#$9+'Mean number of pairs with value of index equal to :');
      AAjout := 'Perm'+#$9+'Year'+#$9+'<-0,9'+#$9;
      cptclass := 0;
      repeat
        AAjout := AAjout+FloatToStr(0.01*(-90+cptclass))+#$9;
        cptclass := cptclass+1
      until (-0.9+cptclass*0.01 >= 0.905);
      AAjout := AAjout+'>0.9'+#$9+'Mean';
      Wonder.Add(AAjout);

      {A ce stade, le premier tableau est prêt. Il faut maintenant lancer
      les permutations}

      if Form10.RadioGroup1.ItemIndex = 1 then TableDIndiv := ExtractPopTInd(Gen3Etude,Form10.Edit1.Text)
      else TableDIndiv := ConvertIndiv(Gen3Etude);    {convertit les individus string en integer}
      if Form10.RadioGroup3.ItemIndex = 1 then TableDIndiv := ExtractSttTInd(TableDIndiv,Form10.Edit4.Text);
      FreqzAllEtude := CalcFreqzAllTInd(TableDIndiv);      {création du tableau de fr allélq}

      NbTotalIndiv := 0;
      i := 1;
      repeat
        if TableDIndiv[i].Sexe <> '' then NbTotalIndiv := NbTotalIndiv+1;
        i := i+1;
      until ((i > IndMax) or (TableDIndiv[i].Sexe = ''));

      Randomize;

      if Form10.RadioGroup6.ItemIndex = 1 then
      begin  {Individus nouveaux créés sur fréquence}
        NbTotalIndiv := Round((NbSites*2)/(1-(Celibat/100)));
        Wonder.Add(EcrivainObs(Gen3Etude,Families,ChCalcul));

        for i := 1 to NbPerm do
        begin
          for j := 1 to NbTotalIndiv do TableDIndiv[j] := InitialisationIndiv(j);
          TabFamy1 := InitialisationDesFamy;
          for j := 1 to NbAnnee do
          begin
            TabFamy2 := InitialisationDesFamy;
            Erreurwriteln('Permutation '+IntToStr(i)+' Année '+IntToStr(j));
            for k := 1 to NbTotalIndiv do TableDIndiv[k] := Sordeloeuf(TableDIndiv,j,k);
                       {Création des nouveaux individus}
            TabFamy2 := OccupezLesSites(TableDIndiv,TabFamy1,NbSites,NbTotalIndiv,DivSiS,DivSiE);
                       {Mariage des individus
                       1) Les individus ayant réussi l'an passé reviennent suivant DivSiS
                       2) Les individus ayant raté reviennent suivant DivSiE
                       3) Les individus non appariés s'apparient, par ordre d'age ou non}
            TabFamy2 := CalculeDistGenet(TabFamy2,ChCalcul,TableDIndiv);
                       {Calcule des distances génétiques suivant le critère choisi}
            TabFamy2 := Succes(TabFamy2,RadioGroup5.ItemIndex,TxEchec,NbSites);
                       {Succès des individus suivant TxEchec, aléatoire ou en
                       accord aux distances génétiques}
            TabFamy1 := TabFamy2;
            TableDIndiv := ReportDisponibilite(TableDIndiv,TabFamy1,NbTotalIndiv);
                       {Report des succès de l'année en succès de l'an passé}
            for k := 1 to NbTotalIndiv do TableDIndiv[k] := Idie(TableDIndiv,Mort,k);
                       {Mort des individus suivant Mort, et changement de status
                       du partenaire encore vivant dans TableDIndiv en utilisant TableFamy1}
            Wonder.Add(EcrivainTableau(i,j,TabFamy1));
          end;
        end;
      end
      else     {Individus observés : a ce moment on ne fait les permutations
               que sur une année}
      begin
        Wonder.Add(EcrivainObs(Gen3Etude,Families,ChCalcul));
        TabFamy1 := InitialisationDesFamy;
        for i := 1 to NbPerm do
        begin
          Erreurwriteln('Permutation '+IntToStr(i));
          TabFamy2 := InitialisationDesFamy;
          for k := 1 to NbTotalIndiv do TableDIndiv[k].Status := 'D';
          TabFamy2 := OccupezLesSites(TableDIndiv,TabFamy1,NbSites,NbTotalIndiv,DivSiS,DivSiE);
                       {Mariage des individus
                       1) Les individus ayant réussi l'an passé reviennent suivant DivSiS
                       2) Les individus ayant raté reviennent suivant DivSiE
                       3) Les individus non appariés s'apparient, par ordre d'age ou non}
          TabFamy2 := CalculeDistGenet(TabFamy2,ChCalcul,TableDIndiv);
                       {Calcule des distances génétiques suivant le critère choisi}
          Wonder.Add(EcrivainTableau(i,0,TabFamy2));
        end;
      end;

      Wonder.SaveToFile(SaveDialog1.FileName);
      Wonder.Free;
      Form10.Close;
    end;
  end;
end;

procedure TForm10.Button1Click(Sender: TObject);
begin
  Form10.Close;
end;

end.



{*************************************************************************************************************************************************************}




unit ProgPrinc;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, NausicaaUtilitaires, NausicaaConstantes, jpeg, ExtCtrls;

type
  TForm1 = class(TForm)
    MenuPrincipal: TMainMenu;
    Main1: TMenuItem;
    Exit1: TMenuItem;
    LoadFile1: TMenuItem;
    Genotypesfile1: TMenuItem;
    Familiesfile1: TMenuItem;
    Observationsfile1: TMenuItem;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    Calcul1: TMenuItem;
    Allelicfrequences1: TMenuItem;
    Individualheterozygosity1: TMenuItem;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Calculonpairs1: TMenuItem;
    Meangenetic1: TMenuItem;
    Relatedness1: TMenuItem;
    Paternity1: TMenuItem;
    Bandsharingcoefficients1: TMenuItem;
    Exclusionprobability1: TMenuItem;
    Exclusonprobabilitiesforloci1: TMenuItem;
    SaveDialog1: TSaveDialog;
    Pairingmodels1: TMenuItem;
    S1: TMenuItem;
    procedure ExitProc(Sender: TObject);
    procedure LoadGenFile(Sender: TObject);
    procedure AllelicFreq(Sender: TObject);
    procedure Individualheterozygosity1Click(Sender: TObject);
    procedure Familiesfile1Click(Sender: TObject);
    procedure Meangenetic1Click(Sender: TObject);
    procedure Exclusionprobability1Click(Sender: TObject);
    procedure Exclusonprobabilitiesforloci1Click(Sender: TObject);
    procedure Bandsharingcoefficients1Click(Sender: TObject);
    procedure Relatedness1Click(Sender: TObject);
    procedure Pairingmodels1Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;


implementation

uses LoadGenFile, LoadFamilFile, AllelicFreqz, IndivHtz, MeanQualitGenet,
  Paternite, ExclProb, Relatedness, Pairing, SParent;

{$R *.DFM}

procedure TForm1.ExitProc(Sender: TObject);   {Quit Nausicaa}
begin
  Form1.Close;
end;

procedure TForm1.LoadGenFile(Sender: TObject);   {Display the window with the options for loading the file with microsatellites information}
begin
  Form2:=TForm2.Create(self);
  Form2.Show;
end;

procedure TForm1.AllelicFreq(Sender: TObject);   {Display the window with the options for calculation of the allelic frequencies}
begin
  Form3:=TForm3.Create(self);
  Form3.Show;
end;

procedure TForm1.Individualheterozygosity1Click(Sender: TObject);  {Display the window with the options for calculation of individual heterozygosoty}
begin
  Form4:=TForm4.Create(self);
  Form4.Show;
end;

procedure TForm1.Familiesfile1Click(Sender: TObject);  {Display the window with the options for loading the file with families information}
begin
  Form5:=TForm5.Create(self);
  Form5.Show;
end;

procedure TForm1.Meangenetic1Click(Sender: TObject);  {Display the window with the options for calculation of the mean of genetic indices : male index + female index /2}
begin
  Form6:=TForm6.Create(self);
  Form6.Show;
end;

procedure TForm1.Exclusionprobability1Click(Sender: TObject); {Display the window with the options for calculation of the exclusion probabilities for each chick, given its parents : this is interesting for paternity analyses}
begin
  Form7:=TForm7.Create(self);
  Form7.Show;
end;

procedure TForm1.Exclusonprobabilitiesforloci1Click(Sender: TObject); {Display the window with the options for calculation of the exclusion probabilities for each locus: this gives the relative importance of each locus in the "individuality"}
begin
  Form8:=TForm8.Create(self);
  Form8.Show;
end;

procedure TForm1.Bandsharingcoefficients1Click(Sender: TObject); {Display the window with the options for calculation of the band sharing coefficients between chicks and parents}
var
  loc,endloc,fam,enf: Word;
  Wonder: TStringList;
  AAjout: String;
  Elix: BandSharing;
begin
  if (SaveDialog1.Execute) then
  begin
    Wonder := TStringList.Create;

    Loc := 0;                              {Comptage du nombre de locus}
    repeat
      Loc := Loc+1;
    until ((Gen3Etude[1].Genotype[Loc,1] = Gen3Etude[IndMax+1].Genotype[Loc,1]) or (Loc > LocusMax));
    EndLoc := Loc-1;

    Wonder := TStringList.Create;
    AAjout := 'Table of band-sharing coefficient';
    Wonder.Add(AAjout);

    AAjout := 'Father'+#$9+'Mother'+#$9+'Offspring'+#$9;

    for Loc := 1 to EndLoc do
    begin
      AAjout := AAjout+'Locus '+IntToStr(Loc)+#$9;
    end;
    AAjout := AAjout+'Sum of Band-sharing coefficient'+#$9+'Number of compared alleles'+#$9+'Percentage of shared alleles';
    Wonder.Add(AAjout);

    for fam := 1 to FamilyNb do
    begin
      enf := 0;
        repeat
          if enf <> 0 then
          begin
            Elix := CalcExclusionProb2(Families[fam,1],Families[fam,2],Families[fam,enf+2]);

            if ((Families[fam,1] <> 0) and (Families[fam,2] <> 0)) then AAjout := Gen3Etude[Families[fam,1]].Individual+#$9+Gen3Etude[Families[fam,2]].Individual+#$9+Gen3Etude[Families[fam,enf+2]].Individual+#$9
            else
            begin
              if Families[fam,1] <> 0 then AAjout := Gen3Etude[Families[fam,1]].Individual+#$9+#$9+Gen3Etude[Families[fam,enf+2]].Individual+#$9;
              if Families[fam,2] <> 0 then AAjout := #$9+Gen3Etude[Families[fam,2]].Individual+#$9+Gen3Etude[Families[fam,enf+2]].Individual+#$9;
            end;

            for Loc := 1 to EndLoc+1 do
            begin
              AAjout := AAjout+IntToStr(Elix[Loc])+#$9;
            end;
            if Elix[EndLoc+2] <> 0 then AAjout := AAjout+IntToStr(Elix[EndLoc+2])+#$9+FloatToStr(Elix[EndLoc+1]/Elix[EndLoc+2])
            else AAjout := AAjout+IntToStr(Elix[EndLoc+2])+#$9+IntToStr(Elix[EndLoc+2]);

            Wonder.Add(AAjout);

          end;
          enf := enf+1;
        until Families[fam,enf+2] = 0;

    end;

    Wonder.Add('The band-sharing value is 2 if the two alleles of the offspring is equal to the alleles of the parents, 1 if only one allele is correct, 0 if no allele is correct.');
    Wonder.Add('The value is 999 if the band-sharing coefficient can''t be calculated.');
    Wonder.Add('The two last column is the sum of all columns, and the sum divided by the number of loci compared.');

    Wonder.SaveToFile(SaveDialog1.FileName);
    Wonder.Free;
  end;

end;

procedure TForm1.Relatedness1Click(Sender: TObject); {Display the window with the options for calculation of relatedness between male and female inside a pair}
begin
  Form9:=TForm9.Create(self);
  Form9.Show;
end;

procedure TForm1.Pairingmodels1Click(Sender: TObject); {Display the window with the options for calculation of Monte Carlo permutations on pairs}
begin
  Form10:=TForm10.Create(self);
  Form10.Show;
end;



procedure TForm1.S1Click(Sender: TObject); {Display the window with the options for the calculation of the identity of the most probable biological parents given the genotype of the chick}
begin
  Form11:=TForm11.Create(self);
  Form11.Show;
end;

end.



{*************************************************************************************************************************************************************}




program Nausicaa;

{
Main Program, runing the program (ProgPrinc)
}

uses
  Forms,
  ProgPrinc in 'ProgPrinc.pas' {Form1},
  LoadGenFile in 'LoadGenFile.pas' {Form2},
  AllelicFreqz in 'AllelicFreqz.pas' {Form3},
  IndivHtz in 'IndivHtz.pas' {Form4},
  NausicaaUtilitaires in 'NausicaaUtilitaires.pas',
  NausicaaConstantes in 'NausicaaConstantes.pas',
  LoadFamilFile in 'LoadFamilFile.pas' {Form5},
  MeanQualitGenet in 'MeanQualitGenet.pas' {Form6},
  Paternite in 'Paternite.pas' {Form7},
  ExclProb in 'ExclProb.pas' {Form8},
  Relatedness in 'Relatedness.pas' {Form9},
  Pairing in 'Pairing.pas' {Form10},
  SParent in 'SParent.pas' {Form11};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TForm11, Form11);
  Application.Run;
end.