Multilocus genotype frequencies

Published results using this notebook should cite:
Hospital, F., Dillmann, C. and Melchinger, A.E. (1996) A general algorithm to compute multilocus genotype frequencies under various mating systems. Comput. Appl. Biosci, 12(6):455-462.
For more information please contact fred@moulon.inra.fr

Self-Fertilization

Initialization

ClearAll["Global`*"];

Number of loci

n=3

General definitions

<<"definitions.m"

S1=
Table[{i,i},{i,1,ngam/2}];
S2=Flatten[
Table[{i,j},
{i,1,ngam/2-1},{j,i+1,ngam-i}],1];
S3=Table[{ngam/2+1-i,ngam/2+i},{i,1,ngam/2}];
S4=Flatten[
Table[{i,j},
{j,ngam/2+2,ngam},{i,ngam+2-j,j-1}],1];
S5=Table[{i,i},{i,ngam/2+1,ngam}];
L1=Length[S1];L2=Length[S2];L3=Length[S3];

genlist=Join[S1,S2,S3,S4,S5]

ngen=Length[genlist]

Initial genotype frequencies

No symmetry

ulist=Table[{genlist[[i]]},{i,ngen}]

nsym=Length[ulist]

Clear[index];
index=Table["+",{ngam},{ngam}];
Do[index[[ulist[[i,1,1]],ulist[[i,1,2]]]]=i,{i,1,nsym}];

Index for elements of freq[t], vector of all genotype frequencies at t

TableForm[index,
TableHeadings->{Table[gamname[i],{i,ngam}],
Table[gamname[i],{i,ngam}]},
TableAlignments->Center]

Define all initial frequencies below:

Do[f[1,x]=0,{x,nsym}];
f[1,index[[1,ngam]]]=1;

Symmetry

rs[k_]:=Sum[10^(n-l-1)*(1+rho[k,l]),{l,n-1}]

genrs[i_,j_]:=(-1)^(gam[i][[1]]+gam[j][[1]])*(rs[i]+rs[j])

rslist[ens_]:=Apply[genrs,ens,2]

usUnion[ens_]:=Map[ens[[##]]&,
Sort[Map[Position[ens,#][[1,1]]&,Union[ens]]]]

SS2=Map[Apply[S2[[##]]&,Position[rslist[S2],##],2]&,
usUnion[rslist[S2]]]

LL2=Length[SS2]

S4r=Reverse[S4]

SS4=Map[Apply[S4r[[##]]&,Position[rslist[S4r],##],2]&,
usUnion[rslist[S4r]]]

ulist=Join[
Table[{S1[[i]],S5[[L1-i+1]]},{i,L1}],
Table[Join[SS2[[i]],SS4[[i]]],{i,LL2}],
Table[{S3[[i]]},{i,L3}]];
ulist//ColumnForm

nsym=Length[ulist]

Clear[index];
index=Table["+",{ngam},{ngam}];
Do[Apply[(index[[##]]=i)&,ulist[[i]],2],{i,nsym}];

TableForm[index,
TableHeadings->{Table[gamname[i],{i,ngam}],
Table[gamname[i],{i,ngam}]},
TableAlignments->Center]

Define all initial frequencies below:

Do[f[1,x]=0,{x,1,nsym-1}];
f[1,nsym]=1

Tables

Format[zf[t_,x_]]:=Subscripted["f*"[x]][t];
Format[zf[t_,x_],TeXForm]:=Subscripted["f^{\ast}"[x]][t];
Format[zf[t,x_],TeXForm]:=Subscripted["f^{\ast}"[x]]

tabf=Table[zf[t,x],{x,nsym}]

Index for genotypes

Visual

Table[Join[
{zf[t,i]},
Apply[StringJoin[gamname[#1],"/",gamname[#2]]&,ulist[[i]],2]
],{i,nsym}]//TableForm

TeX

Table[Join[
{zf[t,i]},
Apply[StringJoin["\\frac{",gamname[#1],"}{",gamname[#2],"}"]&,ulist[[i]],2]
],{i,nsym}]//ColumnForm//TeXForm

Recursion

Definition

genrec[x_]:=Sum[
2^delta[ ulist[[x,1,1]] , ulist[[x,1,2]] ] * 
Simplify[(Apply[Plus,
Apply[P[##][[ ulist[[x,1,1]] ]] * 
P[##][[ ulist[[x,1,2]] ]]&,ulist[[k]],2]] ) ]*
zf[t,k]
,{k,1,nsym}]

Frequencies

Definition

f[t_,x_]:=f[t,x]=Sum[
2^delta[ ulist[[x,1,1]] , ulist[[x,1,2]] ] * 
Simplify[(Apply[Plus,
Apply[P[##][[ ulist[[x,1,1]] ]] * 
P[##][[ ulist[[x,1,2]] ]]&,ulist[[k]],2]] ) ]*
f[t-1,k]
,{k,1,nsym}]

freq[t_]:=Table[f[t,x],{x,nsym}]

f[t_,i_,j_]:=freq[t][[index[[i,j]]]]

freq[1]

freq[2]

freq[2] // ColumnForm

freq[3];

freq[4];

freq[4] /. {r[1] ->  .1, r[2] ->  .2} // ColumnForm

freq[5];

freq[6];

Save["freq_3loc.sve", freq]