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.

Backcross

Initialization

ClearAll["Global`*"];

Number of loci

n=3

Genotype of the  parents

Recipient parent (non recurrent)

a={1,1}

Recurrent parent

b={8,8}

General definitions

<<"definitions.ma"

a1=a[[1]];a2=a[[2]]

b1=b[[1]];b2=b[[2]]

A=Union[Map[g,gamprod[a[[1]],a[[2]]]]];
na=Length[A]

B=Union[Map[g,gamprod[b1,b2]]];
nb=Length[B]

Initial genotype frequencies

ulist=Sort[Union[Map[Sort,
Flatten[Outer[List,Table[i,{i,ngam}],b],1],{1}]]]

nsym=Length[ulist]

Clear[index];
index=Table["+",{ngam},{ngam}];
Do[index[[ulist[[i,1]],ulist[[i,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]

Vector of all initial frequencies below:

freq[1]=Apply[
P[a1,a2][[#1]]*P[b1,b2][[#2]]+
delta[#1,#2]*P[a1,a2][[#2]]*P[b1,b2][[#1]]
&,ulist,{1}]//Simplify

Tables

Recursion

Definitions

tabf=Flatten[Table[zf[t,i,B[[j]]],{i,1,ngam},{j,1,nb}]]

Format[zf[t_,x_,y_]]:=Subscripted[f[x,y]][t];
Format[zf[t_,x_,y_],TeXForm]:=Subscripted[f[x,y]][t];
Format[zf[t,x_,y_],TeXForm]:=Subscripted[f[x,y]]

genrec[x_,y_]:=Sum[
(P[i,B[[j]]][[x]]*P[b1,b2][[y]]+
delta[x,y]*P[i,B[[j]]][[y]]*P[b1,b2][[x]])*
zf[t,Min[i,B[[j]]],Max[i,B[[j]]]],
{i,1,ngam},{j,1,nb}]//Together

ligne[x_,y_]:=
Reduce[
{genrec[x,y]==xxx,
Sum[zf[t,i,y],{i,1,ngam}]==1}
][[1,2]]

Visual output

Flatten[Table[{
ToString[Subscripted[f[x,B[[y]]]]["t+1"]],
"=",
1/Denominator[ligne[x,B[[y]]]]*
Simplify[Collect[Numerator[ligne[x,B[[y]]] ],tabf]
]},
{x,1,ngam},{y,1,nb}],1]//.rulers//TableForm

TeX output

tabtex=Flatten[Table[{
zf["t+1",x,B[[y]]],
"=",
"\\frac{1}{"<>ToString[Denominator[ligne[x,B[[y]]]]]<>"}"*
Simplify[Collect[Numerator[ligne[x,B[[y]]] ],tabf]
]},
{x,1,ngam},{y,1,nb}],1]//.rulers//TableForm//TeXForm

Frequencies

Definitions

f[t_,x_,y_]:=f[t,x,y]=
Sum[
(P[i,B[[j]]][[x]]*P[b1,b2][[y]]+
delta[x,y]*P[i,B[[j]]][[y]]*P[b1,b2][[x]])*
f[t-1,Min[i,B[[j]]],Max[i,B[[j]]]],{i,1,ngam},{j,1,nb}]

Initialization

Do[f[1,Min[x,B[[y]]],Max[x,B[[y]]]]=
P[a1,a2][[x]]*P[b1,b2][[B[[y]]]]+
delta[x,B[[y]]]*P[a1,a2][[B[[y]]]]*P[b1,b2][[x]],
{x,1,ngam},{y,1,nb}]

Output

f[3,3,8]//Simplify

Numerator[Simplify[f[3,4,8]]]//Factor

rulers

(f[3,8,8]//Cancel)//.rulers//Simplify

Table[
Cancel[f[3,x,B[[y]]]],
{x,1,ngam},{y,1,nb}]//.rulers//Simplify//ColumnForm

TeX output

freq23s=Flatten[Table[
{zf["t",x,B[[y]]],
Simplify[f[2,x,B[[y]]]],
Simplify[f[3,x,B[[y]]]]},
{x,1,ngam},{y,1,nb}],1]//.rulers

freq23c=Flatten[Table[
{zf["t",x,B[[y]]],
Simplify[f[2,x,B[[y]]]],
Cancel[f[3,x,B[[y]]]]},
{x,1,ngam},{y,1,nb}],1]//.rulers//Simplify