MAM

Haploid Host/Haploid Parasite

Fitness Functions:

Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
Host genotypes: 0 = a, 1=A

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

(Subscript[w, i,j]) is the fitness genotype i in is j of species the  (Subscript[w, i,j])

wmat=(1+(({{(Subscript[α, p]), -(Subscript[β, p])}, {-(Subscript[β, p]), (Subscript[α, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])}};

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, m]),1], 
j==1,total[(Subscript[f, M]),1],
j==2,total[(Subscript[f, m]),2],
j==3,total[(Subscript[f, M]),2]];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= If[j==0, 1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,0])+(Subscript[f, M])*(Subscript[x, p,1])), 1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,2])+(Subscript[f, M])*(Subscript[x, p,3]))];

(Subscript[(OverBar[w]), h])=(∑_(j=0)^1)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^3)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

(Subscript[(OverBar[w]), i]) is the mean fitness of species i
(Subscript[x, i,j]) is frequency of genotype j in species i

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.

(Subscript[n2x, p,j_])=If[j==1||j==2,
(Subscript[n1x, p,j])+ (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2])),
(Subscript[n1x, p,j])- (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2]))
];
(Subscript[n2x, h,j_])=(Subscript[n1x, h,j]);

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the MAM model.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[c, p2])->(Subscript[cn, p2])/.(Subscript[c, p1])->(Subscript[cn, p1])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the GFG model.

Change of variables

The new variables are defined by: (Subscript[δ, i])=((Subscript[x, i,2])+(Subscript[x, i,3]))-1/2
(Subscript[p, M])=(Subscript[x, i,1])+(Subscript[x, i,3])
(Subscript[D, i])=(Subscript[x, i,0])(Subscript[x, i,3])-(Subscript[x, i,1])(Subscript[x, i,2])which translates into:

changeOfVarHOST=Solve[{(Subscript[δ, h])==(Subscript[x, h,1])-1/2,(Subscript[x, h,0])+(Subscript[x, h,1])==1},{(Subscript[x, h,0]),(Subscript[x, h,1])}]//Simplify//Flatten
changeOfVarPARASITE=Solve[{(Subscript[δ, p])==((Subscript[x, p,2])+(Subscript[x, p,3]))-1/2,(Subscript[p, M])==(Subscript[x, p,1])+(Subscript[x, p,3]),(Subscript[D, p])==(Subscript[x, p,0])(Subscript[x, p,3])-(Subscript[x, p,1])(Subscript[x, p,2]),(Subscript[x, p,0])+(Subscript[x, p,1])+(Subscript[x, p,2])+(Subscript[x, p,3])==1},{(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3])}]//Simplify//Flatten

changeOfVarHOST2=Solve[{(Subscript[δ, h])==(Subscript[n2x, h,1])-1/2,(Subscript[n2x, h,0])+(Subscript[n2x, h,1])==1},{(Subscript[δ, h])}]//Simplify//Flatten
changeOfVarPARASITE2=Solve[{(Subscript[δ, p])==((Subscript[n2x, p,2])+(Subscript[n2x, p,3]))-1/2,(Subscript[p, M])==(Subscript[n2x, p,1])+(Subscript[n2x, p,3]),(Subscript[D, p])==(Subscript[n2x, p,0])(Subscript[n2x, p,3])-(Subscript[n2x, p,1])(Subscript[n2x, p,2]),(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])==1},{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}]//Simplify//Flatten

oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h])}];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE];
changeOverOneGenP=Map[oneGenChangeP,{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}];

Analysis of recursions

subsmall0={(Subscript[D, p])->d+(Subscript[D, p])};

Order assumptions are also included in the following substitution:

subsmall=Function[a,{(Subscript[D, p])->(Subscript[D, p])*(ϵ^a),(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M]) ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={d->0};

eqn1=subAndSeriesP[1,toorder]
eqn2=subAndSeriesP[2,toorder]
eqn3=subAndSeriesP[3,toorder]
Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

Kept order  ϵ  terms in the associations

toorder = 1;

qlesoln={(Subscript[D, p])->0};
suba={d->(Subscript[D, p])}/.qlesoln;

eqn1=subAndSeriesP[1,toorder]
eqn2=subAndSeriesP[2,toorder]
eqn3=subAndSeriesP[3,toorder]
Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=(1/2) (-1+(Subscript[p, M])) (Subscript[p, M]) (2 (Subscript[s, fl])+(Subscript[β, p]) (1-4 (Subscript[δ, h]) (Subscript[δ, p]))-(Subscript[α, p]) (1+4 (Subscript[δ, h]) (Subscript[δ, p]))) (Subscript[Δ, M]);

Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
Host genotypes: 0 = a, 1=A

(Subscript[w, m])=((Subscript[w, p,0])*(Subscript[x, p,0])+(Subscript[w, p,2])*(Subscript[x, p,2]))/((Subscript[x, p,0])+(Subscript[x, p,2]));
(Subscript[w, M])=((Subscript[w, p,1])*(Subscript[x, p,1])+(Subscript[w, p,3])*(Subscript[x, p,3]))/((Subscript[x, p,1])+(Subscript[x, p,3]));

qlesoln={(Subscript[D, p])->0};
orderAssumptions={(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M]) ϵ,(Subscript[δ, h])->(Subscript[δ, h]),(Subscript[δ, p])->(Subscript[δ, p]),(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ};

Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.changeOfVarPARASITE/.changeOfVarHOST/.qlesoln/.orderAssumptions,{ϵ,0,toorder+1}]]/.ϵ->1//Simplify

So our invasion term to put in ms (Table 2) is
(((Subscript[α, p])-(Subscript[β, p]) )/2)+((Subscript[α, p])+(Subscript[β, p]) )(2 (Subscript[δ, h]) (Subscript[δ, p])))

Old recursion analysis

Analysis of the (Subscript[D, i]) recurrences (Part 1):

(Subscript[nextD, p])=(Subscript[n2x, p,0])(Subscript[n2x, p,3])-(Subscript[n2x, p,1])(Subscript[n2x, p,2]);

(Subscript[nD, p])=(Subscript[nextD, p])/.changeOfVarHOST/.changeOfVarPARASITE//Simplify

(Subscript[changeOfVarD, p])={(Subscript[f, m])->(Subscript[f, M])-(Subscript[Δ, m]) ϵ,(Subscript[δ, h])->(Subscript[δ, h]) ϵ,(Subscript[δ, p])->(Subscript[δ, p])ϵ,(Subscript[D, p])->(Subscript[D, 0])+(Subscript[D, 1]) ϵ+(Subscript[D, 2]) (ϵ^2)+(Subscript[D, 3]) (ϵ^3)};

(Subscript[nD, p])=(Subscript[nD, p])/.(Subscript[changeOfVarD, p]);

The next sequence of steps allows one to find the required order of the disequilibrium.

Series[(Subscript[nD, p]),{ϵ,0,0}]//Simplify//Normal

Series[(Subscript[nD, p])/.(Subscript[D, 0])->0,{ϵ,0,1}]//Simplify//Normal

Series[(Subscript[nD, p])/.(Subscript[D, 0])->0/.(Subscript[D, 1])->0,{ϵ,0,2}]//Simplify//Normal
Solve[%==(Subscript[D, 2]), (Subscript[D, 2])]/.ϵ->1//Simplify//Flatten

Analysis of the (Subscript[δ, i,A]) recurrences:

(Subscript[nextδ, h])=(Subscript[n2x, h,1])-1/2;
(Subscript[nextδ, p])=(Subscript[n2x, p,2])+(Subscript[n2x, p,3])-1/2;

(Subscript[nδ, h])=(Subscript[nextδ, h])/.changeOfVarHOST/.changeOfVarPARASITE//FullSimplify
(Subscript[nδ, p])=(Subscript[nextδ, p])/.changeOfVarHOST/.changeOfVarPARASITE//FullSimplify

From the analyis of the (Subscript[D, i]) recurrences above we have:

(Subscript[changeOfVarδ, h])={{(Subscript[δ, h])->(Subscript[δ, h]) ϵ,(Subscript[δ, p])->(Subscript[δ, p]) ϵ,(Subscript[f, m])->(Subscript[f, M])-(Subscript[Δ, m]) ϵ}}//Flatten;
(Subscript[changeOfVarδ, p])={{(Subscript[D, p])-> (Subscript[D, (Subscript[2, p])])(ϵ^2),(Subscript[δ, h])->(Subscript[δ, h]) ϵ,(Subscript[δ, p])->(Subscript[δ, p]) ϵ,(Subscript[f, m])->(Subscript[f, M])-(Subscript[Δ, m]) ϵ}}//Flatten;

(Subscript[nδ, h])=(Subscript[nδ, h])/.(Subscript[changeOfVarδ, h])/.(Subscript[changeOfVarδ, p])//Simplify
(Subscript[nδ, p])=(Subscript[nδ, p])/.(Subscript[changeOfVarδ, p])/.(Subscript[changeOfVarδ, p])//Simplify

Series[(Subscript[nδ, h]),{ϵ,0,2}]//Simplify//Flatten//Normal
Series[(Subscript[nδ, p]),{ϵ,0,2}]//Simplify//Flatten//Normal

Collect[((((-2+(Subscript[f, M]) (Subscript[α, h])) (Subscript[δ, h])+(Subscript[f, M]) (Subscript[α, h]) (Subscript[δ, p])))/(-2+(Subscript[f, M]) (Subscript[α, h]))),{(Subscript[δ, h]),(Subscript[δ, p])},Simplify]
Collect[-(((2 (1+(Subscript[s, fl])) (Subscript[δ, p])+(Subscript[f, M]) ((Subscript[β, p]) ((Subscript[δ, h])-(Subscript[δ, p]))-2 (Subscript[s, fl]) (Subscript[δ, p])+(Subscript[α, p]) ((Subscript[δ, h])+(Subscript[δ, p])))))/(-2+2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) (-(Subscript[α, p])+(Subscript[β, p])))),{(Subscript[δ, h]),(Subscript[δ, p])},Simplify]

Putting the above equations into matrix form gives (({{(Subscript[δ, h])'}, {(Subscript[δ, p])'}}))=(({{1, (((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))}, {(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p])))), 1}}))(({{(Subscript[δ, h])}, {(Subscript[δ, p])}}))

FullSimplify[RSolve[{(Subscript[δ, h])[t+1]==(Subscript[δ, h])[t]+A*(Subscript[δ, p])[t],(Subscript[δ, p])[t+1]==B*(Subscript[δ, h])[t]+(Subscript[δ, p])[t],(Subscript[δ, h])[0]==0,(Subscript[δ, p])[0]==(Subscript[δ, p,0])},{(Subscript[δ, h])[t],(Subscript[δ, p])[t]},t]]

which can be simplified to
(Subscript[δ, h])[t]=((A ((((1+A B))^t)-(((1-A B))^t)))/(2 B))(Subscript[δ, p,0])
(Subscript[δ, p])[t]=(((((1+A B))^t)+(((1-A B))^t))/2) (Subscript[δ, p,0])
where
A=(Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))])and B=(Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))])

(Subscript[δ, h])[t_]=-((Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))]) ((((1-(Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))]) (Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))])))^t)-(((1+(Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))]) (Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))])))^t)) (Subscript[δ, p,0]))/(2 (Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))]));
(Subscript[δ, p])[t_]=(1/2) ((((1-(Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))]) (Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))])))^t)+(((1+(Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))]) (Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))])))^t)) (Subscript[δ, p,0]);

Plot[(Subscript[δ, h])[t]/.(Subscript[α, h])->0.1/.(Subscript[α, p])->0.1/.(Subscript[β, p])->0/.(Subscript[f, M])->0.001/.(Subscript[s, fl])->0/. (Subscript[δ, p,0])->0.01,{t,0,100000}]

Analysis of the (Subscript[D, i]) recurrences (Part 2: General Solution):

(Subscript[nextD, p])=(Subscript[n2x, p,0])(Subscript[n2x, p,3])-(Subscript[n2x, p,1])(Subscript[n2x, p,2]);

We will solve the (Subscript[D, p]) recurrence equations for a general solution

Series[(Subscript[nextD, p])/.changeOfVarHOST/.changeOfVarPARASITE/.(Subscript[f, m])->(Subscript[f, M])-(Subscript[Δ, m]) ϵ/.(Subscript[δ, h])->(Subscript[δ, h])[t-1] ϵ/.(Subscript[δ, p])->(Subscript[δ, p])[t-1] ϵ/.(Subscript[D, p])->(Subscript[D, p])[t-1](ϵ^2),{ϵ,0,2}]//Normal//FullSimplify

So we have
(Subscript[D, p])[t]=(1-(Subscript[ψ, p])) ((Subscript[D, p])[t-1]+((2 (1-(Subscript[p, M])) (Subscript[p, M]) (1+(Subscript[s, fl])) ((Subscript[α, p])+(Subscript[β, p])) (Subscript[Δ, m]) (Subscript[δ, h])[t-1])/(((2+2 (1-(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))^2)))

RSolve[{(Subscript[D, p])[t]==(1-(Subscript[ψ, p])) ((Subscript[D, p])[t-1]+((2 (1-(Subscript[p, M])) (Subscript[p, M]) (1+(Subscript[s, fl])) ((Subscript[α, p])+(Subscript[β, p])) (Subscript[Δ, m]) (Subscript[δ, h])[t-1])/(((2+2 (1-(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))^2))),(Subscript[D, p])[0]==0},(Subscript[D, p])[t],t]/.K[1]->i//Simplify

which simplifies to

(Subscript[D, p])[t]=((2(((1-(Subscript[ψ, p])))^t)(1-(Subscript[p, M])) (Subscript[p, M]) (1+(Subscript[s, fl])) ((Subscript[α, p])+(Subscript[β, p])) (Subscript[Δ, m]) )/(((2+2 (1-(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))^2))(∑_(i=0)^(t-1))(((1-(Subscript[ψ, p])))^(-i)) (Subscript[δ, h])[i]

Analysis of the (Subscript[f, M]) recurrences:

(Subscript[nextf, M])=(Subscript[n2x, p,1])+(Subscript[n2x, p,3]);

(Subscript[nf, M])=(Subscript[nextf, M])/.changeOfVarHOST/.changeOfVarPARASITE//FullSimplify

(Subscript[Δf, M])=(4 (Subscript[D, p]) (Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])) (Subscript[δ, h])+(Subscript[p, M]) (2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p])+4 ((Subscript[α, p])+(Subscript[β, p])) (Subscript[δ, h]) (Subscript[δ, p]))))/(2+2 (1+(Subscript[f, m]) (-1+(Subscript[p, M]))-(Subscript[f, M]) (Subscript[p, M])) (Subscript[s, fl])+(Subscript[f, m]) ((Subscript[α, p]) (1-(Subscript[p, M])-4 (Subscript[D, p]) (Subscript[δ, h])-4 (-1+(Subscript[p, M])) (Subscript[δ, h]) (Subscript[δ, p]))+(Subscript[β, p]) (-1+(Subscript[p, M])-4 (Subscript[D, p]) (Subscript[δ, h])-4 (-1+(Subscript[p, M])) (Subscript[δ, h]) (Subscript[δ, p])))+(Subscript[f, M]) (4 (Subscript[D, p]) ((Subscript[α, p])+(Subscript[β, p])) (Subscript[δ, h])+(Subscript[p, M]) ((Subscript[α, p])-(Subscript[β, p])+4 ((Subscript[α, p])+(Subscript[β, p])) (Subscript[δ, h]) (Subscript[δ, p]))))-(Subscript[p, M])/.(Subscript[f, m])->(Subscript[f, M])-(Subscript[Δ, m]) ϵ/.(Subscript[δ, h])->(Subscript[δ, h])[t-1] ϵ/.(Subscript[δ, p])->(Subscript[δ, p])[t-1] ϵ/.(Subscript[D, p])->(Subscript[D, p])[t-1](ϵ^2)//FullSimplify

From the above analysese we have:

(Subscript[D, p])[t_]=((2(((1-(Subscript[ψ, p])))^(t-1))(1-(Subscript[p, M])) (Subscript[p, M]) (1+(Subscript[s, fl])) ((Subscript[α, p])+(Subscript[β, p])) (Subscript[Δ, m]) (1-(Subscript[ψ, p])) )/(((2+2 (1-(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))^2))(∑_(i=0)^(t-1))(((1-(Subscript[ψ, p])))^(-i)) (Subscript[δ, h])[i]
(Subscript[δ, h])[t_]=-((Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))]) ((((1-(Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))]) (Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))])))^t)-(((1+(Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))]) (Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))])))^t)) (Subscript[δ, p,0]))/(2 (Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))]));
(Subscript[δ, p])[t_]=(1/2) ((((1-(Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))]) (Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))])))^t)+(((1+(Sqrt[(((Subscript[f, M])(Subscript[α, h]))/((Subscript[f, M])(Subscript[α, h])-2))]) (Sqrt[(((Subscript[f, M]) ((Subscript[α, p])+(Subscript[β, p])))/(2-2 (-1+(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))])))^t)) (Subscript[δ, p,0]);

fullP1=Series[(Subscript[Δf, M]),{ϵ,0,1}]//Normal//Simplify

And thus the modifier is selected for when the following is positive
(((1-(Subscript[p, M])) (Subscript[p, M]) (2 (Subscript[s, fl])+(Subscript[β, p])-(Subscript[α, p])) (Subscript[Δ, m]))/((Subscript[f, M]) ((Subscript[β, p])-(Subscript[α, p]))-2-2 (1-(Subscript[f, M])) (Subscript[s, fl])))
which is positive whenever
(((2 (Subscript[s, fl])+(Subscript[β, p])-(Subscript[α, p])) (Subscript[Δ, m]))/((Subscript[f, M]) ((Subscript[β, p])-(Subscript[α, p]))-2-2 (1-(Subscript[f, M])) (Subscript[s, fl])))
is positive. Note that (Subscript[Δ, m])>0 implies that the M allele increases the time spent as a parasite, compared to m  (that is (Subscript[f, M])>(Subscript[f, m]))

(((2 (Subscript[s, fl])-(Subscript[α, p])+(Subscript[β, p])) (Subscript[Δ, m]))/(2+2 (1-(Subscript[f, M])) (Subscript[s, fl])+(Subscript[f, M]) ((Subscript[α, p])-(Subscript[β, p]))))/.(Subscript[s, fl])->0

Haploid Host/Diploid Parasite

Fitness Functions:

Host genotypes: 0 = a, 1=A
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes: 0 = am, 1=aM, 2=Am, 3=AM
(Subscript[x, i,j]) is frequency of genotype j in species i

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

wmat=(1+(({{(Subscript[α, p]), -(Subscript[β, p])}, {-(Subscript[β, p]), -(Subscript[β, p])}, {-(Subscript[β, p]), (Subscript[α, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])}};

(Subscript[w, i,j]) is the fitness of genotype j in species i

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, mm]),1], 
j==1,total[(Subscript[f, Mm]),1],
j==2,total[(Subscript[f, MM]),1],
j==3,total[(Subscript[f, mm]),2],
j==4,total[(Subscript[f, Mm]),2],
j==5,total[(Subscript[f, Mm]),2],
j==6,total[(Subscript[f, MM]),2],
j==7,total[(Subscript[f, mm]),3],
j==8,total[(Subscript[f, Mm]),3],
j==9,total[(Subscript[f, MM]),3]];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= If[j==0, 1-(Subscript[α, h])((Subscript[f, mm])(Subscript[x, p,0])+(Subscript[f, Mm])(Subscript[x, p,1])+(Subscript[f, MM])(Subscript[x, p,2])), 1-(Subscript[α, h])((Subscript[f, mm])(Subscript[x, p,7])+(Subscript[f, Mm])(Subscript[x, p,8])+(Subscript[f, MM])(Subscript[x, p,9]))];

(Subscript[(OverBar[w]), i]) is the mean fitness of species i

(Subscript[(OverBar[w]), h])=(∑_(j=0)^1)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^9)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.
Host genotypes : 0 = aa, 1 = Aa, 2 = AA
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes : 0 = am, 1 = aM, 2 = Am, 3 = AM

Hosts

(Subscript[n2x, h,j_])=(Subscript[n1x, h,j]);

Parasites

rMatrix={
{1,0,0,0},
{(1/2),(1/2),0,0},
{0,1,0,0},
{(1/2),0,(1/2),0},
{((1-r)/2),(r/2),(r/2),((1-r)/2)},
{(r/2),((1-r)/2),((1-r)/2),(r/2)},
{0,(1/2),0,(1/2)},
{0,0,1,0},
{0,0,(1/2),(1/2)},
{0,0,0,1}};

PGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, p,0])},{(Subscript[n1x, p,1])},{(Subscript[n1x, p,2])},{(Subscript[n1x, p,3])},{(Subscript[n1x, p,4])},{(Subscript[n1x, p,5])},{(Subscript[n1x, p,6])},{(Subscript[n1x, p,7])},{(Subscript[n1x, p,8])},{(Subscript[n1x, p,9])}}]).rMatrix];
gamete[j_]=Which[
j==0, PGameteFreqs[[1]],
j==1,PGameteFreqs[[2]],
j==2, PGameteFreqs[[3]],
j==3, PGameteFreqs[[4]]
];

am=0;aM=1;Am=2;AM=3;
(Subscript[n2x, p,j_])=Which[
j==0,(1-(Subscript[ψ, p])) (Subscript[n1x, p,0])+(Subscript[ψ, p]) gamete[am].gamete[am], 
j==1,(1-(Subscript[ψ, p])) (Subscript[n1x, p,1])+(Subscript[ψ, p]) 2 gamete[aM].gamete[am],
j==2,(1-(Subscript[ψ, p])) (Subscript[n1x, p,2])+(Subscript[ψ, p]) gamete[aM].gamete[aM],
j==3,(1-(Subscript[ψ, p])) (Subscript[n1x, p,3])+(Subscript[ψ, p]) 2 gamete[Am].gamete[am],
j==4,(1-(Subscript[ψ, p])) (Subscript[n1x, p,4])+(Subscript[ψ, p]) 2 gamete[AM].gamete[am],
j==5,(1-(Subscript[ψ, p])) (Subscript[n1x, p,5])+(Subscript[ψ, p]) 2 gamete[Am].gamete[aM],
j==6,(1-(Subscript[ψ, p])) (Subscript[n1x, p,6])+(Subscript[ψ, p]) 2 gamete[AM].gamete[aM],
j==7,(1-(Subscript[ψ, p])) (Subscript[n1x, p,7])+(Subscript[ψ, p]) gamete[Am].gamete[Am],
j==8,(1-(Subscript[ψ, p])) (Subscript[n1x, p,8])+(Subscript[ψ, p]) 2 gamete[AM].gamete[Am],
j==9,(1-(Subscript[ψ, p])) (Subscript[n1x, p,9])+(Subscript[ψ, p]) gamete[AM].gamete[AM]
];

Check that things sum to 1 as they should:
(Subscript[n2x, h,0])+(Subscript[n2x, h,1])//Simplify
(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])+(Subscript[n2x, p,4])+(Subscript[n2x, p,5])+(Subscript[n2x, p,6])+(Subscript[n2x, p,7])+(Subscript[n2x, p,8])+(Subscript[n2x, p,9])//Simplify

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the MAM model.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[c, p2])->(Subscript[cn, p2])/.(Subscript[c, p1])->(Subscript[cn, p1])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the GFG model.

Change of variables

Host genotypes: 0 = a, 1=A
Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM
Parasite genotypes: x44=0 = aamm, 2 x24 = 1 = aaMm, x22 = 2 = aaMM, 2 x34 = 3 = Aamm, 2 x14 = 4 = AaMm, 2 x23 = 5 = AamM, 2 x12=6 = AaMM, 2 x33=7 = AAmm, 2 x13=8 = AAMm, x11=9 = AAMM
Parasite haplotypes: 0 = am, 1 = aM, 2 = Am, 3 = AM

changeOfVarHOST=Solve[{(Subscript[δ, h])==(Subscript[x, h,1])-1/2,(Subscript[x, h,0])+(Subscript[x, h,1])==1},{(Subscript[x, h,0]),(Subscript[x, h,1])}]//Simplify//Flatten;
changeOfVarHOST2=Solve[{(Subscript[δ, h])==(Subscript[n2x, h,1])-1/2,(Subscript[n2x, h,0])+(Subscript[n2x, h,1])==1},{(Subscript[δ, h])}]//Simplify//Flatten;
oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h])}];

DtoX=Function[{a,b,c,d,e,f,g,h,i,j},
Block[{pA1=((d/2)+(e/2)+(f/2)+(g/2)+h+i+j),pM1=((b/2)+c+(e/2)+(f/2)+g+(i/2)+j)},
{1->a+b+c+d+e+f+g+h+i+j,
pA->(d/2)+(e/2)+(f/2)+(g/2)+h+i+j,
pM->(b/2)+c+(e/2)+(f/2)+g+(i/2)+j,
FA->(h+(i/2)) (((1-pA1))^2)+((i/2)+j) (((1-pA1))^2)-((d/2)+(e/2)) (1-pA1) pA1-((d/2)+(f/2)) (1-pA1) pA1-((e/2)+(g/2)) (1-pA1) pA1-((f/2)+(g/2)) (1-pA1) pA1+(a+(b/2)) (((pA1))^2)+((b/2)+c) (pA1^2),
FM->(c+(g/2)) (((1-pM1))^2)+((g/2)+j) (((1-pM1))^2)-((b/2)+(e/2)) (1-pM1) pM1-((b/2)+(f/2)) (1-pM1) pM1-((e/2)+(i/2)) (1-pM1) pM1-((f/2)+(i/2)) (1-pM1) pM1+(a+(d/2)) (pM1^2)+((d/2)+h) (pM1^2),
cijcij->j (((1-pA1))^2) (((1-pM1))^2)-g (1-pA1) pA1 (((1-pM1))^2)+c (pA1^2) (((1-pM1))^2)-i (((1-pA1))^2) (1-pM1) pM1+e (1-pA1) pA1 (1-pM1) pM1+f (1-pA1) pA1 (1-pM1) pM1-b (pA1^2) (1-pM1) pM1+h (((1-pA1))^2) (pM1^2)-d (1-pA1) pA1 (pM1^2)+a (pA1^2) (pM1^2),
cijci->((g/2)+j) (1-pA1) (((1-pM1))^2)-(c+(g/2)) pA1 (((1-pM1))^2)-((e/2)+(i/2)) (1-pA1) (1-pM1) pM1-((f/2)+(i/2)) (1-pA1) (1-pM1) pM1+((b/2)+(e/2)) pA1 (1-pM1) pM1+((b/2)+(f/2)) pA1 (1-pM1) pM1+((d/2)+h) (1-pA1) (pM1^2)-(a+(d/2)) pA1 (pM1^2),
cijcj->((i/2)+j) (((1-pA1))^2) (1-pM1)-((e/2)+(g/2)) (1-pA1) pA1 (1-pM1)-((f/2)+(g/2)) (1-pA1) pA1 (1-pM1)+((b/2)+c) (pA1^2) (1-pM1)-(h+(i/2)) (((1-pA1))^2) pM1+((d/2)+(e/2)) (1-pA1) pA1 pM1+((d/2)+(f/2)) (1-pA1) pA1 pM1-(a+(b/2)) (pA1^2) pM1,
cicj->((f/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(e/2)+(g/2)) pA1 (1-pM1)-((d/2)+(e/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(f/2)) pA1 pM1,
cij->((e/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(f/2)+(g/2)) pA1 (1-pM1)-((d/2)+(f/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(e/2)) pA1 pM1}]];

XtoD=Function[{a,b,c,d,e,f,g,h,i,j},
{a->1-2 cijci+cijcij-2 cijcj+FA+FM-2 pA+2 cijci pA-2 FM pA+(pA^2)+FM (pA^2)+2 cicj (-1+pA) (-1+pM)+2 cij (-1+pA) (-1+pM)-2 pM+2 cijcj pM-2 FA pM+4 pA pM-2 (pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
b->-2 (-2 cijci+cijcij-cijcj+FM+2 cijci pA-2 FM pA+FM (pA^2)-pM+2 cijcj pM-FA pM+2 pA pM-(pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2)+cicj (-1+pA) (-1+2 pM)+cij (-1+pA) (-1+2 pM)),
c->cijcij+FM+2 cijci (-1+pA)-2 FM pA+FM (pA^2)-2 cicj pM-2 cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
d->-2 (-cijci+cijcij-2 cijcj+FA-pA+2 cijci pA-FM pA+(pA^2)+FM (pA^2)+cicj (-1+2 pA) (-1+pM)+cij (-1+2 pA) (-1+pM)+2 cijcj pM-2 FA pM+2 pA pM-2 (pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
e->2 (cijcij-cijcj-cicj pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM+2 cijcj pM-FA pM+pA pM+2 cicj pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cij (1-pM+pA (-1+2 pM))),
f->2 (cijcij-cijcj-cij pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cij pM+2 cijcj pM-FA pM+pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cicj (1-pM+pA (-1+2 pM))),
g->-2 (cijcij-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM-cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
h->cijcij+FA-2 cicj pA-2 cij pA+2 cijci pA+(pA^2)+FM (pA^2)+2 cijcj (-1+pM)-2 FA pM+2 cicj pA pM+2 cij pA pM-2 (pA^2) pM+FA (pM^2)+(pA^2) (pM^2),
i->-2 (cijcij-cicj pA-cij pA+2 cijci pA+FM (pA^2)-FA pM+2 cicj pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)+(pA^2) (pM^2)+cijcj (-1+2 pM)),
j->cijcij+2 cijci pA+FM (pA^2)+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)+(pA^2) (pM^2)}];

currGen={(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3]),(Subscript[x, p,4]),(Subscript[x, p,5]),(Subscript[x, p,6]),(Subscript[x, p,7]),(Subscript[x, p,8]),(Subscript[x, p,9])};
nextGen={(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3]),(Subscript[n2x, p,4]),(Subscript[n2x, p,5]),(Subscript[n2x, p,6]),(Subscript[n2x, p,7]),(Subscript[n2x, p,8]),(Subscript[n2x, p,9])};

changeOfVarPARASITE=Apply[XtoD,currGen];
changeOfVarPARASITE2=Apply[DtoX,nextGen];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])];
changeOverOneGenP=Map[oneGenChangeP,{pA,pM,FA,FM,cij,cicj,cijcj,cijci,cijcij}];

Analysis of recursions

Order assumptions are also included in the following substitution:

subsmall0={FA->a3+FA,FM->a4+FM,cij->a5+cij,cicj->a6+cicj,cijcj->a7+cijcj,cijci->a8+cijci,cijcij->a9+cijcij};

subsmall=Function[a,{FA->FA*(ϵ^a),FM->FM*(ϵ^a),cij->cij*(ϵ^a),cicj->cicj*(ϵ^a),cijcj->cijcj*(ϵ^a),cijci->cijci*(ϵ^a),cijcij->cijcij*(ϵ^a),(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={a3->0,a4->0,a5->0,a6->0,a7->0,a8->0,a9->0};

eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]

Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Simplify//Flatten

qlesoln={FA->0,FM->0,cijcj->0,cijci->0,cijcij->0,cicj->0,cij->0};

Kept order  ϵ  terms in the associations

toorder=1;

qlesoln={FA->0,FM->0,cijcj->0,cijci->0,cijcij->0,cicj->0,cij->0};
suba={a3->FA,a4->FM,a5->cij,a6->cicj,a7->cijcj,a8->cijci,a9->cijcij}/.qlesoln;

eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]

Solve[eqn3==0,FA]//Flatten//Simplify

qlesoln =Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Flatten//Simplify

qlesoln={FA->(Subscript[F, A,P]),FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=-(1/4) (-1+pM) pM ((-1+2 pM) (Subscript[Δ, Mm])-pM (Subscript[Δ, MM])) (4 (Subscript[s, fl])-(Subscript[β, p]) (-3+8 (Subscript[δ, h]) (Subscript[δ, p])+4 (Subscript[δ, p]^2)+4 (Subscript[F, A,P]))-(Subscript[α, p]) (1+8 (Subscript[δ, h]) (Subscript[δ, p])+4 (Subscript[δ, p]^2)+4 (Subscript[F, A,P])));

Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM

(Subscript[w, mm])=(fit[0]*(Subscript[x, p,0])+fit[3]*(Subscript[x, p,3])+fit[7]*(Subscript[x, p,7]))/((Subscript[x, p,0])+(Subscript[x, p,3])+(Subscript[x, p,7]));
(Subscript[w, Mm])=(fit[1]*(Subscript[x, p,1])+fit[4]*(Subscript[x, p,4])+fit[5]*(Subscript[x, p,5])+fit[8]*(Subscript[x, p,8]))/((Subscript[x, p,1])+(Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]));
(Subscript[w, MM])=(fit[2]*(Subscript[x, p,2])+fit[6]*(Subscript[x, p,6])+fit[9]*(Subscript[x, p,9]))/((Subscript[x, p,2])+(Subscript[x, p,6])+(Subscript[x, p,9]));

(Subscript[x, M])=((Subscript[x, p,1])/2)+(Subscript[x, p,2])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,6])+((Subscript[x, p,8])/2)+(Subscript[x, p,9]);
(Subscript[x, m])=(Subscript[x, p,0])+((Subscript[x, p,1])/2)+(Subscript[x, p,3])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,7])+((Subscript[x, p,8])/2);

(Subscript[w, M])=(Subscript[x, M]) (Subscript[w, MM])+(Subscript[x, m]) (Subscript[w, Mm]);
(Subscript[w, m])=(Subscript[x, M]) (Subscript[w, Mm])+(Subscript[x, m]) (Subscript[w, mm]);

qlesoln={FA->(Subscript[F, A,p]),FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};
orderAssumptions={(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ};

Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.Apply[XtoD,currGen]/.changeOfVarHOST/.qlesoln/.{pA->(Subscript[δ, p])+1/2,(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) ,(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])}/.orderAssumptions,{ϵ,0,2}]]/.ϵ->1//Simplify

So our invasion term to put in ms (Table 2) is
(((Subscript[α, p])-3(Subscript[β, p]))/4) +((Subscript[α, p])+(Subscript[β, p]))(2 (Subscript[δ, h]) (Subscript[δ, p])+(Subscript[δ, p]^2))
And with  (Subscript[F, A,p])
(((Subscript[α, p])-3(Subscript[β, p]))/4) +((Subscript[α, p])+(Subscript[β, p]))(2 (Subscript[δ, h]) (Subscript[δ, p])+(Subscript[δ, p]^2)+(Subscript[F, A,p]))
Where (Subscript[F, A,p])=(Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p])) (((1/4-(Subscript[δ, p]^2)))^2) (1-(Subscript[ψ, p]))/(Subscript[ψ, p])

Diploid Host/Haploid Parasite

Fitness Functions:

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
(Subscript[x, i,j]) is frequency of genotype j in species i

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

wmat=(1+(({{(Subscript[α, p]), (Subscript[α, p]), -(Subscript[β, p])}, {-(Subscript[β, p]), (Subscript[α, p]), (Subscript[α, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])},{(Subscript[x, h,2])}};

(Subscript[w, i,j]) is the fitness of genotype j in species i

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, m]),1], 
j==1,total[(Subscript[f, M]),1],
j==2,total[(Subscript[f, m]),2],
j==3,total[(Subscript[f, M]),2]];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= Which[
j==0,1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,0])+(Subscript[f, M])*(Subscript[x, p,1])),
j==1,1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,0])+(Subscript[f, M])*(Subscript[x, p,1])+(Subscript[f, m])*(Subscript[x, p,2])+(Subscript[f, M])*(Subscript[x, p,3])),
j==2,1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,2])+(Subscript[f, M])*(Subscript[x, p,3]))];

(Subscript[(OverBar[w]), i]) is the mean fitness of species i

(Subscript[(OverBar[w]), h])=(∑_(j=0)^2)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^3)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.
Host genotypes : 0 = aa, 1 = Aa, 2 = AA
Parasite genotypes : 0 = am, 1 = aM, 2 = Am, 3 = AM

Hosts

HGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, h,0])},{(Subscript[n1x, h,1])},{(Subscript[n1x, h,2])}}]).{{1,0},{(1/2),(1/2)},{0,1}}]//Flatten;
(Subscript[n2x, h,j_])=Which[
j==0,(1-(Subscript[ψ, h])) (Subscript[n1x, h,0])+(Subscript[ψ, h]) HGameteFreqs[[1]]*HGameteFreqs[[1]],
j==1,(1-(Subscript[ψ, h])) (Subscript[n1x, h,1])+(Subscript[ψ, h]) 2*HGameteFreqs[[1]]*HGameteFreqs[[2]],
j==2,(1-(Subscript[ψ, h])) (Subscript[n1x, h,2])+(Subscript[ψ, h]) HGameteFreqs[[2]]*HGameteFreqs[[2]]
];

Parasites

(Subscript[n2x, p,j_])=If[j==1||j==2,
(Subscript[n1x, p,j])+ (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2])),
(Subscript[n1x, p,j])- (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2]))
];

Check that things sum to 1 as they should:
(Subscript[n2x, h,0])+(Subscript[n2x, h,1])+(Subscript[n2x, h,2])//Simplify
(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])//Simplify

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the MAM model.

Change of variables

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = am, 1 = aM, 2 = Am, 3 = AM

changeOfVarHOST=Solve[
{(Subscript[δ, h])==((Subscript[x, h,2])+((Subscript[x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[x, h,0])+((Subscript[x, h,1])/2))(((Subscript[x, h,1])/2)+(Subscript[x, h,2]))-(Subscript[x, h,1]))/2,(∑_(j=0)^2)(Subscript[x, h,j])==1},{(Subscript[x, h,0]),(Subscript[x, h,1]),(Subscript[x, h,2])}]//Simplify//Flatten
changeOfVarPARASITE=Solve[{(Subscript[δ, p])==((Subscript[x, p,2])+(Subscript[x, p,3]))-1/2,(Subscript[p, M])==(Subscript[x, p,1])+(Subscript[x, p,3]),(Subscript[D, p])==(Subscript[x, p,0])(Subscript[x, p,3])-(Subscript[x, p,1])(Subscript[x, p,2]),(Subscript[x, p,0])+(Subscript[x, p,1])+(Subscript[x, p,2])+(Subscript[x, p,3])==1},{(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3])}]//Simplify//Flatten

changeOfVarHOST2=Solve[{(Subscript[δ, h])==((Subscript[n2x, h,2])+((Subscript[n2x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[n2x, h,0])+((Subscript[n2x, h,1])/2))(((Subscript[n2x, h,1])/2)+(Subscript[n2x, h,2]))-(Subscript[n2x, h,1]))/2,(∑_(j=0)^2)(Subscript[n2x, h,j])==1},{(Subscript[δ, h]),(Subscript[F, A,h])}]//Simplify//Flatten
changeOfVarPARASITE2=Solve[{(Subscript[δ, p])==((Subscript[n2x, p,2])+(Subscript[n2x, p,3]))-1/2,(Subscript[p, M])==(Subscript[n2x, p,1])+(Subscript[n2x, p,3]),(Subscript[D, p])==(Subscript[n2x, p,0])(Subscript[n2x, p,3])-(Subscript[n2x, p,1])(Subscript[n2x, p,2]),(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])==1},{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}]//Simplify//Flatten

oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h]),(Subscript[F, A,h])}];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE];
changeOverOneGenP=Map[oneGenChangeP,{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}];

Analysis of recursions

subsmall0={(Subscript[F, A,h])->FAh+(Subscript[F, A,h]),(Subscript[D, p])->d+(Subscript[D, p])};

Order assumptions are also included in the following substitution:

subsmall=Function[a,{(Subscript[F, A,h])->(Subscript[F, A,h])*(ϵ^a),(Subscript[D, p])->(Subscript[D, p])*(ϵ^a),(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M])ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={d->0,FAh->0};

eqn1=subAndSeriesP[1,toorder]
eqn2=subAndSeriesP[2,toorder]
eqn3=subAndSeriesP[3,toorder]
Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

eqn1=subAndSeriesH[1,toorder]
eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={(Subscript[F, A,h])->0,(Subscript[D, p])->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.qlesoln/.subsmall0/.suba/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Kept order  ϵ  terms in the associations

toorder = 1;

qlesoln={(Subscript[D, p])->0,(Subscript[F, A,h])->0};
suba={d->(Subscript[D, p]),FAh->(Subscript[F, A,h])}/.qlesoln;

eqn3=subAndSeriesP[3,toorder]
Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={(Subscript[D, p])->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=(1/4) (-1+(Subscript[p, M])) (Subscript[p, M]) (Subscript[Δ, M]) (4 (Subscript[s, fl])+(Subscript[α, p]) (-3+4 (Subscript[δ, h]^2)-8 (Subscript[δ, h]) (Subscript[δ, p])+4 (Subscript[F, A,h]))+(Subscript[β, p]) (1+4 (Subscript[δ, h]^2)-8 (Subscript[δ, h]) (Subscript[δ, p])+4 (Subscript[F, A,h])));

Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
Host genotypes: 0 = a, 1=A

(Subscript[w, m])=((Subscript[w, p,0])*(Subscript[x, p,0])+(Subscript[w, p,2])*(Subscript[x, p,2]))/((Subscript[x, p,0])+(Subscript[x, p,2]));
(Subscript[w, M])=((Subscript[w, p,1])*(Subscript[x, p,1])+(Subscript[w, p,3])*(Subscript[x, p,3]))/((Subscript[x, p,1])+(Subscript[x, p,3]));

qlesoln={(Subscript[D, p])->0};
orderAssumptions={(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M]) ϵ,(Subscript[δ, h])->(Subscript[δ, h]),(Subscript[δ, p])->(Subscript[δ, p]),(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ};

Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.changeOfVarPARASITE/.changeOfVarHOST/.qlesoln/.orderAssumptions,{ϵ,0,2}]]/.ϵ->1//Simplify

So our invasion term to put in ms (Table 2) is
((3(Subscript[α, p])-(Subscript[β, p]))/4)  +((Subscript[α, p])+(Subscript[β, p]))(2 (Subscript[δ, h]) (Subscript[δ, p])-(Subscript[δ, h]^2))
And with  (Subscript[F, A,h])
((3(Subscript[α, p])-(Subscript[β, p]))/4)  +((Subscript[α, p])+(Subscript[β, p]))(2 (Subscript[δ, h]) (Subscript[δ, p])-(Subscript[δ, h]^2)-(Subscript[F, A,h]))
Where (Subscript[F, A,h])=(Subscript[f, m]) (Subscript[α, h]) (((1/4-(Subscript[δ, h]^2)))^2) (1-(Subscript[ψ, h]))/(Subscript[ψ, h])

Diploid Host/Diploid Parasite

Fitness Functions:

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes: 0 = am, 1=aM, 2=Am, 3=AM
(Subscript[x, i,j]) is frequency of genotype j in species i

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

wmat=(1+(({{(Subscript[α, p]), (Subscript[α, p]), -(Subscript[β, p])}, {-(Subscript[β, p]), (Subscript[α, p]), -(Subscript[β, p])}, {-(Subscript[β, p]), (Subscript[α, p]), (Subscript[α, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])},{(Subscript[x, h,2])}};

(Subscript[w, i,j]) is the fitness of genotype j in species i

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, mm]),1], 
j==1,total[(Subscript[f, Mm]),1],
j==2,total[(Subscript[f, MM]),1],
j==3,total[(Subscript[f, mm]),2],
j==4,total[(Subscript[f, Mm]),2],
j==5,total[(Subscript[f, Mm]),2],
j==6,total[(Subscript[f, MM]),2],
j==7,total[(Subscript[f, mm]),3],
j==8,total[(Subscript[f, Mm]),3],
j==9,total[(Subscript[f, MM]),3]];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= Which[
j==0,1-(Subscript[α, h])((Subscript[f, mm])(Subscript[x, p,0])+(Subscript[f, Mm])(Subscript[x, p,1])+(Subscript[f, MM])(Subscript[x, p,2])),
j==1,1-(Subscript[α, h])((Subscript[f, mm])((Subscript[x, p,0])+(Subscript[x, p,3])+(Subscript[x, p,7]))+(Subscript[f, Mm])((Subscript[x, p,1])+(Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]))+(Subscript[f, MM])((Subscript[x, p,2])+(Subscript[x, p,6])+(Subscript[x, p,9]))),
j==2,1-(Subscript[α, h])((Subscript[f, mm])(Subscript[x, p,7])+(Subscript[f, Mm])(Subscript[x, p,8])+(Subscript[f, MM])(Subscript[x, p,9]))];

(Subscript[(OverBar[w]), i]) is the mean fitness of species i

(Subscript[(OverBar[w]), h])=(∑_(j=0)^2)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^9)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.
Host genotypes : 0 = aa, 1 = Aa, 2 = AA
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes : 0 = am, 1 = aM, 2 = Am, 3 = AM

Hosts

HGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, h,0])},{(Subscript[n1x, h,1])},{(Subscript[n1x, h,2])}}]).{{1,0},{(1/2),(1/2)},{0,1}}]//Flatten;
(Subscript[n2x, h,j_])=Which[
j==0,(1-(Subscript[ψ, h])) (Subscript[n1x, h,0])+(Subscript[ψ, h]) HGameteFreqs[[1]]*HGameteFreqs[[1]],
j==1,(1-(Subscript[ψ, h])) (Subscript[n1x, h,1])+(Subscript[ψ, h]) 2*HGameteFreqs[[1]]*HGameteFreqs[[2]],
j==2,(1-(Subscript[ψ, h])) (Subscript[n1x, h,2])+(Subscript[ψ, h]) HGameteFreqs[[2]]*HGameteFreqs[[2]]
];

Parasites

rMatrix={
{1,0,0,0},
{(1/2),(1/2),0,0},
{0,1,0,0},
{(1/2),0,(1/2),0},
{((1-r)/2),(r/2),(r/2),((1-r)/2)},
{(r/2),((1-r)/2),((1-r)/2),(r/2)},
{0,(1/2),0,(1/2)},
{0,0,1,0},
{0,0,(1/2),(1/2)},
{0,0,0,1}};

PGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, p,0])},{(Subscript[n1x, p,1])},{(Subscript[n1x, p,2])},{(Subscript[n1x, p,3])},{(Subscript[n1x, p,4])},{(Subscript[n1x, p,5])},{(Subscript[n1x, p,6])},{(Subscript[n1x, p,7])},{(Subscript[n1x, p,8])},{(Subscript[n1x, p,9])}}]).rMatrix];
gamete[j_]=Which[
j==0, PGameteFreqs[[1]],
j==1,PGameteFreqs[[2]],
j==2, PGameteFreqs[[3]],
j==3, PGameteFreqs[[4]]
];

am=0;aM=1;Am=2;AM=3;
(Subscript[n2x, p,j_])=Which[
j==0,(1-(Subscript[ψ, p])) (Subscript[n1x, p,0])+(Subscript[ψ, p]) gamete[am].gamete[am], 
j==1,(1-(Subscript[ψ, p])) (Subscript[n1x, p,1])+(Subscript[ψ, p]) 2 gamete[aM].gamete[am],
j==2,(1-(Subscript[ψ, p])) (Subscript[n1x, p,2])+(Subscript[ψ, p]) gamete[aM].gamete[aM],
j==3,(1-(Subscript[ψ, p])) (Subscript[n1x, p,3])+(Subscript[ψ, p]) 2 gamete[Am].gamete[am],
j==4,(1-(Subscript[ψ, p])) (Subscript[n1x, p,4])+(Subscript[ψ, p]) 2 gamete[AM].gamete[am],
j==5,(1-(Subscript[ψ, p])) (Subscript[n1x, p,5])+(Subscript[ψ, p]) 2 gamete[Am].gamete[aM],
j==6,(1-(Subscript[ψ, p])) (Subscript[n1x, p,6])+(Subscript[ψ, p]) 2 gamete[AM].gamete[aM],
j==7,(1-(Subscript[ψ, p])) (Subscript[n1x, p,7])+(Subscript[ψ, p]) gamete[Am].gamete[Am],
j==8,(1-(Subscript[ψ, p])) (Subscript[n1x, p,8])+(Subscript[ψ, p]) 2 gamete[AM].gamete[Am],
j==9,(1-(Subscript[ψ, p])) (Subscript[n1x, p,9])+(Subscript[ψ, p]) gamete[AM].gamete[AM]
];

Check that things sum to 1 as they should:
(Subscript[n2x, h,0])+(Subscript[n2x, h,1])+(Subscript[n2x, h,2])//Simplify
(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])+(Subscript[n2x, p,4])+(Subscript[n2x, p,5])+(Subscript[n2x, p,6])+(Subscript[n2x, p,7])+(Subscript[n2x, p,8])+(Subscript[n2x, p,9])//Simplify

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the MAM model.

Change of variables

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM
Parasite genotypes: x44=0 = aamm, 2 x24 = 1 = aaMm, x22 = 2 = aaMM, 2 x34 = 3 = Aamm, 2 x14 = 4 = AaMm, 2 x23 = 5 = AamM, 2 x12=6 = AaMM, 2 x33=7 = AAmm, 2 x13=8 = AAMm, x11=9 = AAMM
Parasite haplotypes: 0 = am, 1 = aM, 2 = Am, 3 = AM

Define new variables as: (Subscript[δ, h])=((Subscript[x, h,2])+((Subscript[x, h,1])/2))-(1/2)
(Subscript[F, A,h])==(Subscript[x, h,1])-2((Subscript[x, h,0])+((Subscript[x, h,1])/2))(((Subscript[x, h,1])/2)+(Subscript[x, h,2]))

changeOfVarHOST=Solve[
{(Subscript[δ, h])==((Subscript[x, h,2])+((Subscript[x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[x, h,0])+((Subscript[x, h,1])/2))(((Subscript[x, h,1])/2)+(Subscript[x, h,2]))-(Subscript[x, h,1]))/2,(∑_(j=0)^2)(Subscript[x, h,j])==1},{(Subscript[x, h,0]),(Subscript[x, h,1]),(Subscript[x, h,2])}]//Simplify//Flatten
changeOfVarHOST2=Solve[{(Subscript[δ, h])==((Subscript[n2x, h,2])+((Subscript[n2x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[n2x, h,0])+((Subscript[n2x, h,1])/2))(((Subscript[n2x, h,1])/2)+(Subscript[n2x, h,2]))-(Subscript[n2x, h,1]))/2,(∑_(j=0)^2)(Subscript[n2x, h,j])==1},{(Subscript[δ, h]),(Subscript[F, A,h])}]//Simplify//Flatten
oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h]),(Subscript[F, A,h])}];

Using Sally's code from Otto (2003) we can change the system of equations (for the parasites) into a new system of equations with all higher order associations, etc etc. Genotype labels in our model can be converted into those in Sally's model in the following way: {(Subscript[x, p,0])->x44,(Subscript[x, p,1])->2 x24,(Subscript[x, p,2])->x22,(Subscript[x, p,3])->2 x34,(Subscript[x, p,4])->2 x14,(Subscript[x, p,5])->2 x23,(Subscript[x, p,6])->2 x12,(Subscript[x, p,7])->x33,(Subscript[x, p,8])->2 x13,(Subscript[x, p,9])->x11}
The below functions DtoX converts from disequilbrium to genotype frequencies, and XtoD does the reverse conversion. DtoX is equivalent to 'subpD2' in Otto (2003) and XtoD is equivalent to 'subx2', except that they are written to work with our variable naming scheme.

DtoX=Function[{a,b,c,d,e,f,g,h,i,j},
Block[{pA1=((d/2)+(e/2)+(f/2)+(g/2)+h+i+j),pM1=((b/2)+c+(e/2)+(f/2)+g+(i/2)+j)},
{1->a+b+c+d+e+f+g+h+i+j,
pA->(d/2)+(e/2)+(f/2)+(g/2)+h+i+j,
pM->(b/2)+c+(e/2)+(f/2)+g+(i/2)+j,
FA->(h+(i/2)) (((1-pA1))^2)+((i/2)+j) (((1-pA1))^2)-((d/2)+(e/2)) (1-pA1) pA1-((d/2)+(f/2)) (1-pA1) pA1-((e/2)+(g/2)) (1-pA1) pA1-((f/2)+(g/2)) (1-pA1) pA1+(a+(b/2)) (((pA1))^2)+((b/2)+c) (pA1^2),
FM->(c+(g/2)) (((1-pM1))^2)+((g/2)+j) (((1-pM1))^2)-((b/2)+(e/2)) (1-pM1) pM1-((b/2)+(f/2)) (1-pM1) pM1-((e/2)+(i/2)) (1-pM1) pM1-((f/2)+(i/2)) (1-pM1) pM1+(a+(d/2)) (pM1^2)+((d/2)+h) (pM1^2),
cijcij->j (((1-pA1))^2) (((1-pM1))^2)-g (1-pA1) pA1 (((1-pM1))^2)+c (pA1^2) (((1-pM1))^2)-i (((1-pA1))^2) (1-pM1) pM1+e (1-pA1) pA1 (1-pM1) pM1+f (1-pA1) pA1 (1-pM1) pM1-b (pA1^2) (1-pM1) pM1+h (((1-pA1))^2) (pM1^2)-d (1-pA1) pA1 (pM1^2)+a (pA1^2) (pM1^2),
cijci->((g/2)+j) (1-pA1) (((1-pM1))^2)-(c+(g/2)) pA1 (((1-pM1))^2)-((e/2)+(i/2)) (1-pA1) (1-pM1) pM1-((f/2)+(i/2)) (1-pA1) (1-pM1) pM1+((b/2)+(e/2)) pA1 (1-pM1) pM1+((b/2)+(f/2)) pA1 (1-pM1) pM1+((d/2)+h) (1-pA1) (pM1^2)-(a+(d/2)) pA1 (pM1^2),
cijcj->((i/2)+j) (((1-pA1))^2) (1-pM1)-((e/2)+(g/2)) (1-pA1) pA1 (1-pM1)-((f/2)+(g/2)) (1-pA1) pA1 (1-pM1)+((b/2)+c) (pA1^2) (1-pM1)-(h+(i/2)) (((1-pA1))^2) pM1+((d/2)+(e/2)) (1-pA1) pA1 pM1+((d/2)+(f/2)) (1-pA1) pA1 pM1-(a+(b/2)) (pA1^2) pM1,
cicj->((f/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(e/2)+(g/2)) pA1 (1-pM1)-((d/2)+(e/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(f/2)) pA1 pM1,
cij->((e/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(f/2)+(g/2)) pA1 (1-pM1)-((d/2)+(f/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(e/2)) pA1 pM1}]];

XtoD=Function[{a,b,c,d,e,f,g,h,i,j},
{a->1-2 cijci+cijcij-2 cijcj+FA+FM-2 pA+2 cijci pA-2 FM pA+(pA^2)+FM (pA^2)+2 cicj (-1+pA) (-1+pM)+2 cij (-1+pA) (-1+pM)-2 pM+2 cijcj pM-2 FA pM+4 pA pM-2 (pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
b->-2 (-2 cijci+cijcij-cijcj+FM+2 cijci pA-2 FM pA+FM (pA^2)-pM+2 cijcj pM-FA pM+2 pA pM-(pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2)+cicj (-1+pA) (-1+2 pM)+cij (-1+pA) (-1+2 pM)),
c->cijcij+FM+2 cijci (-1+pA)-2 FM pA+FM (pA^2)-2 cicj pM-2 cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
d->-2 (-cijci+cijcij-2 cijcj+FA-pA+2 cijci pA-FM pA+(pA^2)+FM (pA^2)+cicj (-1+2 pA) (-1+pM)+cij (-1+2 pA) (-1+pM)+2 cijcj pM-2 FA pM+2 pA pM-2 (pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
e->2 (cijcij-cijcj-cicj pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM+2 cijcj pM-FA pM+pA pM+2 cicj pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cij (1-pM+pA (-1+2 pM))),
f->2 (cijcij-cijcj-cij pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cij pM+2 cijcj pM-FA pM+pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cicj (1-pM+pA (-1+2 pM))),
g->-2 (cijcij-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM-cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
h->cijcij+FA-2 cicj pA-2 cij pA+2 cijci pA+(pA^2)+FM (pA^2)+2 cijcj (-1+pM)-2 FA pM+2 cicj pA pM+2 cij pA pM-2 (pA^2) pM+FA (pM^2)+(pA^2) (pM^2),
i->-2 (cijcij-cicj pA-cij pA+2 cijci pA+FM (pA^2)-FA pM+2 cicj pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)+(pA^2) (pM^2)+cijcj (-1+2 pM)),
j->cijcij+2 cijci pA+FM (pA^2)+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)+(pA^2) (pM^2)}];

I can get the same thing as above from Sally's equations by doing the following, if I have the function 'subpD2' in the kernel (the first function converts a standard vector of parasite genotypes into the appropriate format to pass into Sally's functions):
convertToSallysNotation=Function[{a,b,c,d,e,f,g,h,i,j},{j,(g/2),(i/2),(e/2),c,(f/2),(b/2),h,(d/2),a}];
Apply[subpD2,convertToSallysNotation[(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3]),(Subscript[x, p,4]),(Subscript[x, p,5]),(Subscript[x, p,6]),(Subscript[x, p,7]),(Subscript[x, p,8]),(Subscript[x, p,9])]];

(*convertNotation={x44->(Subscript[x, p,0]),x24->((Subscript[x, p,1])/2),x22->(Subscript[x, p,2]),x34->((Subscript[x, p,3])/2),x14->((Subscript[x, p,4])/2),x23->((Subscript[x, p,5])/2),x12->((Subscript[x, p,6])/2),x33->(Subscript[x, p,7]),x13->((Subscript[x, p,8])/2),x11->(Subscript[x, p,9])};*)

Create a vector of genotype frequencies for the current generation, as well as the next generation:

currGen={(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3]),(Subscript[x, p,4]),(Subscript[x, p,5]),(Subscript[x, p,6]),(Subscript[x, p,7]),(Subscript[x, p,8]),(Subscript[x, p,9])};
nextGen={(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3]),(Subscript[n2x, p,4]),(Subscript[n2x, p,5]),(Subscript[n2x, p,6]),(Subscript[n2x, p,7]),(Subscript[n2x, p,8]),(Subscript[n2x, p,9])};

Again, the following is taken from Otto (2003). The first term in brackets (on each line) denotes the change in each disequilbrium term over a single generation (e.g., pA/.sub1 denotes the frequency of A in the next generation - and from it we subtract pA, the frequency of A in the current generation). All variables are then converted back into genotype frequencies by applying sub2. Lastly we switch from pA to (Subscript[δ, P]).

changeOfVarPARASITE=Apply[XtoD,currGen];
changeOfVarPARASITE2=Apply[DtoX,nextGen];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])];
changeOverOneGenP=Map[oneGenChangeP,{pA,pM,FA,FM,cij,cicj,cijcj,cijci,cijcij}];

Analysis of recursions

subsmall0={(Subscript[F, A,h])->FAh+(Subscript[F, A,h]),FA->a3+FA,FM->a4+FM,cij->a5+cij,cicj->a6+cicj,cijcj->a7+cijcj,cijci->a8+cijci,cijcij->a9+cijcij};

subsmall=Function[a,{(Subscript[F, A,h])->(Subscript[F, A,h])*(ϵ^a),FA->FA*(ϵ^a),FM->FM*(ϵ^a),cij->cij*(ϵ^a),cicj->cicj*(ϵ^a),cijcj->cijcj*(ϵ^a),cijci->cijci*(ϵ^a),cijcij->cijcij*(ϵ^a),(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={FAh->0,a3->0,a4->0,a5->0,a6->0,a7->0,a8->0,a9->0};

eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]
Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Simplify//Flatten

eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={(Subscript[F, A,h])->0,FA->0,FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Kept order  ϵ  terms in the associations

toorder=1;

qlesoln={(Subscript[F, A,h])->0,FA->0,FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};
suba={FAh->(Subscript[F, A,h]),a3->FA,a4->FM,a5->cij,a6->cicj,a7->cijcj,a8->cijci,a9->cijcij}/.qlesoln;

eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]
Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Flatten//Simplify

Solve[eqn3==0,FA]//Flatten

This can be written as:

(FA/.%) - (((1-(Subscript[ψ, p])))/(Subscript[ψ, p]))(Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p]))((Subscript[x, h,0])+(Subscript[x, h,2])) (pA^2)(((1-pA))^2)/.pA->(Subscript[δ, p])+1/2/.changeOfVarHOST//Factor

eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={FA->(Subscript[F, A,p]),FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=-(1/8) (-1+pM) pM ((-1+2 pM) (Subscript[Δ, Mm])-pM (Subscript[Δ, MM])) (8 (Subscript[s, fl])-(Subscript[α, p]) (5+16 (Subscript[δ, h]) (Subscript[δ, p])-12 (Subscript[F, A,h])+4 (Subscript[δ, p]^2) (1+4 (Subscript[F, A,h]))+4 (Subscript[F, A,p])+16 (Subscript[F, A,h]) (Subscript[F, A,p])+4 (Subscript[δ, h]^2) (-3+4 (Subscript[δ, p]^2)+4 (Subscript[F, A,p])))-(Subscript[β, p]) (16 (Subscript[δ, h]) (Subscript[δ, p])+4 (Subscript[δ, h]^2) (-3+4 (Subscript[δ, p]^2)+4 (Subscript[F, A,p]))+(1+4 (Subscript[F, A,h])) (-3+4 (Subscript[δ, p]^2)+4 (Subscript[F, A,p]))));

Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM

(Subscript[w, mm])=(fit[0]*(Subscript[x, p,0])+fit[3]*(Subscript[x, p,3])+fit[7]*(Subscript[x, p,7]))/((Subscript[x, p,0])+(Subscript[x, p,3])+(Subscript[x, p,7]));
(Subscript[w, Mm])=(fit[1]*(Subscript[x, p,1])+fit[4]*(Subscript[x, p,4])+fit[5]*(Subscript[x, p,5])+fit[8]*(Subscript[x, p,8]))/((Subscript[x, p,1])+(Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]));
(Subscript[w, MM])=(fit[2]*(Subscript[x, p,2])+fit[6]*(Subscript[x, p,6])+fit[9]*(Subscript[x, p,9]))/((Subscript[x, p,2])+(Subscript[x, p,6])+(Subscript[x, p,9]));

(Subscript[x, M])=((Subscript[x, p,1])/2)+(Subscript[x, p,2])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,6])+((Subscript[x, p,8])/2)+(Subscript[x, p,9]);
(Subscript[x, m])=(Subscript[x, p,0])+((Subscript[x, p,1])/2)+(Subscript[x, p,3])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,7])+((Subscript[x, p,8])/2);

(Subscript[w, M])=(Subscript[x, M]) (Subscript[w, MM])+(Subscript[x, m]) (Subscript[w, Mm]);
(Subscript[w, m])=(Subscript[x, M]) (Subscript[w, Mm])+(Subscript[x, m]) (Subscript[w, mm]);

qlesoln={FA->(Subscript[F, A,p]),FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0,FAh->(Subscript[F, A,h])};
orderAssumptions={(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ};

Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.Apply[XtoD,currGen]/.changeOfVarHOST/.qlesoln/.{pA->(Subscript[δ, p])+1/2,(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) ,(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])}/.orderAssumptions,{ϵ,0,2}]]/.ϵ->1//Simplify

So our invasion term to put in ms (Table 2) is
((5(Subscript[α, p])-3 (Subscript[β, p]))/8) +(1/2)((Subscript[α, p])+(Subscript[β, p]))(4 (Subscript[δ, h]) (Subscript[δ, p]) (1+(Subscript[δ, h]) (Subscript[δ, p]))-3 (Subscript[δ, h]^2) +(Subscript[δ, p]^2) )
And with  (Subscript[F, A,p]) and (Subscript[F, A,h])
((5(Subscript[α, p])-3 (Subscript[β, p]))/8) +(1/2)((Subscript[α, p])+(Subscript[β, p]))((4 (Subscript[δ, h]) (Subscript[δ, p]) (1+(Subscript[δ, h]) (Subscript[δ, p]))-3 (Subscript[δ, h]^2) +(Subscript[δ, p]^2) )+(1+4 (Subscript[δ, h]^2)) (Subscript[F, A,p])- (3-4 (Subscript[δ, p]^2)) (Subscript[F, A,h])+4 (Subscript[F, A,h]) (Subscript[F, A,p]))
Where (Subscript[F, A,h])=2(Subscript[f, mm]) (Subscript[α, h])(((1/4-(Subscript[δ, h]^2)))^2) (3/4-(Subscript[δ, p]^2)) (1-(Subscript[ψ, h]))/(Subscript[ψ, h])
 and (Subscript[F, A,p])=2(Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p])) (((1/4-(Subscript[δ, p]^2)))^2)(1/4+(Subscript[δ, h]^2))(1-(Subscript[ψ, p])) /(Subscript[ψ, p])

Analysis of the (Subscript[δ, i]):

Host genotypes : 0 = aa, 1 = Aa, 2 = AA
Parasite genotypes : 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM

(Subscript[nextδ, h])=((Subscript[n2x, h,2])+((Subscript[n2x, h,1])/2))-(1/2);
(Subscript[nextδ, p])=((Subscript[n2x, p,7])+(Subscript[n2x, p,8])+(Subscript[n2x, p,9]))+((((Subscript[n2x, p,3])+(Subscript[n2x, p,4])+(Subscript[n2x, p,5])+(Subscript[n2x, p,6])))/2)-(1/2);

changeOfVarPARASITE=Apply[XtoD,{(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3]),(Subscript[x, p,4]),(Subscript[x, p,5]),(Subscript[x, p,6]),(Subscript[x, p,7]),(Subscript[x, p,8]),(Subscript[x, p,9])}]/.pA->(Subscript[δ, p])+(1/2)//Simplify;

subsmall0={FA->a3+FA,FM->a4+FM,cij->a5+cij,cicj->a6+cicj,cijcj->a7+cijcj,cijci->a8+cijci,cijcij->a9+cijcij};

Order assumptions are also included in the following substitution:

subsmall=Function[a,{FA->FA*(ϵ^a),FM->FM*(ϵ^a),cij->cij*(ϵ^a),cicj->cicj*(ϵ^a),cijcj->cijcj*(ϵ^a),cijci->cijci*(ϵ^a),cijcij->cijcij*(ϵ^a),(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM]),(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]),(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[δ, h])-> (Subscript[δ, h]) ϵ,(Subscript[δ, p])-> (Subscript[δ, p]) ϵ}];

suba={a3->-(((Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p])) (((1-4 (Subscript[δ, p]^2)))^2) (-1+(Subscript[ψ, p])) (1+4 (Subscript[δ, h]^2)-2 (Subscript[F, A,h])))/(32 (Subscript[ψ, p]))),a4->0,a5->0,a6->0,a7->0,a8->0,a9->0};

(Subscript[nδ, h])=Simplify[Series[(Subscript[nextδ, h])/.changeOfVarHOST/.changeOfVarPARASITE/.subsmall0/.suba/.subsmall[2],{ϵ,0,2}]]//Normal
(Subscript[nδ, p])=Simplify[Series[(Subscript[nextδ, p])/.changeOfVarHOST/.changeOfVarPARASITE/.subsmall0/.suba/.subsmall[2],{ϵ,0,2}]]//Normal

Collect[(Subscript[nδ, h])/.ϵ ->1,{ (Subscript[δ, h]), (Subscript[δ, p])},Simplify]
Collect[(Subscript[nδ, p])/.ϵ ->1, (Subscript[δ, h]),Simplify]

which can be put into matrix form as:
(({{(Subscript[δ, h,A])'}, {(Subscript[δ, p,A])'}}))=(({{ (1-(3/8) (Subscript[α, h]) ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))) (-1+4 (Subscript[F, A,h]))), -(1/4) (Subscript[α, h]) ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))) (1+4 (Subscript[F, A,h]))}, {(1/4) ((Subscript[α, p])+(Subscript[β, p])) ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))), (1/8) (8+((Subscript[α, p])+(Subscript[β, p])) ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))) (1+4 (Subscript[F, A,h])))}}))(({{(Subscript[δ, h,A])}, {(Subscript[δ, p,A])}}))

Solving the δ recurrences (using box 9.2 to get a general solution):

MatrixValues={a->(1-(3/8) (Subscript[α, h]) ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))) (-1+4 (Subscript[F, A,h]))),
b->-(1/4) (Subscript[α, h]) ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))) (1+4 (Subscript[F, A,h])),
c->(1/4) ((Subscript[α, p])+(Subscript[β, p])) ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))),
d->(1/8) (8+((Subscript[α, p])+(Subscript[β, p])) ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))) (1+4 (Subscript[F, A,h]))),
β->Sqrt[(-(((a-d))^2)-4b c)]/2};

MMat=(R^t)(({{Cos[ϕ t]+(((a-d))/(2 β)) Sin[ϕ t], (b/β) Sin[ϕ t]}, {(c/β) Sin[ϕ t], Cos[ϕ t]-(((a-d))/(2 β)) Sin[ϕ t]}}))/.MatrixValues//Simplify//MatrixForm
(* and the equation for ϕ *)
subϕ={ϕ->(Sqrt[((-(((a-d))^2)-4 b c)/(a+d))]) }/.MatrixValues//Simplify
(* and the equation for R *)
subR={R->(((a d-b c))^(1/t))}/.MatrixValues//Simplify

so ultimately we get:

(Subscript[δ, h])[t]=(R^t) (Cos[t ϕ]-((Sin[t ϕ] ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))) (3 (Subscript[α, h]) (-1+4 (Subscript[F, A,h]))+((Subscript[α, p])+(Subscript[β, p])) (1+4 (Subscript[F, A,h]))))/(8 (Sqrt[-(a^2)-4 b c+2 a d-(d^2)]))))(Subscript[δ, h,0])-(((R^t) Sin[t ϕ] (Subscript[α, h]) ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))) (1+4 (Subscript[F, A,h])))/(2 (Sqrt[-4 b c-(((a-d))^2)])))(Subscript[δ, p,0])/.subϕ/.subR;
(Subscript[δ, p])[t]=(((R^t) Sin[t ϕ] ((Subscript[α, p])+(Subscript[β, p])) ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))))/(2 (Sqrt[-4 b c-(((a-d))^2)])))(Subscript[δ, h,0])+(R^t) (Cos[t ϕ]+((Sin[t ϕ] ((Subscript[f, mm])+pM (-2 (-1+pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM]))) (3 (Subscript[α, h]) (-1+4 (Subscript[F, A,h]))+((Subscript[α, p])+(Subscript[β, p])) (1+4 (Subscript[F, A,h]))))/(8 (Sqrt[-(a^2)-4 b c+2 a d-(d^2)]))))(Subscript[δ, p,0])/.subϕ/.subR;

IMAM

Haploid Host/Haploid Parasite

Fitness Functions:

Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
Host genotypes: 0 = a, 1=A

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

(Subscript[w, i,j]) is the fitness genotype i in is j of species the  (Subscript[w, i,j])

wmat=(1+(({{-(Subscript[β, p]), (Subscript[α, p])}, {(Subscript[α, p]), -(Subscript[β, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])}};

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, m]),1], 
j==1,total[(Subscript[f, M]),1],
j==2,total[(Subscript[f, m]),2],
j==3,total[(Subscript[f, M]),2]];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= If[j==0, 1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,2])+(Subscript[f, M])*(Subscript[x, p,3])), 1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,0])+(Subscript[f, M])*(Subscript[x, p,1]))];

(Subscript[(OverBar[w]), h])=(∑_(j=0)^1)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^3)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

(Subscript[(OverBar[w]), i]) is the mean fitness of species i
(Subscript[x, i,j]) is frequency of genotype j in species i

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.

(Subscript[n2x, p,j_])=If[j==1||j==2,
(Subscript[n1x, p,j])+ (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2])),
(Subscript[n1x, p,j])- (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2]))
];
(Subscript[n2x, h,j_])=(Subscript[n1x, h,j]);

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the IMAM model.

Change of variables

The new variables are defined by: (Subscript[δ, i])=((Subscript[x, i,2])+(Subscript[x, i,3]))-1/2
(Subscript[p, M])=(Subscript[x, i,1])+(Subscript[x, i,3])
(Subscript[D, i])=(Subscript[x, i,0])(Subscript[x, i,3])-(Subscript[x, i,1])(Subscript[x, i,2])which translates into:

changeOfVarHOST=Solve[{(Subscript[δ, h])==(Subscript[x, h,1])-1/2,(Subscript[x, h,0])+(Subscript[x, h,1])==1},{(Subscript[x, h,0]),(Subscript[x, h,1])}]//Simplify//Flatten
changeOfVarPARASITE=Solve[{(Subscript[δ, p])==((Subscript[x, p,2])+(Subscript[x, p,3]))-1/2,(Subscript[p, M])==(Subscript[x, p,1])+(Subscript[x, p,3]),(Subscript[D, p])==(Subscript[x, p,0])(Subscript[x, p,3])-(Subscript[x, p,1])(Subscript[x, p,2]),(Subscript[x, p,0])+(Subscript[x, p,1])+(Subscript[x, p,2])+(Subscript[x, p,3])==1},{(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3])}]//Simplify//Flatten

changeOfVarHOST2=Solve[{(Subscript[δ, h])==(Subscript[n2x, h,1])-1/2,(Subscript[n2x, h,0])+(Subscript[n2x, h,1])==1},{(Subscript[δ, h])}]//Simplify//Flatten
changeOfVarPARASITE2=Solve[{(Subscript[δ, p])==((Subscript[n2x, p,2])+(Subscript[n2x, p,3]))-1/2,(Subscript[p, M])==(Subscript[n2x, p,1])+(Subscript[n2x, p,3]),(Subscript[D, p])==(Subscript[n2x, p,0])(Subscript[n2x, p,3])-(Subscript[n2x, p,1])(Subscript[n2x, p,2]),(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])==1},{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}]//Simplify//Flatten

oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h])}];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE];
changeOverOneGenP=Map[oneGenChangeP,{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}];

Analysis of recursions

subsmall0={(Subscript[D, p])->d+(Subscript[D, p])};

Order assumptions are also included in the following substitution:

subsmall=Function[a,{(Subscript[D, p])->(Subscript[D, p])*(ϵ^a),(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M]) ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={d->0};

eqn1=subAndSeriesP[1,toorder]
eqn2=subAndSeriesP[2,toorder]
eqn3=subAndSeriesP[3,toorder]
Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

Kept order  ϵ  terms in the associations

toorder = 1;

qlesoln={(Subscript[D, p])->0};
suba={d->(Subscript[D, p])}/.qlesoln;

eqn1=subAndSeriesP[1,toorder]
eqn2=subAndSeriesP[2,toorder]
eqn3=subAndSeriesP[3,toorder]
Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=(1/2) (-1+(Subscript[p, M])) (Subscript[p, M]) (2 (Subscript[s, fl])+(Subscript[α, p]) (-1+4 (Subscript[δ, h]) (Subscript[δ, p]))+(Subscript[β, p]) (1+4 (Subscript[δ, h]) (Subscript[δ, p]))) (Subscript[Δ, M]);

Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
Host genotypes: 0 = a, 1=A

(Subscript[w, m])=((Subscript[w, p,0])*(Subscript[x, p,0])+(Subscript[w, p,2])*(Subscript[x, p,2]))/((Subscript[x, p,0])+(Subscript[x, p,2]));
(Subscript[w, M])=((Subscript[w, p,1])*(Subscript[x, p,1])+(Subscript[w, p,3])*(Subscript[x, p,3]))/((Subscript[x, p,1])+(Subscript[x, p,3]));

qlesoln={(Subscript[D, p])->0};
orderAssumptions={(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M]) ϵ,(Subscript[δ, h])->(Subscript[δ, h]),(Subscript[δ, p])->(Subscript[δ, p]),(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ};

Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.changeOfVarPARASITE/.changeOfVarHOST/.qlesoln/.orderAssumptions,{ϵ,0,toorder+1}]]/.ϵ->1//Simplify

So our invasion term to put in ms (Table 2) is
(((Subscript[α, p])-(Subscript[β, p]) )/2)-((Subscript[α, p])+(Subscript[β, p]) )(2 (Subscript[δ, h]) (Subscript[δ, p]))

Haploid Host/Diploid Parasite

Fitness Functions:

Host genotypes: 0 = a, 1=A
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes: 0 = am, 1=aM, 2=Am, 3=AM
(Subscript[x, i,j]) is frequency of genotype j in species i

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

wmat=(1+(({{-(Subscript[β, p]), (Subscript[α, p])}, {-(Subscript[β, p]), -(Subscript[β, p])}, {(Subscript[α, p]), -(Subscript[β, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])}};

(Subscript[w, i,j]) is the fitness of genotype j in species i

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, mm]),1], 
j==1,total[(Subscript[f, Mm]),1],
j==2,total[(Subscript[f, MM]),1],
j==3,total[(Subscript[f, mm]),2],
j==4,total[(Subscript[f, Mm]),2],
j==5,total[(Subscript[f, Mm]),2],
j==6,total[(Subscript[f, MM]),2],
j==7,total[(Subscript[f, mm]),3],
j==8,total[(Subscript[f, Mm]),3],
j==9,total[(Subscript[f, MM]),3]];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= If[j==0, 1-(Subscript[α, h])((Subscript[f, mm])(Subscript[x, p,0])+(Subscript[f, Mm])(Subscript[x, p,1])+(Subscript[f, MM])(Subscript[x, p,2])), 1-(Subscript[α, h])((Subscript[f, mm])(Subscript[x, p,7])+(Subscript[f, Mm])(Subscript[x, p,8])+(Subscript[f, MM])(Subscript[x, p,9]))];

(Subscript[(OverBar[w]), i]) is the mean fitness of species i

(Subscript[(OverBar[w]), h])=(∑_(j=0)^1)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^9)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.
Host genotypes : 0 = aa, 1 = Aa, 2 = AA
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes : 0 = am, 1 = aM, 2 = Am, 3 = AM

Hosts

(Subscript[n2x, h,j_])=(Subscript[n1x, h,j]);

Parasites

rMatrix={
{1,0,0,0},
{(1/2),(1/2),0,0},
{0,1,0,0},
{(1/2),0,(1/2),0},
{((1-r)/2),(r/2),(r/2),((1-r)/2)},
{(r/2),((1-r)/2),((1-r)/2),(r/2)},
{0,(1/2),0,(1/2)},
{0,0,1,0},
{0,0,(1/2),(1/2)},
{0,0,0,1}};

PGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, p,0])},{(Subscript[n1x, p,1])},{(Subscript[n1x, p,2])},{(Subscript[n1x, p,3])},{(Subscript[n1x, p,4])},{(Subscript[n1x, p,5])},{(Subscript[n1x, p,6])},{(Subscript[n1x, p,7])},{(Subscript[n1x, p,8])},{(Subscript[n1x, p,9])}}]).rMatrix];
gamete[j_]=Which[
j==0, PGameteFreqs[[1]],
j==1,PGameteFreqs[[2]],
j==2, PGameteFreqs[[3]],
j==3, PGameteFreqs[[4]]
];

am=0;aM=1;Am=2;AM=3;
(Subscript[n2x, p,j_])=Which[
j==0,(1-(Subscript[ψ, p])) (Subscript[n1x, p,0])+(Subscript[ψ, p]) gamete[am].gamete[am], 
j==1,(1-(Subscript[ψ, p])) (Subscript[n1x, p,1])+(Subscript[ψ, p]) 2 gamete[aM].gamete[am],
j==2,(1-(Subscript[ψ, p])) (Subscript[n1x, p,2])+(Subscript[ψ, p]) gamete[aM].gamete[aM],
j==3,(1-(Subscript[ψ, p])) (Subscript[n1x, p,3])+(Subscript[ψ, p]) 2 gamete[Am].gamete[am],
j==4,(1-(Subscript[ψ, p])) (Subscript[n1x, p,4])+(Subscript[ψ, p]) 2 gamete[AM].gamete[am],
j==5,(1-(Subscript[ψ, p])) (Subscript[n1x, p,5])+(Subscript[ψ, p]) 2 gamete[Am].gamete[aM],
j==6,(1-(Subscript[ψ, p])) (Subscript[n1x, p,6])+(Subscript[ψ, p]) 2 gamete[AM].gamete[aM],
j==7,(1-(Subscript[ψ, p])) (Subscript[n1x, p,7])+(Subscript[ψ, p]) gamete[Am].gamete[Am],
j==8,(1-(Subscript[ψ, p])) (Subscript[n1x, p,8])+(Subscript[ψ, p]) 2 gamete[AM].gamete[Am],
j==9,(1-(Subscript[ψ, p])) (Subscript[n1x, p,9])+(Subscript[ψ, p]) gamete[AM].gamete[AM]
];

Check that things sum to 1 as they should:
(Subscript[n2x, h,0])+(Subscript[n2x, h,1])//Simplify
(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])+(Subscript[n2x, p,4])+(Subscript[n2x, p,5])+(Subscript[n2x, p,6])+(Subscript[n2x, p,7])+(Subscript[n2x, p,8])+(Subscript[n2x, p,9])//Simplify

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the IMAM model.

Change of variables

Host genotypes: 0 = a, 1=A
Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM
Parasite genotypes: x44=0 = aamm, 2 x24 = 1 = aaMm, x22 = 2 = aaMM, 2 x34 = 3 = Aamm, 2 x14 = 4 = AaMm, 2 x23 = 5 = AamM, 2 x12=6 = AaMM, 2 x33=7 = AAmm, 2 x13=8 = AAMm, x11=9 = AAMM
Parasite haplotypes: 0 = am, 1 = aM, 2 = Am, 3 = AM

changeOfVarHOST=Solve[{(Subscript[δ, h])==(Subscript[x, h,1])-1/2,(Subscript[x, h,0])+(Subscript[x, h,1])==1},{(Subscript[x, h,0]),(Subscript[x, h,1])}]//Simplify//Flatten;
changeOfVarHOST2=Solve[{(Subscript[δ, h])==(Subscript[n2x, h,1])-1/2,(Subscript[n2x, h,0])+(Subscript[n2x, h,1])==1},{(Subscript[δ, h])}]//Simplify//Flatten;
oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h])}];

DtoX=Function[{a,b,c,d,e,f,g,h,i,j},
Block[{pA1=((d/2)+(e/2)+(f/2)+(g/2)+h+i+j),pM1=((b/2)+c+(e/2)+(f/2)+g+(i/2)+j)},
{1->a+b+c+d+e+f+g+h+i+j,
pA->(d/2)+(e/2)+(f/2)+(g/2)+h+i+j,
pM->(b/2)+c+(e/2)+(f/2)+g+(i/2)+j,
FA->(h+(i/2)) (((1-pA1))^2)+((i/2)+j) (((1-pA1))^2)-((d/2)+(e/2)) (1-pA1) pA1-((d/2)+(f/2)) (1-pA1) pA1-((e/2)+(g/2)) (1-pA1) pA1-((f/2)+(g/2)) (1-pA1) pA1+(a+(b/2)) (((pA1))^2)+((b/2)+c) (pA1^2),
FM->(c+(g/2)) (((1-pM1))^2)+((g/2)+j) (((1-pM1))^2)-((b/2)+(e/2)) (1-pM1) pM1-((b/2)+(f/2)) (1-pM1) pM1-((e/2)+(i/2)) (1-pM1) pM1-((f/2)+(i/2)) (1-pM1) pM1+(a+(d/2)) (pM1^2)+((d/2)+h) (pM1^2),
cijcij->j (((1-pA1))^2) (((1-pM1))^2)-g (1-pA1) pA1 (((1-pM1))^2)+c (pA1^2) (((1-pM1))^2)-i (((1-pA1))^2) (1-pM1) pM1+e (1-pA1) pA1 (1-pM1) pM1+f (1-pA1) pA1 (1-pM1) pM1-b (pA1^2) (1-pM1) pM1+h (((1-pA1))^2) (pM1^2)-d (1-pA1) pA1 (pM1^2)+a (pA1^2) (pM1^2),
cijci->((g/2)+j) (1-pA1) (((1-pM1))^2)-(c+(g/2)) pA1 (((1-pM1))^2)-((e/2)+(i/2)) (1-pA1) (1-pM1) pM1-((f/2)+(i/2)) (1-pA1) (1-pM1) pM1+((b/2)+(e/2)) pA1 (1-pM1) pM1+((b/2)+(f/2)) pA1 (1-pM1) pM1+((d/2)+h) (1-pA1) (pM1^2)-(a+(d/2)) pA1 (pM1^2),
cijcj->((i/2)+j) (((1-pA1))^2) (1-pM1)-((e/2)+(g/2)) (1-pA1) pA1 (1-pM1)-((f/2)+(g/2)) (1-pA1) pA1 (1-pM1)+((b/2)+c) (pA1^2) (1-pM1)-(h+(i/2)) (((1-pA1))^2) pM1+((d/2)+(e/2)) (1-pA1) pA1 pM1+((d/2)+(f/2)) (1-pA1) pA1 pM1-(a+(b/2)) (pA1^2) pM1,
cicj->((f/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(e/2)+(g/2)) pA1 (1-pM1)-((d/2)+(e/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(f/2)) pA1 pM1,
cij->((e/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(f/2)+(g/2)) pA1 (1-pM1)-((d/2)+(f/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(e/2)) pA1 pM1}]];

XtoD=Function[{a,b,c,d,e,f,g,h,i,j},
{a->1-2 cijci+cijcij-2 cijcj+FA+FM-2 pA+2 cijci pA-2 FM pA+(pA^2)+FM (pA^2)+2 cicj (-1+pA) (-1+pM)+2 cij (-1+pA) (-1+pM)-2 pM+2 cijcj pM-2 FA pM+4 pA pM-2 (pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
b->-2 (-2 cijci+cijcij-cijcj+FM+2 cijci pA-2 FM pA+FM (pA^2)-pM+2 cijcj pM-FA pM+2 pA pM-(pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2)+cicj (-1+pA) (-1+2 pM)+cij (-1+pA) (-1+2 pM)),
c->cijcij+FM+2 cijci (-1+pA)-2 FM pA+FM (pA^2)-2 cicj pM-2 cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
d->-2 (-cijci+cijcij-2 cijcj+FA-pA+2 cijci pA-FM pA+(pA^2)+FM (pA^2)+cicj (-1+2 pA) (-1+pM)+cij (-1+2 pA) (-1+pM)+2 cijcj pM-2 FA pM+2 pA pM-2 (pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
e->2 (cijcij-cijcj-cicj pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM+2 cijcj pM-FA pM+pA pM+2 cicj pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cij (1-pM+pA (-1+2 pM))),
f->2 (cijcij-cijcj-cij pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cij pM+2 cijcj pM-FA pM+pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cicj (1-pM+pA (-1+2 pM))),
g->-2 (cijcij-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM-cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
h->cijcij+FA-2 cicj pA-2 cij pA+2 cijci pA+(pA^2)+FM (pA^2)+2 cijcj (-1+pM)-2 FA pM+2 cicj pA pM+2 cij pA pM-2 (pA^2) pM+FA (pM^2)+(pA^2) (pM^2),
i->-2 (cijcij-cicj pA-cij pA+2 cijci pA+FM (pA^2)-FA pM+2 cicj pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)+(pA^2) (pM^2)+cijcj (-1+2 pM)),
j->cijcij+2 cijci pA+FM (pA^2)+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)+(pA^2) (pM^2)}];

currGen={(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3]),(Subscript[x, p,4]),(Subscript[x, p,5]),(Subscript[x, p,6]),(Subscript[x, p,7]),(Subscript[x, p,8]),(Subscript[x, p,9])};
nextGen={(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3]),(Subscript[n2x, p,4]),(Subscript[n2x, p,5]),(Subscript[n2x, p,6]),(Subscript[n2x, p,7]),(Subscript[n2x, p,8]),(Subscript[n2x, p,9])};

changeOfVarPARASITE=Apply[XtoD,currGen];
changeOfVarPARASITE2=Apply[DtoX,nextGen];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])];
changeOverOneGenP=Map[oneGenChangeP,{pA,pM,FA,FM,cij,cicj,cijcj,cijci,cijcij}];

Analysis of recursions

Order assumptions are also included in the following substitution:

subsmall0={FA->a3+FA,FM->a4+FM,cij->a5+cij,cicj->a6+cicj,cijcj->a7+cijcj,cijci->a8+cijci,cijcij->a9+cijcij};

subsmall=Function[a,{FA->FA*(ϵ^a),FM->FM*(ϵ^a),cij->cij*(ϵ^a),cicj->cicj*(ϵ^a),cijcj->cijcj*(ϵ^a),cijci->cijci*(ϵ^a),cijcij->cijcij*(ϵ^a),(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={a3->0,a4->0,a5->0,a6->0,a7->0,a8->0,a9->0};

eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]

Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Simplify//Flatten

qlesoln={FA->0,FM->0,cijcj->0,cijci->0,cijcij->0,cicj->0,cij->0};

Kept order  ϵ  terms in the associations

toorder=1;

qlesoln={FA->0,FM->0,cijcj->0,cijci->0,cijcij->0,cicj->0,cij->0};
suba={a3->FA,a4->FM,a5->cij,a6->cicj,a7->cijcj,a8->cijci,a9->cijcij}/.qlesoln;

eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]

Solve[eqn3==0,FA]//Flatten//Simplify

qlesoln =Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Flatten//Simplify

qlesoln={FA->(Subscript[F, A,P]),FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=-(1/4) (-1+pM) pM ((-1+2 pM) (Subscript[Δ, Mm])-pM (Subscript[Δ, MM])) (4 (Subscript[s, fl])-(Subscript[β, p]) (-3+8 (Subscript[δ, h]) (Subscript[δ, p])+4 (Subscript[δ, p]^2)+4 (Subscript[F, A,P]))-(Subscript[α, p]) (1+8 (Subscript[δ, h]) (Subscript[δ, p])+4 (Subscript[δ, p]^2)+4 (Subscript[F, A,P])));

Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM

(Subscript[w, mm])=(fit[0]*(Subscript[x, p,0])+fit[3]*(Subscript[x, p,3])+fit[7]*(Subscript[x, p,7]))/((Subscript[x, p,0])+(Subscript[x, p,3])+(Subscript[x, p,7]));
(Subscript[w, Mm])=(fit[1]*(Subscript[x, p,1])+fit[4]*(Subscript[x, p,4])+fit[5]*(Subscript[x, p,5])+fit[8]*(Subscript[x, p,8]))/((Subscript[x, p,1])+(Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]));
(Subscript[w, MM])=(fit[2]*(Subscript[x, p,2])+fit[6]*(Subscript[x, p,6])+fit[9]*(Subscript[x, p,9]))/((Subscript[x, p,2])+(Subscript[x, p,6])+(Subscript[x, p,9]));

(Subscript[x, M])=((Subscript[x, p,1])/2)+(Subscript[x, p,2])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,6])+((Subscript[x, p,8])/2)+(Subscript[x, p,9]);
(Subscript[x, m])=(Subscript[x, p,0])+((Subscript[x, p,1])/2)+(Subscript[x, p,3])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,7])+((Subscript[x, p,8])/2);

(Subscript[w, M])=(Subscript[x, M]) (Subscript[w, MM])+(Subscript[x, m]) (Subscript[w, Mm]);
(Subscript[w, m])=(Subscript[x, M]) (Subscript[w, Mm])+(Subscript[x, m]) (Subscript[w, mm]);

qlesoln={FA->(Subscript[F, A,p]),FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};
orderAssumptions={(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ};

Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.Apply[XtoD,currGen]/.changeOfVarHOST/.qlesoln/.{pA->(Subscript[δ, p])+1/2,(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) ,(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])}/.orderAssumptions,{ϵ,0,2}]]/.ϵ->1//Simplify

So our invasion term to put in ms (Table 2) is
(((Subscript[α, p])-3(Subscript[β, p]))/4) -((Subscript[α, p])+(Subscript[β, p]))(2 (Subscript[δ, h]) (Subscript[δ, p])-(Subscript[δ, p]^2))
And with  (Subscript[F, A,p])
(((Subscript[α, p])-3(Subscript[β, p]))/4) -((Subscript[α, p])+(Subscript[β, p]))(2 (Subscript[δ, h]) (Subscript[δ, p])-(Subscript[δ, p]^2)-(Subscript[F, A,p]))

Diploid Host/Haploid Parasite

Fitness Functions:

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
(Subscript[x, i,j]) is frequency of genotype j in species i

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

wmat=(1+(({{-(Subscript[β, p]), -(Subscript[β, p]), (Subscript[α, p])}, {(Subscript[α, p]), -(Subscript[β, p]), -(Subscript[β, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])},{(Subscript[x, h,2])}};

(Subscript[w, i,j]) is the fitness of genotype j in species i

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, m]),1], 
j==1,total[(Subscript[f, M]),1],
j==2,total[(Subscript[f, m]),2],
j==3,total[(Subscript[f, M]),2]];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= Which[
j==0,1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,0])+(Subscript[f, M])*(Subscript[x, p,1])),
j==1,1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,0])+(Subscript[f, M])*(Subscript[x, p,1])+(Subscript[f, m])*(Subscript[x, p,2])+(Subscript[f, M])*(Subscript[x, p,3])),
j==2,1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,2])+(Subscript[f, M])*(Subscript[x, p,3]))];

(Subscript[(OverBar[w]), i]) is the mean fitness of species i

(Subscript[(OverBar[w]), h])=(∑_(j=0)^2)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^3)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.
Host genotypes : 0 = aa, 1 = Aa, 2 = AA
Parasite genotypes : 0 = am, 1 = aM, 2 = Am, 3 = AM

Hosts

HGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, h,0])},{(Subscript[n1x, h,1])},{(Subscript[n1x, h,2])}}]).{{1,0},{(1/2),(1/2)},{0,1}}]//Flatten;
(Subscript[n2x, h,j_])=Which[
j==0,(1-(Subscript[ψ, h])) (Subscript[n1x, h,0])+(Subscript[ψ, h]) HGameteFreqs[[1]]*HGameteFreqs[[1]],
j==1,(1-(Subscript[ψ, h])) (Subscript[n1x, h,1])+(Subscript[ψ, h]) 2*HGameteFreqs[[1]]*HGameteFreqs[[2]],
j==2,(1-(Subscript[ψ, h])) (Subscript[n1x, h,2])+(Subscript[ψ, h]) HGameteFreqs[[2]]*HGameteFreqs[[2]]
];

Parasites

(Subscript[n2x, p,j_])=If[j==1||j==2,
(Subscript[n1x, p,j])+ (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2])),
(Subscript[n1x, p,j])- (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2]))
];

Check that things sum to 1 as they should:
(Subscript[n2x, h,0])+(Subscript[n2x, h,1])+(Subscript[n2x, h,2])//Simplify
(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])//Simplify

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the IMAM model.

Change of variables

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = am, 1 = aM, 2 = Am, 3 = AM

changeOfVarHOST=Solve[
{(Subscript[δ, h])==((Subscript[x, h,2])+((Subscript[x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[x, h,0])+((Subscript[x, h,1])/2))(((Subscript[x, h,1])/2)+(Subscript[x, h,2]))-(Subscript[x, h,1]))/2,(∑_(j=0)^2)(Subscript[x, h,j])==1},{(Subscript[x, h,0]),(Subscript[x, h,1]),(Subscript[x, h,2])}]//Simplify//Flatten
changeOfVarPARASITE=Solve[{(Subscript[δ, p])==((Subscript[x, p,2])+(Subscript[x, p,3]))-1/2,(Subscript[p, M])==(Subscript[x, p,1])+(Subscript[x, p,3]),(Subscript[D, p])==(Subscript[x, p,0])(Subscript[x, p,3])-(Subscript[x, p,1])(Subscript[x, p,2]),(Subscript[x, p,0])+(Subscript[x, p,1])+(Subscript[x, p,2])+(Subscript[x, p,3])==1},{(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3])}]//Simplify//Flatten

changeOfVarHOST2=Solve[{(Subscript[δ, h])==((Subscript[n2x, h,2])+((Subscript[n2x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[n2x, h,0])+((Subscript[n2x, h,1])/2))(((Subscript[n2x, h,1])/2)+(Subscript[n2x, h,2]))-(Subscript[n2x, h,1]))/2,(∑_(j=0)^2)(Subscript[n2x, h,j])==1},{(Subscript[δ, h]),(Subscript[F, A,h])}]//Simplify//Flatten
changeOfVarPARASITE2=Solve[{(Subscript[δ, p])==((Subscript[n2x, p,2])+(Subscript[n2x, p,3]))-1/2,(Subscript[p, M])==(Subscript[n2x, p,1])+(Subscript[n2x, p,3]),(Subscript[D, p])==(Subscript[n2x, p,0])(Subscript[n2x, p,3])-(Subscript[n2x, p,1])(Subscript[n2x, p,2]),(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])==1},{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}]//Simplify//Flatten

oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h]),(Subscript[F, A,h])}];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE];
changeOverOneGenP=Map[oneGenChangeP,{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}];

Analysis of recursions

subsmall0={(Subscript[F, A,h])->FAh+(Subscript[F, A,h]),(Subscript[D, p])->d+(Subscript[D, p])};

Order assumptions are also included in the following substitution:

subsmall=Function[a,{(Subscript[F, A,h])->(Subscript[F, A,h])*(ϵ^a),(Subscript[D, p])->(Subscript[D, p])*(ϵ^a),(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M])ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={d->0,FAh->0};

eqn1=subAndSeriesP[1,toorder]
eqn2=subAndSeriesP[2,toorder]
eqn3=subAndSeriesP[3,toorder]
Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

eqn1=subAndSeriesH[1,toorder]
eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={(Subscript[D, p])->0,(Subscript[F, A,h])->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.qlesoln/.subsmall0/.suba/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Kept order  ϵ  terms in the associations

toorder = 1;

qlesoln={(Subscript[D, p])->0,(Subscript[F, A,h])->0};
suba={d->(Subscript[D, p]),FAh->(Subscript[F, A,h])}/.qlesoln;

eqn3=subAndSeriesP[3,toorder]
Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={(Subscript[D, p])->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=(1/4) (-1+(Subscript[p, M])) (Subscript[p, M]) (Subscript[Δ, M]) (4 (Subscript[s, fl])+(Subscript[β, p]) (3-4 (Subscript[δ, h]^2)+8 (Subscript[δ, h]) (Subscript[δ, p])-4 (Subscript[F, A,h]))-(Subscript[α, p]) (1+4 (Subscript[δ, h]^2)-8 (Subscript[δ, h]) (Subscript[δ, p])+4 (Subscript[F, A,h])));

Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
Host genotypes: 0 = a, 1=A

(Subscript[w, m])=((Subscript[w, p,0])*(Subscript[x, p,0])+(Subscript[w, p,2])*(Subscript[x, p,2]))/((Subscript[x, p,0])+(Subscript[x, p,2]));
(Subscript[w, M])=((Subscript[w, p,1])*(Subscript[x, p,1])+(Subscript[w, p,3])*(Subscript[x, p,3]))/((Subscript[x, p,1])+(Subscript[x, p,3]));

qlesoln={(Subscript[D, p])->0};
orderAssumptions={(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M]) ϵ,(Subscript[δ, h])->(Subscript[δ, h]),(Subscript[δ, p])->(Subscript[δ, p]),(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ};

Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.changeOfVarPARASITE/.changeOfVarHOST/.qlesoln/.orderAssumptions,{ϵ,0,2}]]/.ϵ->1//Simplify

So our invasion term to put in ms (Table 2) is
(((Subscript[α, p])-3(Subscript[β, p]))/4) -((Subscript[α, p])+(Subscript[β, p]))(2 (Subscript[δ, h]) (Subscript[δ, p])-(Subscript[δ, h]^2))
And with  (Subscript[F, A,h])
(((Subscript[α, p])-3(Subscript[β, p]))/4) -((Subscript[α, p])+(Subscript[β, p]))(2 (Subscript[δ, h]) (Subscript[δ, p])-(Subscript[δ, h]^2)-(Subscript[F, A,h]))

Diploid Host/Diploid Parasite

Fitness Functions:

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes: 0 = am, 1=aM, 2=Am, 3=AM
(Subscript[x, i,j]) is frequency of genotype j in species i

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

wmat=(1+(({{-(Subscript[β, p]), -(Subscript[β, p]), (Subscript[α, p])}, {-(Subscript[β, p]), -(Subscript[β, p]), -(Subscript[β, p])}, {(Subscript[α, p]), -(Subscript[β, p]), -(Subscript[β, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])},{(Subscript[x, h,2])}};

(Subscript[w, i,j]) is the fitness of genotype j in species i

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, mm]),1], 
j==1,total[(Subscript[f, Mm]),1],
j==2,total[(Subscript[f, MM]),1],
j==3,total[(Subscript[f, mm]),2],
j==4,total[(Subscript[f, Mm]),2],
j==5,total[(Subscript[f, Mm]),2],
j==6,total[(Subscript[f, MM]),2],
j==7,total[(Subscript[f, mm]),3],
j==8,total[(Subscript[f, Mm]),3],
j==9,total[(Subscript[f, MM]),3]];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= Which[
j==0,1-(Subscript[α, h])((Subscript[f, mm])(Subscript[x, p,0])+(Subscript[f, Mm])(Subscript[x, p,1])+(Subscript[f, MM])(Subscript[x, p,2])),
j==1,1-(Subscript[α, h])((Subscript[f, mm])((Subscript[x, p,0])+(Subscript[x, p,3])+(Subscript[x, p,7]))+(Subscript[f, Mm])((Subscript[x, p,1])+(Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]))+(Subscript[f, MM])((Subscript[x, p,2])+(Subscript[x, p,6])+(Subscript[x, p,9]))),
j==2,1-(Subscript[α, h])((Subscript[f, mm])(Subscript[x, p,7])+(Subscript[f, Mm])(Subscript[x, p,8])+(Subscript[f, MM])(Subscript[x, p,9]))];

(Subscript[(OverBar[w]), i]) is the mean fitness of species i

(Subscript[(OverBar[w]), h])=(∑_(j=0)^2)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^9)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.
Host genotypes : 0 = aa, 1 = Aa, 2 = AA
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes : 0 = am, 1 = aM, 2 = Am, 3 = AM

Hosts

HGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, h,0])},{(Subscript[n1x, h,1])},{(Subscript[n1x, h,2])}}]).{{1,0},{(1/2),(1/2)},{0,1}}]//Flatten;
(Subscript[n2x, h,j_])=Which[
j==0,(1-(Subscript[ψ, h])) (Subscript[n1x, h,0])+(Subscript[ψ, h]) HGameteFreqs[[1]]*HGameteFreqs[[1]],
j==1,(1-(Subscript[ψ, h])) (Subscript[n1x, h,1])+(Subscript[ψ, h]) 2*HGameteFreqs[[1]]*HGameteFreqs[[2]],
j==2,(1-(Subscript[ψ, h])) (Subscript[n1x, h,2])+(Subscript[ψ, h]) HGameteFreqs[[2]]*HGameteFreqs[[2]]
];

Parasites

rMatrix={
{1,0,0,0},
{(1/2),(1/2),0,0},
{0,1,0,0},
{(1/2),0,(1/2),0},
{((1-r)/2),(r/2),(r/2),((1-r)/2)},
{(r/2),((1-r)/2),((1-r)/2),(r/2)},
{0,(1/2),0,(1/2)},
{0,0,1,0},
{0,0,(1/2),(1/2)},
{0,0,0,1}};

PGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, p,0])},{(Subscript[n1x, p,1])},{(Subscript[n1x, p,2])},{(Subscript[n1x, p,3])},{(Subscript[n1x, p,4])},{(Subscript[n1x, p,5])},{(Subscript[n1x, p,6])},{(Subscript[n1x, p,7])},{(Subscript[n1x, p,8])},{(Subscript[n1x, p,9])}}]).rMatrix];
gamete[j_]=Which[
j==0, PGameteFreqs[[1]],
j==1,PGameteFreqs[[2]],
j==2, PGameteFreqs[[3]],
j==3, PGameteFreqs[[4]]
];

am=0;aM=1;Am=2;AM=3;
(Subscript[n2x, p,j_])=Which[
j==0,(1-(Subscript[ψ, p])) (Subscript[n1x, p,0])+(Subscript[ψ, p]) gamete[am].gamete[am], 
j==1,(1-(Subscript[ψ, p])) (Subscript[n1x, p,1])+(Subscript[ψ, p]) 2 gamete[aM].gamete[am],
j==2,(1-(Subscript[ψ, p])) (Subscript[n1x, p,2])+(Subscript[ψ, p]) gamete[aM].gamete[aM],
j==3,(1-(Subscript[ψ, p])) (Subscript[n1x, p,3])+(Subscript[ψ, p]) 2 gamete[Am].gamete[am],
j==4,(1-(Subscript[ψ, p])) (Subscript[n1x, p,4])+(Subscript[ψ, p]) 2 gamete[AM].gamete[am],
j==5,(1-(Subscript[ψ, p])) (Subscript[n1x, p,5])+(Subscript[ψ, p]) 2 gamete[Am].gamete[aM],
j==6,(1-(Subscript[ψ, p])) (Subscript[n1x, p,6])+(Subscript[ψ, p]) 2 gamete[AM].gamete[aM],
j==7,(1-(Subscript[ψ, p])) (Subscript[n1x, p,7])+(Subscript[ψ, p]) gamete[Am].gamete[Am],
j==8,(1-(Subscript[ψ, p])) (Subscript[n1x, p,8])+(Subscript[ψ, p]) 2 gamete[AM].gamete[Am],
j==9,(1-(Subscript[ψ, p])) (Subscript[n1x, p,9])+(Subscript[ψ, p]) gamete[AM].gamete[AM]
];

Check that things sum to 1 as they should:
(Subscript[n2x, h,0])+(Subscript[n2x, h,1])+(Subscript[n2x, h,2])//Simplify
(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])+(Subscript[n2x, p,4])+(Subscript[n2x, p,5])+(Subscript[n2x, p,6])+(Subscript[n2x, p,7])+(Subscript[n2x, p,8])+(Subscript[n2x, p,9])//Simplify

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the IMAM model.

Change of variables

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM
Parasite genotypes: x44=0 = aamm, 2 x24 = 1 = aaMm, x22 = 2 = aaMM, 2 x34 = 3 = Aamm, 2 x14 = 4 = AaMm, 2 x23 = 5 = AamM, 2 x12=6 = AaMM, 2 x33=7 = AAmm, 2 x13=8 = AAMm, x11=9 = AAMM
Parasite haplotypes: 0 = am, 1 = aM, 2 = Am, 3 = AM

Define new variables as: (Subscript[δ, h])=((Subscript[x, h,2])+((Subscript[x, h,1])/2))-(1/2)
(Subscript[F, A,h])==(Subscript[x, h,1])-2((Subscript[x, h,0])+((Subscript[x, h,1])/2))(((Subscript[x, h,1])/2)+(Subscript[x, h,2]))

changeOfVarHOST=Solve[
{(Subscript[δ, h])==((Subscript[x, h,2])+((Subscript[x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[x, h,0])+((Subscript[x, h,1])/2))(((Subscript[x, h,1])/2)+(Subscript[x, h,2]))-(Subscript[x, h,1]))/2,(∑_(j=0)^2)(Subscript[x, h,j])==1},{(Subscript[x, h,0]),(Subscript[x, h,1]),(Subscript[x, h,2])}]//Simplify//Flatten
changeOfVarHOST2=Solve[{(Subscript[δ, h])==((Subscript[n2x, h,2])+((Subscript[n2x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[n2x, h,0])+((Subscript[n2x, h,1])/2))(((Subscript[n2x, h,1])/2)+(Subscript[n2x, h,2]))-(Subscript[n2x, h,1]))/2,(∑_(j=0)^2)(Subscript[n2x, h,j])==1},{(Subscript[δ, h]),(Subscript[F, A,h])}]//Simplify//Flatten
oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h]),(Subscript[F, A,h])}];

Using Sally's code from Otto (2003) we can change the system of equations (for the parasites) into a new system of equations with all higher order associations, etc etc. Genotype labels in our model can be converted into those in Sally's model in the following way: {(Subscript[x, p,0])->x44,(Subscript[x, p,1])->2 x24,(Subscript[x, p,2])->x22,(Subscript[x, p,3])->2 x34,(Subscript[x, p,4])->2 x14,(Subscript[x, p,5])->2 x23,(Subscript[x, p,6])->2 x12,(Subscript[x, p,7])->x33,(Subscript[x, p,8])->2 x13,(Subscript[x, p,9])->x11}
The below functions DtoX converts from disequilbrium to genotype frequencies, and XtoD does the reverse conversion. DtoX is equivalent to 'subpD2' in Otto (2003) and XtoD is equivalent to 'subx2', except that they are written to work with our variable naming scheme.

DtoX=Function[{a,b,c,d,e,f,g,h,i,j},
Block[{pA1=((d/2)+(e/2)+(f/2)+(g/2)+h+i+j),pM1=((b/2)+c+(e/2)+(f/2)+g+(i/2)+j)},
{1->a+b+c+d+e+f+g+h+i+j,
pA->(d/2)+(e/2)+(f/2)+(g/2)+h+i+j,
pM->(b/2)+c+(e/2)+(f/2)+g+(i/2)+j,
FA->(h+(i/2)) (((1-pA1))^2)+((i/2)+j) (((1-pA1))^2)-((d/2)+(e/2)) (1-pA1) pA1-((d/2)+(f/2)) (1-pA1) pA1-((e/2)+(g/2)) (1-pA1) pA1-((f/2)+(g/2)) (1-pA1) pA1+(a+(b/2)) (((pA1))^2)+((b/2)+c) (pA1^2),
FM->(c+(g/2)) (((1-pM1))^2)+((g/2)+j) (((1-pM1))^2)-((b/2)+(e/2)) (1-pM1) pM1-((b/2)+(f/2)) (1-pM1) pM1-((e/2)+(i/2)) (1-pM1) pM1-((f/2)+(i/2)) (1-pM1) pM1+(a+(d/2)) (pM1^2)+((d/2)+h) (pM1^2),
cijcij->j (((1-pA1))^2) (((1-pM1))^2)-g (1-pA1) pA1 (((1-pM1))^2)+c (pA1^2) (((1-pM1))^2)-i (((1-pA1))^2) (1-pM1) pM1+e (1-pA1) pA1 (1-pM1) pM1+f (1-pA1) pA1 (1-pM1) pM1-b (pA1^2) (1-pM1) pM1+h (((1-pA1))^2) (pM1^2)-d (1-pA1) pA1 (pM1^2)+a (pA1^2) (pM1^2),
cijci->((g/2)+j) (1-pA1) (((1-pM1))^2)-(c+(g/2)) pA1 (((1-pM1))^2)-((e/2)+(i/2)) (1-pA1) (1-pM1) pM1-((f/2)+(i/2)) (1-pA1) (1-pM1) pM1+((b/2)+(e/2)) pA1 (1-pM1) pM1+((b/2)+(f/2)) pA1 (1-pM1) pM1+((d/2)+h) (1-pA1) (pM1^2)-(a+(d/2)) pA1 (pM1^2),
cijcj->((i/2)+j) (((1-pA1))^2) (1-pM1)-((e/2)+(g/2)) (1-pA1) pA1 (1-pM1)-((f/2)+(g/2)) (1-pA1) pA1 (1-pM1)+((b/2)+c) (pA1^2) (1-pM1)-(h+(i/2)) (((1-pA1))^2) pM1+((d/2)+(e/2)) (1-pA1) pA1 pM1+((d/2)+(f/2)) (1-pA1) pA1 pM1-(a+(b/2)) (pA1^2) pM1,
cicj->((f/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(e/2)+(g/2)) pA1 (1-pM1)-((d/2)+(e/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(f/2)) pA1 pM1,
cij->((e/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(f/2)+(g/2)) pA1 (1-pM1)-((d/2)+(f/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(e/2)) pA1 pM1}]];

XtoD=Function[{a,b,c,d,e,f,g,h,i,j},
{a->1-2 cijci+cijcij-2 cijcj+FA+FM-2 pA+2 cijci pA-2 FM pA+(pA^2)+FM (pA^2)+2 cicj (-1+pA) (-1+pM)+2 cij (-1+pA) (-1+pM)-2 pM+2 cijcj pM-2 FA pM+4 pA pM-2 (pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
b->-2 (-2 cijci+cijcij-cijcj+FM+2 cijci pA-2 FM pA+FM (pA^2)-pM+2 cijcj pM-FA pM+2 pA pM-(pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2)+cicj (-1+pA) (-1+2 pM)+cij (-1+pA) (-1+2 pM)),
c->cijcij+FM+2 cijci (-1+pA)-2 FM pA+FM (pA^2)-2 cicj pM-2 cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
d->-2 (-cijci+cijcij-2 cijcj+FA-pA+2 cijci pA-FM pA+(pA^2)+FM (pA^2)+cicj (-1+2 pA) (-1+pM)+cij (-1+2 pA) (-1+pM)+2 cijcj pM-2 FA pM+2 pA pM-2 (pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
e->2 (cijcij-cijcj-cicj pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM+2 cijcj pM-FA pM+pA pM+2 cicj pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cij (1-pM+pA (-1+2 pM))),
f->2 (cijcij-cijcj-cij pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cij pM+2 cijcj pM-FA pM+pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cicj (1-pM+pA (-1+2 pM))),
g->-2 (cijcij-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM-cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
h->cijcij+FA-2 cicj pA-2 cij pA+2 cijci pA+(pA^2)+FM (pA^2)+2 cijcj (-1+pM)-2 FA pM+2 cicj pA pM+2 cij pA pM-2 (pA^2) pM+FA (pM^2)+(pA^2) (pM^2),
i->-2 (cijcij-cicj pA-cij pA+2 cijci pA+FM (pA^2)-FA pM+2 cicj pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)+(pA^2) (pM^2)+cijcj (-1+2 pM)),
j->cijcij+2 cijci pA+FM (pA^2)+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)+(pA^2) (pM^2)}];

I can get the same thing as above from Sally's equations by doing the following, if I have the function 'subpD2' in the kernel (the first function converts a standard vector of parasite genotypes into the appropriate format to pass into Sally's functions):
convertToSallysNotation=Function[{a,b,c,d,e,f,g,h,i,j},{j,(g/2),(i/2),(e/2),c,(f/2),(b/2),h,(d/2),a}];
Apply[subpD2,convertToSallysNotation[(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3]),(Subscript[x, p,4]),(Subscript[x, p,5]),(Subscript[x, p,6]),(Subscript[x, p,7]),(Subscript[x, p,8]),(Subscript[x, p,9])]];

(*convertNotation={x44->(Subscript[x, p,0]),x24->((Subscript[x, p,1])/2),x22->(Subscript[x, p,2]),x34->((Subscript[x, p,3])/2),x14->((Subscript[x, p,4])/2),x23->((Subscript[x, p,5])/2),x12->((Subscript[x, p,6])/2),x33->(Subscript[x, p,7]),x13->((Subscript[x, p,8])/2),x11->(Subscript[x, p,9])};*)

Create a vector of genotype frequencies for the current generation, as well as the next generation:

currGen={(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3]),(Subscript[x, p,4]),(Subscript[x, p,5]),(Subscript[x, p,6]),(Subscript[x, p,7]),(Subscript[x, p,8]),(Subscript[x, p,9])};
nextGen={(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3]),(Subscript[n2x, p,4]),(Subscript[n2x, p,5]),(Subscript[n2x, p,6]),(Subscript[n2x, p,7]),(Subscript[n2x, p,8]),(Subscript[n2x, p,9])};

Again, the following is taken from Otto (2003). The first term in brackets (on each line) denotes the change in each disequilbrium term over a single generation (e.g., pA/.sub1 denotes the frequency of A in the next generation - and from it we subtract pA, the frequency of A in the current generation). All variables are then converted back into genotype frequencies by applying sub2. Lastly we switch from pA to (Subscript[δ, P]).

changeOfVarPARASITE=Apply[XtoD,currGen];
changeOfVarPARASITE2=Apply[DtoX,nextGen];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])];
changeOverOneGenP=Map[oneGenChangeP,{pA,pM,FA,FM,cij,cicj,cijcj,cijci,cijcij}];

Analysis of recursions

subsmall0={(Subscript[F, A,h])->FAh+(Subscript[F, A,h]),FA->a3+FA,FM->a4+FM,cij->a5+cij,cicj->a6+cicj,cijcj->a7+cijcj,cijci->a8+cijci,cijcij->a9+cijcij};

subsmall=Function[a,{(Subscript[F, A,h])->(Subscript[F, A,h])*(ϵ^a),FA->FA*(ϵ^a),FM->FM*(ϵ^a),cij->cij*(ϵ^a),cicj->cicj*(ϵ^a),cijcj->cijcj*(ϵ^a),cijci->cijci*(ϵ^a),cijcij->cijcij*(ϵ^a),(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={FAh->0,a3->0,a4->0,a5->0,a6->0,a7->0,a8->0,a9->0};

eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]
Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Simplify//Flatten

eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={(Subscript[F, A,h])->0,FA->0,FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Kept order  ϵ  terms in the associations

toorder=1;

qlesoln={(Subscript[F, A,h])->0,FA->0,FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};
suba={FAh->(Subscript[F, A,h]),a3->FA,a4->FM,a5->cij,a6->cicj,a7->cijcj,a8->cijci,a9->cijcij}/.qlesoln;

eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]
Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Flatten//Simplify

Solve[eqn3==0,FA]//Flatten

This can be written as:

(FA/.%) - (((1-(Subscript[ψ, p])))/(Subscript[ψ, p]))(Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p]))((Subscript[x, h,0])+(Subscript[x, h,2])) (pA^2)(((1-pA))^2)/.pA->(Subscript[δ, p])+1/2/.changeOfVarHOST//Factor

eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={FA->(Subscript[F, A,p]),FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=-(1/8) (-1+pM) pM ((-1+2 pM) (Subscript[Δ, Mm])-pM (Subscript[Δ, MM])) (8 (Subscript[s, fl])-(Subscript[β, p]) (-7-16 (Subscript[δ, h]) (Subscript[δ, p])+4 (Subscript[F, A,h])+4 (Subscript[δ, p]^2) (1+4 (Subscript[F, A,h]))+4 (Subscript[F, A,p])+16 (Subscript[F, A,h]) (Subscript[F, A,p])+4 (Subscript[δ, h]^2) (1+4 (Subscript[δ, p]^2)+4 (Subscript[F, A,p])))-(Subscript[α, p]) (-16 (Subscript[δ, h]) (Subscript[δ, p])+4 (Subscript[δ, h]^2) (1+4 (Subscript[δ, p]^2)+4 (Subscript[F, A,p]))+(1+4 (Subscript[F, A,h])) (1+4 (Subscript[δ, p]^2)+4 (Subscript[F, A,p]))));

Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM

(Subscript[w, mm])=(fit[0]*(Subscript[x, p,0])+fit[3]*(Subscript[x, p,3])+fit[7]*(Subscript[x, p,7]))/((Subscript[x, p,0])+(Subscript[x, p,3])+(Subscript[x, p,7]));
(Subscript[w, Mm])=(fit[1]*(Subscript[x, p,1])+fit[4]*(Subscript[x, p,4])+fit[5]*(Subscript[x, p,5])+fit[8]*(Subscript[x, p,8]))/((Subscript[x, p,1])+(Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]));
(Subscript[w, MM])=(fit[2]*(Subscript[x, p,2])+fit[6]*(Subscript[x, p,6])+fit[9]*(Subscript[x, p,9]))/((Subscript[x, p,2])+(Subscript[x, p,6])+(Subscript[x, p,9]));

(Subscript[x, M])=((Subscript[x, p,1])/2)+(Subscript[x, p,2])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,6])+((Subscript[x, p,8])/2)+(Subscript[x, p,9]);
(Subscript[x, m])=(Subscript[x, p,0])+((Subscript[x, p,1])/2)+(Subscript[x, p,3])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,7])+((Subscript[x, p,8])/2);

(Subscript[w, M])=(Subscript[x, M]) (Subscript[w, MM])+(Subscript[x, m]) (Subscript[w, Mm]);
(Subscript[w, m])=(Subscript[x, M]) (Subscript[w, Mm])+(Subscript[x, m]) (Subscript[w, mm]);

qlesoln={FA->(Subscript[F, A,p]),FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0,FAh->(Subscript[F, A,h])};
orderAssumptions={(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ};

Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.Apply[XtoD,currGen]/.changeOfVarHOST/.qlesoln/.{pA->(Subscript[δ, p])+1/2,(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) ,(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])}/.orderAssumptions,{ϵ,0,2}]]/.ϵ->1//Simplify

So our invasion term to put in ms (Table 2) is
(((Subscript[α, p])-7 (Subscript[β, p]))/8)-(1/2)  ((Subscript[α, p])+(Subscript[β, p])) (4 (Subscript[δ, h]) (Subscript[δ, p])(1-(Subscript[δ, h])(Subscript[δ, p]))-(Subscript[δ, h]^2)-(Subscript[δ, p]^2) )
And with  (Subscript[F, A,p]) and (Subscript[F, A,h])
(((Subscript[α, p])-7 (Subscript[β, p]))/8)-(1/2) ((Subscript[α, p])+(Subscript[β, p])) ((4 (Subscript[δ, h]) (Subscript[δ, p])(1-(Subscript[δ, h])(Subscript[δ, p]))-(Subscript[δ, h]^2)-(Subscript[δ, p]^2) )- ((1+4 (Subscript[δ, h]^2)) (Subscript[F, A,p])+(Subscript[F, A,h]) (1+4 (Subscript[δ, p]^2))+4 (Subscript[F, A,h]) (Subscript[F, A,p])))
Where (Subscript[F, A,h])=2(Subscript[f, mm]) (Subscript[α, h])(((1/4-(Subscript[δ, h]^2)))^2) (3/4-(Subscript[δ, p]^2)) (1-(Subscript[ψ, h]))/(Subscript[ψ, h])
 and (Subscript[F, A,p])=2(Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p])) (((1/4-(Subscript[δ, p]^2)))^2)(1/4+(Subscript[δ, h]^2))(1-(Subscript[ψ, p])) /(Subscript[ψ, p])

GFG

Haploid Host/Haploid Parasite

Fitness Functions:

Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
Host genotypes: 0 = a, 1=A

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

(Subscript[w, i,j]) is the fitness genotype i in is j of species the  (Subscript[w, i,j])

wmat=(1+(({{(Subscript[α, p]), -(Subscript[β, p])}, {(Subscript[α, p]), (Subscript[α, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])}}-{{0},{(Subscript[c, p1])}};

wmat

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, m]),1], 
j==1,total[(Subscript[f, M]),1],
j==2,total[(Subscript[f, m]),2]-(Subscript[c, p2]),
j==3,total[(Subscript[f, M]),2]-(Subscript[c, p2])];

The below commented out code is to rescale the costs and alpha_p by the beta_p so that the the right entry of wmat is just 1... yields the same outcome, but demonstrates that the lack of beta_p in the delta_p solution is not a mistake

(*sub=Flatten[Simplify[Solve[{(1+(Subscript[α, p]))==(1+(Subscript[sα, p]))/(1-(Subscript[sβ, p])),(Subscript[c, p1])==(Subscript[sc, p1])/(1-(Subscript[sβ, p])),(Subscript[c, p2])==(Subscript[sc, p2])/(1-(Subscript[sβ, p])),(Subscript[β, p])==0},{(Subscript[α, p]),(Subscript[β, p]),(Subscript[c, p1]),(Subscript[c, p2])}]]]
sub2={(Subscript[sα, p])->(Subscript[α, p]),(Subscript[sβ, p])->(Subscript[β, p]),(Subscript[sc, p1])->(Subscript[c, p1]),(Subscript[sc, p2])->(Subscript[c, p2]),(Subscript[c, p2])->0}
total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, m]),1]/.sub/.sub2, 
j==1,total[(Subscript[f, M]),1]/.sub/.sub2,
j==2,total[(Subscript[f, m]),2]-(Subscript[c, p2])/.sub/.sub2,
j==3,total[(Subscript[f, M]),2]-(Subscript[c, p2])/.sub/.sub2];*)

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= If[j==0, 1-(Subscript[α, h])((Subscript[f, m])*((Subscript[x, p,0])+(Subscript[x, p,2]))+(Subscript[f, M])*((Subscript[x, p,1])+(Subscript[x, p,3]))), 1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,2])+(Subscript[f, M])*(Subscript[x, p,3]))-(Subscript[c, h])];

(Subscript[(OverBar[w]), h])=(∑_(j=0)^1)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^3)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

(Subscript[(OverBar[w]), i]) is the mean fitness of species i
(Subscript[x, i,j]) is frequency of genotype j in species i

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.

(Subscript[n2x, p,j_])=If[j==1||j==2,
(Subscript[n1x, p,j])+ (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2])),
(Subscript[n1x, p,j])- (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2]))
];
(Subscript[n2x, h,j_])=(Subscript[n1x, h,j]);

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))
	  (Subscript[c, p1])/(1+(Subscript[s, fl])) -> (Subscript[cn, p1])
	  (Subscript[c, p2])/(1+(Subscript[s, fl])) -> (Subscript[cn, p2])

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))/.(Subscript[c, p2])->(Subscript[cn, p2])(1+(Subscript[s, fl]))/.(Subscript[c, p1])->(Subscript[cn, p1])(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[c, p2])->(Subscript[cn, p2])/.(Subscript[c, p1])->(Subscript[cn, p1])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the GFG model.

Change of variables

The new variables are defined by: (Subscript[δ, i])=((Subscript[x, i,2])+(Subscript[x, i,3]))-1/2
(Subscript[p, M])=(Subscript[x, i,1])+(Subscript[x, i,3])
(Subscript[D, i])=(Subscript[x, i,0])(Subscript[x, i,3])-(Subscript[x, i,1])(Subscript[x, i,2])which translates into:

changeOfVarHOST=Solve[{(Subscript[δ, h])==(Subscript[x, h,1])-1/2,(Subscript[x, h,0])+(Subscript[x, h,1])==1},{(Subscript[x, h,0]),(Subscript[x, h,1])}]//Simplify//Flatten
changeOfVarPARASITE=Solve[{(Subscript[δ, p])==((Subscript[x, p,2])+(Subscript[x, p,3]))-1/2,(Subscript[p, M])==(Subscript[x, p,1])+(Subscript[x, p,3]),(Subscript[D, p])==(Subscript[x, p,0])(Subscript[x, p,3])-(Subscript[x, p,1])(Subscript[x, p,2]),(Subscript[x, p,0])+(Subscript[x, p,1])+(Subscript[x, p,2])+(Subscript[x, p,3])==1},{(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3])}]//Simplify//Flatten

changeOfVarHOST2=Solve[{(Subscript[δ, h])==(Subscript[n2x, h,1])-1/2,(Subscript[n2x, h,0])+(Subscript[n2x, h,1])==1},{(Subscript[δ, h])}]//Simplify//Flatten
changeOfVarPARASITE2=Solve[{(Subscript[δ, p])==((Subscript[n2x, p,2])+(Subscript[n2x, p,3]))-1/2,(Subscript[p, M])==(Subscript[n2x, p,1])+(Subscript[n2x, p,3]),(Subscript[D, p])==(Subscript[n2x, p,0])(Subscript[n2x, p,3])-(Subscript[n2x, p,1])(Subscript[n2x, p,2]),(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])==1},{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}]//Simplify//Flatten

oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h])}];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE];
changeOverOneGenP=Map[oneGenChangeP,{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}];

Analysis of recursions

subsmall0={(Subscript[D, p])->d+(Subscript[D, p])};

Order assumptions are also included in the following substitution:

subsmall=Function[a,{(Subscript[D, p])->(Subscript[D, p])*(ϵ^a),(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M]) ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ, (Subscript[α, p])->(Subscript[α, p])ϵ, (Subscript[β, p])->(Subscript[β, p])ϵ, (Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[c, h])->(Subscript[c, h])ϵ,(Subscript[c, p1])->(Subscript[c, p1])ϵ,(Subscript[c, p2])->(Subscript[c, p2])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={d->0};

eqn1=subAndSeriesP[1,toorder]

eqn2=subAndSeriesP[2,toorder]

eqn3=subAndSeriesP[3,toorder]

Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Kept order  ϵ  terms in the associations

toorder = 1;

qlesoln={(Subscript[D, p])->0};
suba={d->(Subscript[D, p])}/.qlesoln;

eqn1H = subAndSeriesH[1, toorder]
eqn1P = subAndSeriesP[1, toorder]

Solve[eqn1H==0,(Subscript[δ, p])]
Solve[eqn1P==0,(Subscript[δ, h])]

Solve[{(Subscript[sα, p])==(1+(Subscript[α, p]))/(1-(Subscript[β, p]))-1,-(Subscript[sc, p1])==(1-(Subscript[c, p1]))/(1-(Subscript[β, p]))-1,-(Subscript[sc, p2])==(1-(Subscript[c, p2]))/(1-(Subscript[β, p]))-1,(Subscript[sβ, p])==0},{(Subscript[α, p]),(Subscript[c, p1]),(Subscript[c, p2])}]

{((-2 (Subscript[c, h])+(Subscript[f, m]) (Subscript[α, h]))/(2 (Subscript[f, m]) (Subscript[α, h]))),((2 (Subscript[c, p2])+2 (Subscript[c, p1]) (Subscript[f, m])-(Subscript[f, m]) (Subscript[α, p])-(Subscript[f, m]) (Subscript[β, p]))/(2 (Subscript[f, m]) ((Subscript[α, p])+(Subscript[β, p]))))}/.(Subscript[f, m])->1/.{(Subscript[α, p])->(Subscript[sα, p])-(Subscript[β, p])-(Subscript[sα, p]) (Subscript[β, p]),(Subscript[c, p1])->(Subscript[sc, p1])+(Subscript[β, p])-(Subscript[sc, p1]) (Subscript[β, p]),(Subscript[c, p2])->(Subscript[sc, p2])+(Subscript[β, p])-(Subscript[sc, p2]) (Subscript[β, p])}//Factor

deltaSolns={(Subscript[δ, p])->((-2 (Subscript[c, h])+(Subscript[f, m]) (Subscript[α, h]))/(2 (Subscript[f, m]) (Subscript[α, h]))),(Subscript[δ, h])->((2 (Subscript[c, p2])+2 (Subscript[c, p1]) (Subscript[f, m])-(Subscript[f, m]) (Subscript[α, p])-(Subscript[f, m]) (Subscript[β, p]))/(2 (Subscript[f, m]) ((Subscript[α, p])+(Subscript[β, p]))))};

eqn2 = subAndSeriesP[2,toorder]

eqn3 = subAndSeriesP[3,toorder]/.ϵ->1

Solve[eqn3==0,(Subscript[D, p])]//Flatten

qlesoln={(Subscript[D, p])->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=(1/4) (-1+(Subscript[p, M])) (Subscript[p, M]) (4 (Subscript[s, fl])-3 (Subscript[α, p])+(Subscript[β, p])+2 (Subscript[α, p]) (Subscript[δ, h])+2 (Subscript[β, p]) (Subscript[δ, h])-2 (Subscript[α, p]) (Subscript[δ, p])-2 (Subscript[β, p]) (Subscript[δ, p])-4 (Subscript[α, p]) (Subscript[δ, h]) (Subscript[δ, p])-4 (Subscript[β, p]) (Subscript[δ, h]) (Subscript[δ, p])+(Subscript[c, p1]) (2+4 (Subscript[δ, p]))) (Subscript[Δ, M]);

Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
Host genotypes: 0 = a, 1=A

(Subscript[w, m])=((Subscript[w, p,0])*(Subscript[x, p,0])+(Subscript[w, p,2])*(Subscript[x, p,2]))/((Subscript[x, p,0])+(Subscript[x, p,2]));
(Subscript[w, M])=((Subscript[w, p,1])*(Subscript[x, p,1])+(Subscript[w, p,3])*(Subscript[x, p,3]))/((Subscript[x, p,1])+(Subscript[x, p,3]));

qlesoln={(Subscript[D, p])->0};
orderAssumptions=subsmall[1]

diffw = Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.changeOfVarPARASITE/.changeOfVarHOST/.qlesoln/.orderAssumptions,{ϵ,0,2}]]/.ϵ->1//Simplify

So our invasion term to put in ms (Table 2) is:
(1/4)(3 (Subscript[α, p])- (Subscript[β, p])+2((Subscript[α, p])+ (Subscript[β, p]))((Subscript[δ, p])-(Subscript[δ, h]) (1-2 (Subscript[δ, p])))-2(Subscript[c, p1]) (1+2 (Subscript[δ, p])))

-2 (Subscript[δ, h])+2 (Subscript[δ, p])+4 (Subscript[δ, h]) (Subscript[δ, p])//Simplify

(1/4)((Subscript[α, p]) (3-2 (Subscript[δ, h])+2 (Subscript[δ, p])+4 (Subscript[δ, h]) (Subscript[δ, p]))-(Subscript[β, p]) (1+2 (Subscript[δ, h])-2 (Subscript[δ, p])-4 (Subscript[δ, h]) (Subscript[δ, p]))-(Subscript[c, p1]) (2+4 (Subscript[δ, p])))-((1/4)(3 (Subscript[α, p])- (Subscript[β, p])+2((Subscript[α, p])+ (Subscript[β, p]))((Subscript[δ, p])-(Subscript[δ, h]) (1-2 (Subscript[δ, p])))-(Subscript[c, p1]) (2+4 (Subscript[δ, p]))))//Simplify

So our invasion term to put in R is:
(1/4) ((Subscript[α, p]) (3-2 (Subscript[δ, h])+2 (Subscript[δ, p])+4 (Subscript[δ, h]) (Subscript[δ, p]))-(Subscript[β, p]) (1+2 (Subscript[δ, h])-2 (Subscript[δ, p])-4 (Subscript[δ, h]) (Subscript[δ, p]))-(Subscript[c, p1]) (2+4 (Subscript[δ, p])))

deltaSolns={(Subscript[δ, p])->((-2 (Subscript[c, h])+(Subscript[f, m]) (Subscript[α, h]))/(2 (Subscript[f, m]) (Subscript[α, h]))),(Subscript[δ, h])->((2 (Subscript[c, p2])+2 (Subscript[c, p1]) (Subscript[f, m])-(Subscript[f, m]) (Subscript[α, p])-(Subscript[f, m]) (Subscript[β, p]))/(2 (Subscript[f, m]) ((Subscript[α, p])+(Subscript[β, p]))))};

qlesoln={(Subscript[D, p])->0};
orderAssumptions={(Subscript[D, p])->ϵ (Subscript[D, p]),(Subscript[f, M])->(Subscript[f, m])+ϵ (Subscript[Δ, M]),(Subscript[α, h])->ϵ (Subscript[α, h]),(Subscript[α, p])->ϵ (Subscript[α, p]),(Subscript[β, p])->ϵ (Subscript[β, p]),(Subscript[s, fl])->ϵ (Subscript[s, fl]),(Subscript[c, h])->ϵ (Subscript[c, h]),(Subscript[c, p1])->ϵ (Subscript[c, p1]),(Subscript[c, p2])->ϵ (Subscript[c, p2])};

wpbar=(Subscript[(OverBar[w]), p])/.changeOfVarPARASITE/.changeOfVarHOST/.deltaSolns/.qlesoln/.orderAssumptions;

Normal[Series[wpbar,{ϵ,0,2}]]//Simplify

Then with the delta solutions:

diffw = Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.changeOfVarPARASITE/.changeOfVarHOST/.qlesoln/.deltaSolns/.orderAssumptions,{ϵ,0,2}]]/.ϵ->1//Simplify

diffw=-((((Subscript[c, h]) (Subscript[c, p2])+(Subscript[f, m]^2) (Subscript[α, h]) ((Subscript[c, p1])+(Subscript[s, fl])-(Subscript[α, p]))))/((Subscript[f, m]^2) (Subscript[α, h])));

For cP1 plots:

Normal[Series[diffw/.(Subscript[c, p2])->0/.(Subscript[s, fl])->0,{(Subscript[f, m]),0,-1}]]
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;
Normal[Series[diffw/.(Subscript[c, p2])->0/.(Subscript[s, fl])->0,{(Subscript[f, m]),1,0}]]//Simplify
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;

For cP2 plots:

Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, m]),0,-1}]]
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, m]),1,0}]]//Simplify
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;

-(((Subscript[c, h]) (Subscript[c, p2]))/(Subscript[α, h]))+(Subscript[α, p])/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.01
-(((Subscript[c, h]) (Subscript[c, p2]))/(Subscript[α, h]))+(Subscript[α, p])/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.05

Haploid Host/Diploid Parasite

Fitness Functions:

Host genotypes: 0 = a, 1=A
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes: 0 = am, 1=aM, 2=Am, 3=AM
(Subscript[x, i,j]) is frequency of genotype j in species i

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

wmat=(1+(({{(Subscript[α, p]), -(Subscript[β, p])}, {(Subscript[α, p]), (Subscript[α, p])}, {(Subscript[α, p]), (Subscript[α, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])}}-{{0},{(Subscript[c, p1])},{(Subscript[c, p1])}};

(Subscript[w, i,j]) is the fitness of genotype j in species i

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, mm]),1], 
j==1,total[(Subscript[f, Mm]),1],
j==2,total[(Subscript[f, MM]),1],
j==3,total[(Subscript[f, mm]),2]-(Subscript[c, p2]),
j==4,total[(Subscript[f, Mm]),2]-(Subscript[c, p2]),
j==5,total[(Subscript[f, Mm]),2]-(Subscript[c, p2]),
j==6,total[(Subscript[f, MM]),2]-(Subscript[c, p2]),
j==7,total[(Subscript[f, mm]),3]-(Subscript[c, p2]),
j==8,total[(Subscript[f, Mm]),3]-(Subscript[c, p2]),
j==9,total[(Subscript[f, MM]),3]-(Subscript[c, p2])];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= If[j==0,1-(Subscript[α, h])((Subscript[f, mm])((Subscript[x, p,0])+(Subscript[x, p,3])+(Subscript[x, p,7]))+(Subscript[f, Mm])((Subscript[x, p,1])+(Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]))+(Subscript[f, MM])((Subscript[x, p,2])+(Subscript[x, p,6])+(Subscript[x, p,9]))), 1-(Subscript[α, h])((Subscript[f, mm])((Subscript[x, p,3])+(Subscript[x, p,7]))+(Subscript[f, Mm])((Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]))+(Subscript[f, MM])((Subscript[x, p,6])+(Subscript[x, p,9])))-(Subscript[c, h])];

(Subscript[(OverBar[w]), i]) is the mean fitness of species i

(Subscript[(OverBar[w]), h])=(∑_(j=0)^1)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^9)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.
Host genotypes : 0 = aa, 1 = Aa, 2 = AA
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes : 0 = am, 1 = aM, 2 = Am, 3 = AM

Hosts

(Subscript[n2x, h,j_])=(Subscript[n1x, h,j]);

Parasites

rMatrix={
{1,0,0,0},
{(1/2),(1/2),0,0},
{0,1,0,0},
{(1/2),0,(1/2),0},
{((1-r)/2),(r/2),(r/2),((1-r)/2)},
{(r/2),((1-r)/2),((1-r)/2),(r/2)},
{0,(1/2),0,(1/2)},
{0,0,1,0},
{0,0,(1/2),(1/2)},
{0,0,0,1}};

PGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, p,0])},{(Subscript[n1x, p,1])},{(Subscript[n1x, p,2])},{(Subscript[n1x, p,3])},{(Subscript[n1x, p,4])},{(Subscript[n1x, p,5])},{(Subscript[n1x, p,6])},{(Subscript[n1x, p,7])},{(Subscript[n1x, p,8])},{(Subscript[n1x, p,9])}}]).rMatrix];
gamete[j_]=Which[
j==0, PGameteFreqs[[1]],
j==1,PGameteFreqs[[2]],
j==2, PGameteFreqs[[3]],
j==3, PGameteFreqs[[4]]
];

am=0;aM=1;Am=2;AM=3;
(Subscript[n2x, p,j_])=Which[
j==0,(1-(Subscript[ψ, p])) (Subscript[n1x, p,0])+(Subscript[ψ, p]) gamete[am].gamete[am], 
j==1,(1-(Subscript[ψ, p])) (Subscript[n1x, p,1])+(Subscript[ψ, p]) 2 gamete[aM].gamete[am],
j==2,(1-(Subscript[ψ, p])) (Subscript[n1x, p,2])+(Subscript[ψ, p]) gamete[aM].gamete[aM],
j==3,(1-(Subscript[ψ, p])) (Subscript[n1x, p,3])+(Subscript[ψ, p]) 2 gamete[Am].gamete[am],
j==4,(1-(Subscript[ψ, p])) (Subscript[n1x, p,4])+(Subscript[ψ, p]) 2 gamete[AM].gamete[am],
j==5,(1-(Subscript[ψ, p])) (Subscript[n1x, p,5])+(Subscript[ψ, p]) 2 gamete[Am].gamete[aM],
j==6,(1-(Subscript[ψ, p])) (Subscript[n1x, p,6])+(Subscript[ψ, p]) 2 gamete[AM].gamete[aM],
j==7,(1-(Subscript[ψ, p])) (Subscript[n1x, p,7])+(Subscript[ψ, p]) gamete[Am].gamete[Am],
j==8,(1-(Subscript[ψ, p])) (Subscript[n1x, p,8])+(Subscript[ψ, p]) 2 gamete[AM].gamete[Am],
j==9,(1-(Subscript[ψ, p])) (Subscript[n1x, p,9])+(Subscript[ψ, p]) gamete[AM].gamete[AM]
];

Check that things sum to 1 as they should:
(Subscript[n2x, h,0])+(Subscript[n2x, h,1])//Simplify
(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])+(Subscript[n2x, p,4])+(Subscript[n2x, p,5])+(Subscript[n2x, p,6])+(Subscript[n2x, p,7])+(Subscript[n2x, p,8])+(Subscript[n2x, p,9])//Simplify

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))
	  (Subscript[c, p1])/(1+(Subscript[s, fl])) -> (Subscript[cn, p1])
	  (Subscript[c, p2])/(1+(Subscript[s, fl])) -> (Subscript[cn, p2])

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))/.(Subscript[c, p2])->(Subscript[cn, p2])(1+(Subscript[s, fl]))/.(Subscript[c, p1])->(Subscript[cn, p1])(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[c, p2])->(Subscript[cn, p2])/.(Subscript[c, p1])->(Subscript[cn, p1])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the GFG model.

Change of variables

Host genotypes: 0 = a, 1=A
Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM
Parasite genotypes: x44=0 = aamm, 2 x24 = 1 = aaMm, x22 = 2 = aaMM, 2 x34 = 3 = Aamm, 2 x14 = 4 = AaMm, 2 x23 = 5 = AamM, 2 x12=6 = AaMM, 2 x33=7 = AAmm, 2 x13=8 = AAMm, x11=9 = AAMM
Parasite haplotypes: 0 = am, 1 = aM, 2 = Am, 3 = AM

changeOfVarHOST=Solve[{(Subscript[δ, h])==(Subscript[x, h,1])-1/2,(Subscript[x, h,0])+(Subscript[x, h,1])==1},{(Subscript[x, h,0]),(Subscript[x, h,1])}]//Simplify//Flatten;
changeOfVarHOST2=Solve[{(Subscript[δ, h])==(Subscript[n2x, h,1])-1/2,(Subscript[n2x, h,0])+(Subscript[n2x, h,1])==1},{(Subscript[δ, h])}]//Simplify//Flatten;
oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h])}];

DtoX=Function[{a,b,c,d,e,f,g,h,i,j},
Block[{pA1=((d/2)+(e/2)+(f/2)+(g/2)+h+i+j),pM1=((b/2)+c+(e/2)+(f/2)+g+(i/2)+j)},
{1->a+b+c+d+e+f+g+h+i+j,
pA->(d/2)+(e/2)+(f/2)+(g/2)+h+i+j,
pM->(b/2)+c+(e/2)+(f/2)+g+(i/2)+j,
FA->(h+(i/2)) (((1-pA1))^2)+((i/2)+j) (((1-pA1))^2)-((d/2)+(e/2)) (1-pA1) pA1-((d/2)+(f/2)) (1-pA1) pA1-((e/2)+(g/2)) (1-pA1) pA1-((f/2)+(g/2)) (1-pA1) pA1+(a+(b/2)) (((pA1))^2)+((b/2)+c) (pA1^2),
FM->(c+(g/2)) (((1-pM1))^2)+((g/2)+j) (((1-pM1))^2)-((b/2)+(e/2)) (1-pM1) pM1-((b/2)+(f/2)) (1-pM1) pM1-((e/2)+(i/2)) (1-pM1) pM1-((f/2)+(i/2)) (1-pM1) pM1+(a+(d/2)) (pM1^2)+((d/2)+h) (pM1^2),
cijcij->j (((1-pA1))^2) (((1-pM1))^2)-g (1-pA1) pA1 (((1-pM1))^2)+c (pA1^2) (((1-pM1))^2)-i (((1-pA1))^2) (1-pM1) pM1+e (1-pA1) pA1 (1-pM1) pM1+f (1-pA1) pA1 (1-pM1) pM1-b (pA1^2) (1-pM1) pM1+h (((1-pA1))^2) (pM1^2)-d (1-pA1) pA1 (pM1^2)+a (pA1^2) (pM1^2),
cijci->((g/2)+j) (1-pA1) (((1-pM1))^2)-(c+(g/2)) pA1 (((1-pM1))^2)-((e/2)+(i/2)) (1-pA1) (1-pM1) pM1-((f/2)+(i/2)) (1-pA1) (1-pM1) pM1+((b/2)+(e/2)) pA1 (1-pM1) pM1+((b/2)+(f/2)) pA1 (1-pM1) pM1+((d/2)+h) (1-pA1) (pM1^2)-(a+(d/2)) pA1 (pM1^2),
cijcj->((i/2)+j) (((1-pA1))^2) (1-pM1)-((e/2)+(g/2)) (1-pA1) pA1 (1-pM1)-((f/2)+(g/2)) (1-pA1) pA1 (1-pM1)+((b/2)+c) (pA1^2) (1-pM1)-(h+(i/2)) (((1-pA1))^2) pM1+((d/2)+(e/2)) (1-pA1) pA1 pM1+((d/2)+(f/2)) (1-pA1) pA1 pM1-(a+(b/2)) (pA1^2) pM1,
cicj->((f/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(e/2)+(g/2)) pA1 (1-pM1)-((d/2)+(e/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(f/2)) pA1 pM1,
cij->((e/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(f/2)+(g/2)) pA1 (1-pM1)-((d/2)+(f/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(e/2)) pA1 pM1}]];

XtoD=Function[{a,b,c,d,e,f,g,h,i,j},
{a->1-2 cijci+cijcij-2 cijcj+FA+FM-2 pA+2 cijci pA-2 FM pA+(pA^2)+FM (pA^2)+2 cicj (-1+pA) (-1+pM)+2 cij (-1+pA) (-1+pM)-2 pM+2 cijcj pM-2 FA pM+4 pA pM-2 (pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
b->-2 (-2 cijci+cijcij-cijcj+FM+2 cijci pA-2 FM pA+FM (pA^2)-pM+2 cijcj pM-FA pM+2 pA pM-(pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2)+cicj (-1+pA) (-1+2 pM)+cij (-1+pA) (-1+2 pM)),
c->cijcij+FM+2 cijci (-1+pA)-2 FM pA+FM (pA^2)-2 cicj pM-2 cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
d->-2 (-cijci+cijcij-2 cijcj+FA-pA+2 cijci pA-FM pA+(pA^2)+FM (pA^2)+cicj (-1+2 pA) (-1+pM)+cij (-1+2 pA) (-1+pM)+2 cijcj pM-2 FA pM+2 pA pM-2 (pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
e->2 (cijcij-cijcj-cicj pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM+2 cijcj pM-FA pM+pA pM+2 cicj pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cij (1-pM+pA (-1+2 pM))),
f->2 (cijcij-cijcj-cij pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cij pM+2 cijcj pM-FA pM+pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cicj (1-pM+pA (-1+2 pM))),
g->-2 (cijcij-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM-cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
h->cijcij+FA-2 cicj pA-2 cij pA+2 cijci pA+(pA^2)+FM (pA^2)+2 cijcj (-1+pM)-2 FA pM+2 cicj pA pM+2 cij pA pM-2 (pA^2) pM+FA (pM^2)+(pA^2) (pM^2),
i->-2 (cijcij-cicj pA-cij pA+2 cijci pA+FM (pA^2)-FA pM+2 cicj pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)+(pA^2) (pM^2)+cijcj (-1+2 pM)),
j->cijcij+2 cijci pA+FM (pA^2)+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)+(pA^2) (pM^2)}];

currGen={(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3]),(Subscript[x, p,4]),(Subscript[x, p,5]),(Subscript[x, p,6]),(Subscript[x, p,7]),(Subscript[x, p,8]),(Subscript[x, p,9])};
nextGen={(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3]),(Subscript[n2x, p,4]),(Subscript[n2x, p,5]),(Subscript[n2x, p,6]),(Subscript[n2x, p,7]),(Subscript[n2x, p,8]),(Subscript[n2x, p,9])};

changeOfVarPARASITE=Apply[XtoD,currGen];
changeOfVarPARASITE2=Apply[DtoX,nextGen];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])];
changeOverOneGenP=Map[oneGenChangeP,{pA,pM,FA,FM,cij,cicj,cijcj,cijci,cijcij}];

Analysis of recursions

Order assumptions are also included in the following substitution:

subsmall0={FA->a3+FA,FM->a4+FM,cij->a5+cij,cicj->a6+cicj,cijcj->a7+cijcj,cijci->a8+cijci,cijcij->a9+cijcij};

subsmall=Function[a,{FA->FA*(ϵ^a),FM->FM*(ϵ^a),cij->cij*(ϵ^a),cicj->cicj*(ϵ^a),cijcj->cijcj*(ϵ^a),cijci->cijci*(ϵ^a),cijcij->cijcij*(ϵ^a),(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[c, h])->(Subscript[c, h])ϵ,(Subscript[c, p1])->(Subscript[c, p1])ϵ,(Subscript[c, p2])->(Subscript[c, p2])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={a3->0,a4->0,a5->0,a6->0,a7->0,a8->0,a9->0};

eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]

qlesoln=Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Simplify//Flatten

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Kept order  ϵ  terms in the associations

toorder=1;

qlesoln={FA->0,FM->0,cijcj->0,cijci->0,cijcij->0,cicj->0,cij->0};
suba={a3->FA,a4->FM,a5->cij,a6->cicj,a7->cijcj,a8->cijci,a9->cijcij}/.qlesoln;

eqn1H=subAndSeriesH[1,toorder]
eqn1P=subAndSeriesP[1,toorder]

Solve[eqn1H==0,(Subscript[δ, p])]//Simplify//Flatten
Solve[eqn1P==0,(Subscript[δ, h])]/.%//Simplify//Flatten

deltaSolns={(Subscript[δ, p])->(1/2)-((Sqrt[(Subscript[c, h])])/((Sqrt[(Subscript[f, mm])]) (Sqrt[(Subscript[α, h])]))),(Subscript[δ, h])->((2 (Subscript[c, p2])+(Subscript[f, mm]) (2 (Subscript[c, p1])-(Subscript[α, p])-(Subscript[β, p])))/(2 (Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p]))))};

eqn2=subAndSeriesP[2,toorder]
eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]

Solve[eqn3==0,FA]//Flatten//Simplify

qlesoln =Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Flatten//Simplify

qlesoln={cij->0,FA->-(((2 (Subscript[c, p2])+(Subscript[f, mm]) (2 (Subscript[c, p1])-((Subscript[α, p])+(Subscript[β, p])) (1+2 (Subscript[δ, h])))) (((1-4 (Subscript[δ, p]^2)))^2) (-1+(Subscript[ψ, p])))/(32 (Subscript[ψ, p]))),FM->0,cijcj->0,cijci->0,cijcij->0,cicj->0};

modChange=FullSimplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=(1/8) (1-pM) pM (8 (Subscript[s, fl])-7 (Subscript[α, p])+(Subscript[β, p])+2 ((Subscript[α, p])+(Subscript[β, p])) (Subscript[δ, h])+4 ((Subscript[α, p])+(Subscript[β, p])) (1+2 (Subscript[δ, h])) (-1+(Subscript[δ, p])) (Subscript[δ, p])+(Subscript[c, p1]) (6-8 (-1+(Subscript[δ, p])) (Subscript[δ, p]))) ((-1+2 pM) (Subscript[Δ, Mm])-pM (Subscript[Δ, MM]))

Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM

(Subscript[w, mm])=(fit[0]*(Subscript[x, p,0])+fit[3]*(Subscript[x, p,3])+fit[7]*(Subscript[x, p,7]))/((Subscript[x, p,0])+(Subscript[x, p,3])+(Subscript[x, p,7]));
(Subscript[w, Mm])=(fit[1]*(Subscript[x, p,1])+fit[4]*(Subscript[x, p,4])+fit[5]*(Subscript[x, p,5])+fit[8]*(Subscript[x, p,8]))/((Subscript[x, p,1])+(Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]));
(Subscript[w, MM])=(fit[2]*(Subscript[x, p,2])+fit[6]*(Subscript[x, p,6])+fit[9]*(Subscript[x, p,9]))/((Subscript[x, p,2])+(Subscript[x, p,6])+(Subscript[x, p,9]));

(Subscript[x, M])=((Subscript[x, p,1])/2)+(Subscript[x, p,2])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,6])+((Subscript[x, p,8])/2)+(Subscript[x, p,9]);
(Subscript[x, m])=(Subscript[x, p,0])+((Subscript[x, p,1])/2)+(Subscript[x, p,3])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,7])+((Subscript[x, p,8])/2);

(Subscript[w, M])=(Subscript[x, M]) (Subscript[w, MM])+(Subscript[x, m]) (Subscript[w, Mm]);
(Subscript[w, m])=(Subscript[x, M]) (Subscript[w, Mm])+(Subscript[x, m]) (Subscript[w, mm]);

qlesoln={cij->0,FA->(Subscript[F, A,p]),FM->0,cijcj->0,cijci->0,cijcij->0,cicj->0};
orderAssumptions={(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[c, h])->(Subscript[c, h])ϵ,(Subscript[c, p1])->(Subscript[c, p1])ϵ,(Subscript[c, p2])->(Subscript[c, p2])ϵ};

diffw=Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.Apply[XtoD,currGen]/.changeOfVarHOST/.qlesoln/.{pA->(Subscript[δ, p])+1/2,(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]),(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])}/.orderAssumptions,{ϵ,0,2}]]//FullSimplify

So our invasion term to put in ms (Table 2) is
(1/8) (7 (Subscript[α, p])-(Subscript[β, p]))+((Subscript[α, p])+(Subscript[β, p])) (2 (1+2 (Subscript[δ, h])) (1-(Subscript[δ, p])) (Subscript[δ, p])-(Subscript[δ, h]))/4-(Subscript[c, p1]) (3/4+(1-(Subscript[δ, p])) (Subscript[δ, p]))
And with  (Subscript[F, A,p])
(1/8) (7 (Subscript[α, p])-(Subscript[β, p]))+((Subscript[α, p])+(Subscript[β, p])) ((2 (1+2 (Subscript[δ, h])) (1-(Subscript[δ, p])) (Subscript[δ, p])-(Subscript[δ, h]))-2 (1+2 (Subscript[δ, h])) (Subscript[F, A,p]))/4-(Subscript[c, p1]) (3/4+(1-(Subscript[δ, p])) (Subscript[δ, p])- (Subscript[F, A,p]) )
where (Subscript[F, A,p])=(((1/4-(Subscript[δ, p]^2)))^2)((Subscript[c, p2])+(Subscript[f, mm])(Subscript[c, p1])-(Subscript[f, mm])((Subscript[α, p])+(Subscript[β, p])) (1/2+(Subscript[δ, h]))) (1-(Subscript[ψ, p]))/(Subscript[ψ, p])

deltaSolns={(Subscript[δ, p])->(1/2)-((Sqrt[(Subscript[c, h])])/((Sqrt[(Subscript[f, mm])]) (Sqrt[(Subscript[α, h])]))),(Subscript[δ, h])->((2 (Subscript[c, p2])+(Subscript[f, mm]) (2 (Subscript[c, p1])-(Subscript[α, p])-(Subscript[β, p])))/(2 (Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p]))))};

qlesoln={cij->0,FA->-(((2 (Subscript[c, p2])+(Subscript[f, mm]) (-2 (Subscript[c, p1])+((Subscript[α, p])+(Subscript[β, p])) (1+2 (Subscript[δ, h])))) (((1-4 (Subscript[δ, p]^2)))^2) (-1+(Subscript[ψ, p])))/(32 (Subscript[ψ, p]))),FM->0,cijcj->0,cijci->0,cijcij->0,cicj->0};
orderAssumptions={(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[c, h])->(Subscript[c, h])ϵ,(Subscript[c, p1])->(Subscript[c, p1])ϵ,(Subscript[c, p2])->(Subscript[c, p2])ϵ};

wpbar=(Subscript[(OverBar[w]), p])/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])/.changeOfVarHOST/.deltaSolns/.qlesoln/.orderAssumptions;

Normal[Series[wpbar,{ϵ,0,2}]]//Simplify

deltaSolns/.(Subscript[f, mm])->1//Simplify

diffw=Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.Apply[XtoD,currGen]/.changeOfVarHOST/.qlesoln/.{pA->(Subscript[δ, p])+1/2,(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]),(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])}/.deltaSolns/.orderAssumptions,{ϵ,0,2}]]//Simplify

diffw=-((((Subscript[c, h]) (Subscript[c, p2])+(Subscript[f, mm]^2) (Subscript[α, h]) ((Subscript[c, p1])+(Subscript[s, fl])-(Subscript[α, p]))))/((Subscript[f, mm]^2) (Subscript[α, h])));

Normal[Series[diffw/.(Subscript[c, p2])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),0,-1}]]
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;
Normal[Series[diffw/.(Subscript[c, p2])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),1,0}]]//Simplify
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;

For cP2 plots:

Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),0,-1}]]
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),1,0}]]//Simplify
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;

-(((Subscript[c, h]) (Subscript[c, p2]))/(Subscript[α, h]))+(Subscript[α, p])/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.01
-(((Subscript[c, h]) (Subscript[c, p2]))/(Subscript[α, h]))+(Subscript[α, p])/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.05

Diploid Host/Haploid Parasite

Fitness Functions:

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
(Subscript[x, i,j]) is frequency of genotype j in species i

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

wmat=(1+(({{(Subscript[α, p]), -(Subscript[β, p]), -(Subscript[β, p])}, {(Subscript[α, p]), (Subscript[α, p]), (Subscript[α, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])},{(Subscript[x, h,2])}}-{{0},{(Subscript[c, p1])}};

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, m]),1], 
j==1,total[(Subscript[f, M]),1],
j==2,total[(Subscript[f, m]),2]-(Subscript[c, p2]),
j==3,total[(Subscript[f, M]),2]-(Subscript[c, p2])];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= Which[
j==0,1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,0])+(Subscript[f, M])*(Subscript[x, p,1])+(Subscript[f, m])*(Subscript[x, p,2])+(Subscript[f, M])*(Subscript[x, p,3])),
j==1,1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,2])+(Subscript[f, M])*(Subscript[x, p,3]))-(Subscript[c, h]),
j==2,1-(Subscript[α, h])((Subscript[f, m])*(Subscript[x, p,2])+(Subscript[f, M])*(Subscript[x, p,3]))-(Subscript[c, h])];

(Subscript[(OverBar[w]), i]) is the mean fitness of species i

(Subscript[(OverBar[w]), h])=(∑_(j=0)^2)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^3)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.
Host genotypes : 0 = aa, 1 = Aa, 2 = AA
Parasite genotypes : 0 = am, 1 = aM, 2 = Am, 3 = AM

Hosts

HGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, h,0])},{(Subscript[n1x, h,1])},{(Subscript[n1x, h,2])}}]).{{1,0},{(1/2),(1/2)},{0,1}}]//Flatten;
(Subscript[n2x, h,j_])=Which[
j==0,(1-(Subscript[ψ, h])) (Subscript[n1x, h,0])+(Subscript[ψ, h]) HGameteFreqs[[1]]*HGameteFreqs[[1]],
j==1,(1-(Subscript[ψ, h])) (Subscript[n1x, h,1])+(Subscript[ψ, h]) 2*HGameteFreqs[[1]]*HGameteFreqs[[2]],
j==2,(1-(Subscript[ψ, h])) (Subscript[n1x, h,2])+(Subscript[ψ, h]) HGameteFreqs[[2]]*HGameteFreqs[[2]]
];

Parasites

(Subscript[n2x, p,j_])=If[j==1||j==2,
(Subscript[n1x, p,j])+ (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2])),
(Subscript[n1x, p,j])- (Subscript[ψ, p])((Subscript[n1x, p,0])*(Subscript[n1x, p,3])-(Subscript[n1x, p,1])*(Subscript[n1x, p,2]))
];

Check that things sum to 1 as they should:
(Subscript[n2x, h,0])+(Subscript[n2x, h,1])+(Subscript[n2x, h,2])//Simplify
(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])//Simplify

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))
	  (Subscript[c, p1])/(1+(Subscript[s, fl])) -> (Subscript[cn, p1])
	  (Subscript[c, p2])/(1+(Subscript[s, fl])) -> (Subscript[cn, p2])

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))/.(Subscript[c, p2])->(Subscript[cn, p2])(1+(Subscript[s, fl]))/.(Subscript[c, p1])->(Subscript[cn, p1])(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[c, p2])->(Subscript[cn, p2])/.(Subscript[c, p1])->(Subscript[cn, p1])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the GFG model.

Change of variables

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = am, 1 = aM, 2 = Am, 3 = AM

changeOfVarHOST=Solve[
{(Subscript[δ, h])==((Subscript[x, h,2])+((Subscript[x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[x, h,0])+((Subscript[x, h,1])/2))(((Subscript[x, h,1])/2)+(Subscript[x, h,2]))-(Subscript[x, h,1]))/2,(∑_(j=0)^2)(Subscript[x, h,j])==1},{(Subscript[x, h,0]),(Subscript[x, h,1]),(Subscript[x, h,2])}]//Simplify//Flatten
changeOfVarPARASITE=Solve[{(Subscript[δ, p])==((Subscript[x, p,2])+(Subscript[x, p,3]))-1/2,(Subscript[p, M])==(Subscript[x, p,1])+(Subscript[x, p,3]),(Subscript[D, p])==(Subscript[x, p,0])(Subscript[x, p,3])-(Subscript[x, p,1])(Subscript[x, p,2]),(Subscript[x, p,0])+(Subscript[x, p,1])+(Subscript[x, p,2])+(Subscript[x, p,3])==1},{(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3])}]//Simplify//Flatten

changeOfVarHOST2=Solve[{(Subscript[δ, h])==((Subscript[n2x, h,2])+((Subscript[n2x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[n2x, h,0])+((Subscript[n2x, h,1])/2))(((Subscript[n2x, h,1])/2)+(Subscript[n2x, h,2]))-(Subscript[n2x, h,1]))/2,(∑_(j=0)^2)(Subscript[n2x, h,j])==1},{(Subscript[δ, h]),(Subscript[F, A,h])}]//Simplify//Flatten
changeOfVarPARASITE2=Solve[{(Subscript[δ, p])==((Subscript[n2x, p,2])+(Subscript[n2x, p,3]))-1/2,(Subscript[p, M])==(Subscript[n2x, p,1])+(Subscript[n2x, p,3]),(Subscript[D, p])==(Subscript[n2x, p,0])(Subscript[n2x, p,3])-(Subscript[n2x, p,1])(Subscript[n2x, p,2]),(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])==1},{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}]//Simplify//Flatten

oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h]),(Subscript[F, A,h])}];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE];
changeOverOneGenP=Map[oneGenChangeP,{(Subscript[δ, p]),(Subscript[p, M]),(Subscript[D, p])}];

Analysis of recursions

subsmall0={(Subscript[F, A,h])->FAh+(Subscript[F, A,h]),(Subscript[D, p])->d+(Subscript[D, p])};

Order assumptions are also included in the following substitution:

subsmall=Function[a,{(Subscript[F, A,h])->(Subscript[F, A,h])*(ϵ^a),(Subscript[D, p])->(Subscript[D, p])*(ϵ^a),(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M])ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[c, h])->(Subscript[c, h])ϵ,(Subscript[c, p1])->(Subscript[c, p1])ϵ,(Subscript[c, p2])->(Subscript[c, p2])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={d->0,FAh->0};

eqn1=subAndSeriesP[1,toorder]
eqn2=subAndSeriesP[2,toorder]
eqn3=subAndSeriesP[3,toorder]
Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

eqn1=subAndSeriesH[1,toorder]
eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={(Subscript[F, A,h])->0,(Subscript[D, p])->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.qlesoln/.subsmall0/.suba/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Kept order  ϵ  terms in the associations

toorder = 1;

qlesoln={(Subscript[D, p])->0,(Subscript[F, A,h])->0};
suba={d->(Subscript[D, p]),FAh->(Subscript[F, A,h])}/.qlesoln;

eqn1H = subAndSeriesH[1, toorder]
eqn1P = subAndSeriesP[1, toorder]

Solve[eqn1H==0,(Subscript[δ, p])]//Simplify//Flatten
Solve[eqn1P==0,(Subscript[δ, h])]//Simplify//Flatten

deltaSolns={(Subscript[δ, p])->(1/2)-((Subscript[c, h])/((Subscript[f, m]) (Subscript[α, h]))),(Subscript[δ, h])->(((Subscript[f, m]) ((Subscript[α, p])+(Subscript[β, p]))-2 (Sqrt[-(Subscript[f, m]) ((Subscript[α, p])+(Subscript[β, p])) ((Subscript[c, p2])+(Subscript[f, m]) ((Subscript[c, p1])+((Subscript[α, p])+(Subscript[β, p])) (-1+(Subscript[F, A,h]))))]))/(2 (Subscript[f, m]) ((Subscript[α, p])+(Subscript[β, p]))))};

eqn3=subAndSeriesP[3,toorder]
Solve[eqn3==0,(Subscript[D, p])]//Simplify//Flatten

eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={(Subscript[D, p])->0};

modChange=FullSimplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=(1/8) (-1+(Subscript[p, M])) (Subscript[p, M]) (Subscript[Δ, M]) (8 (Subscript[s, fl])+(Subscript[c, p1]) (4+8 (Subscript[δ, p]))+(Subscript[β, p]) (-1+2 (Subscript[δ, p])) (-3+4 (-1+(Subscript[δ, h])) (Subscript[δ, h])+4 (Subscript[F, A,h]))+(Subscript[α, p]) (-5-6 (Subscript[δ, p])+4 (-1+(Subscript[δ, h])) (Subscript[δ, h]) (-1+2 (Subscript[δ, p]))-4 (Subscript[F, A,h])+8 (Subscript[δ, p]) (Subscript[F, A,h])));

Parasite genotypes: 0 = am, 1=aM, 2=Am, 3=AM
Host genotypes: 0 = a, 1=A

(Subscript[w, m])=((Subscript[w, p,0])*(Subscript[x, p,0])+(Subscript[w, p,2])*(Subscript[x, p,2]))/((Subscript[x, p,0])+(Subscript[x, p,2]));
(Subscript[w, M])=((Subscript[w, p,1])*(Subscript[x, p,1])+(Subscript[w, p,3])*(Subscript[x, p,3]))/((Subscript[x, p,1])+(Subscript[x, p,3]));

qlesoln={(Subscript[D, p])->0};
orderAssumptions={(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M])ϵ,(Subscript[δ, h])->(Subscript[δ, h]),(Subscript[δ, p])->(Subscript[δ, p]),(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[c, h])->(Subscript[c, h])ϵ,(Subscript[c, p1])->(Subscript[c, p1])ϵ,(Subscript[c, p2])->(Subscript[c, p2])ϵ};

diffw = Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.changeOfVarPARASITE/.changeOfVarHOST/.qlesoln/.orderAssumptions,{ϵ,0,2}]]/.ϵ->1//FullSimplify

So our invasion term to put in ms (Table 2) is
(1/8)  (5 (Subscript[α, p])-3(Subscript[β, p]))+((Subscript[α, p])+(Subscript[β, p])) (3 (Subscript[δ, p])+2 (1-2 (Subscript[δ, p])) ((Subscript[δ, h]^2)-(Subscript[δ, h])))/4 -(Subscript[c, p1]) (1+2 (Subscript[δ, p]))/2
And with  (Subscript[F, A,h])
(1/8)  (5 (Subscript[α, p])-3(Subscript[β, p]))+((Subscript[α, p])+(Subscript[β, p])) (3 (Subscript[δ, p])+2 (1-2 (Subscript[δ, p])) ((Subscript[δ, h]^2)-(Subscript[δ, h])+(Subscript[F, A,h])))/4 -(Subscript[c, p1]) (1+2 (Subscript[δ, p]))/2
where (Subscript[F, A,h])=(((1/4-(Subscript[δ, h]^2)))^2) ((Subscript[c, h])-(Subscript[f, m]) (Subscript[α, h]) (1/2-(Subscript[δ, p]))) (1-(Subscript[ψ, h]))/(Subscript[ψ, h])

deltaSolns={(Subscript[δ, p])->(1/2)-((Subscript[c, h])/((Subscript[f, m]) (Subscript[α, h]))),(Subscript[δ, h])->(((Subscript[f, m]) ((Subscript[α, p])+(Subscript[β, p]))-2 (Sqrt[-(Subscript[f, m]) ((Subscript[α, p])+(Subscript[β, p])) ((Subscript[c, p2])+(Subscript[f, m]) ((Subscript[c, p1])+((Subscript[α, p])+(Subscript[β, p])) (-1+(Subscript[F, A,h]))))]))/(2 (Subscript[f, m]) ((Subscript[α, p])+(Subscript[β, p]))))};

qlesoln={(Subscript[D, p])->0};
orderAssumptions={(Subscript[f, M])->(Subscript[f, m])+(Subscript[Δ, M])ϵ,(Subscript[δ, h])->(Subscript[δ, h]),(Subscript[δ, p])->(Subscript[δ, p]),(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[c, h])->(Subscript[c, h])ϵ,(Subscript[c, p1])->(Subscript[c, p1])ϵ,(Subscript[c, p2])->(Subscript[c, p2])ϵ};

wpbar=(Subscript[(OverBar[w]), p])/.changeOfVarPARASITE/.changeOfVarHOST/.deltaSolns/.qlesoln/.orderAssumptions;

Normal[Series[wpbar,{ϵ,0,2}]]//Simplify

deltaSolns/.(Subscript[f, m])->1/.(Subscript[F, A,h])->0//Simplify

diffw = Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.changeOfVarPARASITE/.changeOfVarHOST/.qlesoln/.deltaSolns/.orderAssumptions,{ϵ,0,2}]]/.ϵ->1//Simplify

diffw=-((((Subscript[c, h]) (Subscript[c, p2])+(Subscript[f, m]^2) (Subscript[α, h]) ((Subscript[c, p1])+(Subscript[s, fl])-(Subscript[α, p]))))/((Subscript[f, m]^2) (Subscript[α, h])));

Normal[Series[diffw/.(Subscript[c, p2])->0/.(Subscript[s, fl])->0,{(Subscript[f, m]),0,-1}]]
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;
Normal[Series[diffw/.(Subscript[c, p2])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),1,0}]]//Simplify
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;

For cP2 plots:

Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, m]),0,-1}]]
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, m]),1,0}]]//Simplify
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;

-(((Subscript[c, h]) (Subscript[c, p2]))/(Subscript[α, h]))+(Subscript[α, p])/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.01
-(((Subscript[c, h]) (Subscript[c, p2]))/(Subscript[α, h]))+(Subscript[α, p])/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.05

Diploid Host/Diploid Parasite

Fitness Functions:

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes: 0 = am, 1=aM, 2=Am, 3=AM
(Subscript[x, i,j]) is frequency of genotype j in species i

(Subscript[w, freeliving])=1+(Subscript[s, fl]);

wmat=(1+(({{(Subscript[α, p]), -(Subscript[β, p]), -(Subscript[β, p])}, {(Subscript[α, p]), (Subscript[α, p]), (Subscript[α, p])}, {(Subscript[α, p]), (Subscript[α, p]), (Subscript[α, p])}}))).{{(Subscript[x, h,0])},{(Subscript[x, h,1])},{(Subscript[x, h,2])}}-{{0},{(Subscript[c, p1])},{(Subscript[c, p1])}};

(Subscript[w, i,j]) is the fitness of genotype j in species i

total=Function[{a,b},(1-a)(Subscript[w, freeliving])+a wmat[[b]][[1]]];

fit[j_]=Which[
j==0,total[(Subscript[f, mm]),1], 
j==1,total[(Subscript[f, Mm]),1],
j==2,total[(Subscript[f, MM]),1],
j==3,total[(Subscript[f, mm]),2]-(Subscript[c, p2]),
j==4,total[(Subscript[f, Mm]),2]-(Subscript[c, p2]),
j==5,total[(Subscript[f, Mm]),2]-(Subscript[c, p2]),
j==6,total[(Subscript[f, MM]),2]-(Subscript[c, p2]),
j==7,total[(Subscript[f, mm]),3]-(Subscript[c, p2]),
j==8,total[(Subscript[f, Mm]),3]-(Subscript[c, p2]),
j==9,total[(Subscript[f, MM]),3]-(Subscript[c, p2])];

(Subscript[w, p,j_])=fit[j];

(Subscript[w, h,j_])= Which[
j==0,1-(Subscript[α, h])((Subscript[f, mm])((Subscript[x, p,0])+(Subscript[x, p,3])+(Subscript[x, p,7]))+(Subscript[f, Mm])((Subscript[x, p,1])+(Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]))+(Subscript[f, MM])((Subscript[x, p,2])+(Subscript[x, p,6])+(Subscript[x, p,9]))),
j==1,1-(Subscript[α, h])((Subscript[f, mm])((Subscript[x, p,3])+(Subscript[x, p,7]))+(Subscript[f, Mm])((Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]))+(Subscript[f, MM])((Subscript[x, p,6])+(Subscript[x, p,9])))-(Subscript[c, h]),
j==2,1-(Subscript[α, h])((Subscript[f, mm])((Subscript[x, p,3])+(Subscript[x, p,7]))+(Subscript[f, Mm])((Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]))+(Subscript[f, MM])((Subscript[x, p,6])+(Subscript[x, p,9])))-(Subscript[c, h])];

(Subscript[(OverBar[w]), i]) is the mean fitness of species i

(Subscript[(OverBar[w]), h])=(∑_(j=0)^2)(Subscript[w, h,j])*(Subscript[x, h,j]);
(Subscript[(OverBar[w]), p])=(∑_(j=0)^9)(Subscript[w, p,j])*(Subscript[x, p,j]);

Recurrence equations:

Selection

(Subscript[n1x, h,j_])=(Subscript[w, h,j])*(Subscript[x, h,j])/(Subscript[(OverBar[w]), h]);
(Subscript[n1x, p,j_])=(Subscript[w, p,j])*(Subscript[x, p,j])/(Subscript[(OverBar[w]), p]);

Sex/Recombination

Let ψ denote the probability that sex and recombination occurs.
Host genotypes : 0 = aa, 1 = Aa, 2 = AA
Parasite genotypes: 0 = aamm, 1=aaMm, 2=aaMM, 3=Aamm, 4=AaMm, 5=AamM, 6=AaMM, 7=AAmm, 8=AAMm, 9=AAMM
Parasite haplotypes : 0 = am, 1 = aM, 2 = Am, 3 = AM

Hosts

HGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, h,0])},{(Subscript[n1x, h,1])},{(Subscript[n1x, h,2])}}]).{{1,0},{(1/2),(1/2)},{0,1}}]//Flatten;
(Subscript[n2x, h,j_])=Which[
j==0,(1-(Subscript[ψ, h])) (Subscript[n1x, h,0])+(Subscript[ψ, h]) HGameteFreqs[[1]]*HGameteFreqs[[1]],
j==1,(1-(Subscript[ψ, h])) (Subscript[n1x, h,1])+(Subscript[ψ, h]) 2*HGameteFreqs[[1]]*HGameteFreqs[[2]],
j==2,(1-(Subscript[ψ, h])) (Subscript[n1x, h,2])+(Subscript[ψ, h]) HGameteFreqs[[2]]*HGameteFreqs[[2]]
];

Parasites

rMatrix={
{1,0,0,0},
{(1/2),(1/2),0,0},
{0,1,0,0},
{(1/2),0,(1/2),0},
{((1-r)/2),(r/2),(r/2),((1-r)/2)},
{(r/2),((1-r)/2),((1-r)/2),(r/2)},
{0,(1/2),0,(1/2)},
{0,0,1,0},
{0,0,(1/2),(1/2)},
{0,0,0,1}};

PGameteFreqs=Transpose[(Transpose[{{(Subscript[n1x, p,0])},{(Subscript[n1x, p,1])},{(Subscript[n1x, p,2])},{(Subscript[n1x, p,3])},{(Subscript[n1x, p,4])},{(Subscript[n1x, p,5])},{(Subscript[n1x, p,6])},{(Subscript[n1x, p,7])},{(Subscript[n1x, p,8])},{(Subscript[n1x, p,9])}}]).rMatrix];
gamete[j_]=Which[
j==0, PGameteFreqs[[1]],
j==1,PGameteFreqs[[2]],
j==2, PGameteFreqs[[3]],
j==3, PGameteFreqs[[4]]
];

am=0;aM=1;Am=2;AM=3;
(Subscript[n2x, p,j_])=Which[
j==0,(1-(Subscript[ψ, p])) (Subscript[n1x, p,0])+(Subscript[ψ, p]) gamete[am].gamete[am], 
j==1,(1-(Subscript[ψ, p])) (Subscript[n1x, p,1])+(Subscript[ψ, p]) 2 gamete[aM].gamete[am],
j==2,(1-(Subscript[ψ, p])) (Subscript[n1x, p,2])+(Subscript[ψ, p]) gamete[aM].gamete[aM],
j==3,(1-(Subscript[ψ, p])) (Subscript[n1x, p,3])+(Subscript[ψ, p]) 2 gamete[Am].gamete[am],
j==4,(1-(Subscript[ψ, p])) (Subscript[n1x, p,4])+(Subscript[ψ, p]) 2 gamete[AM].gamete[am],
j==5,(1-(Subscript[ψ, p])) (Subscript[n1x, p,5])+(Subscript[ψ, p]) 2 gamete[Am].gamete[aM],
j==6,(1-(Subscript[ψ, p])) (Subscript[n1x, p,6])+(Subscript[ψ, p]) 2 gamete[AM].gamete[aM],
j==7,(1-(Subscript[ψ, p])) (Subscript[n1x, p,7])+(Subscript[ψ, p]) gamete[Am].gamete[Am],
j==8,(1-(Subscript[ψ, p])) (Subscript[n1x, p,8])+(Subscript[ψ, p]) 2 gamete[AM].gamete[Am],
j==9,(1-(Subscript[ψ, p])) (Subscript[n1x, p,9])+(Subscript[ψ, p]) gamete[AM].gamete[AM]
];

Check that things sum to 1 as they should:
(Subscript[n2x, h,0])+(Subscript[n2x, h,1])+(Subscript[n2x, h,2])//Simplify
(Subscript[n2x, p,0])+(Subscript[n2x, p,1])+(Subscript[n2x, p,2])+(Subscript[n2x, p,3])+(Subscript[n2x, p,4])+(Subscript[n2x, p,5])+(Subscript[n2x, p,6])+(Subscript[n2x, p,7])+(Subscript[n2x, p,8])+(Subscript[n2x, p,9])//Simplify

Measuring fitness relative to the free-living stage

Let's measure fitness in parasites relative to the free-living phase.  That is, we redefine:

	 (1+(Subscript[α, p]))/(1+(Subscript[s, fl])) -> (1+(Subscript[αn, p]))
	 (1-(Subscript[β, p]))/(1+(Subscript[s, fl])) -> (1-(Subscript[βn, p]))
	  (Subscript[c, p1])/(1+(Subscript[s, fl])) -> (Subscript[cn, p1])
	  (Subscript[c, p2])/(1+(Subscript[s, fl])) -> (Subscript[cn, p2])

where the "n" stands for the new fitness regime.

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(1+(Subscript[αn, p]))(1+(Subscript[s, fl]))-1/.(Subscript[β, p])->1-(1-(Subscript[βn, p]))(1+(Subscript[s, fl]))/.(Subscript[c, p2])->(Subscript[cn, p2])(1+(Subscript[s, fl]))/.(Subscript[c, p1])->(Subscript[cn, p1])(1+(Subscript[s, fl]))//Simplify;

The following demonstrates that this redefinition of fitness does not change the dynamics from before, had we just not used (Subscript[s, fl]) and thought of (Subscript[α, p]) and (Subscript[β, p]) as these relative measures:

{(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3])}/.(Subscript[α, p])->(Subscript[αn, p])/.(Subscript[β, p])->(Subscript[βn, p])/.(Subscript[c, p2])->(Subscript[cn, p2])/.(Subscript[c, p1])->(Subscript[cn, p1])/.(Subscript[s, fl])->0;
Factor[%%-%]

Thus, we are free to drop (Subscript[s, fl]) from the GFG model.

Change of variables

Host genotypes: 0 = aa, 1=Aa, 2=AA
Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM
Parasite genotypes: x44=0 = aamm, 2 x24 = 1 = aaMm, x22 = 2 = aaMM, 2 x34 = 3 = Aamm, 2 x14 = 4 = AaMm, 2 x23 = 5 = AamM, 2 x12=6 = AaMM, 2 x33=7 = AAmm, 2 x13=8 = AAMm, x11=9 = AAMM
Parasite haplotypes: 0 = am, 1 = aM, 2 = Am, 3 = AM

Define new variables as: (Subscript[δ, h])=((Subscript[x, h,2])+((Subscript[x, h,1])/2))-(1/2)
(Subscript[F, A,h])==(Subscript[x, h,1])-2((Subscript[x, h,0])+((Subscript[x, h,1])/2))(((Subscript[x, h,1])/2)+(Subscript[x, h,2]))

changeOfVarHOST=Solve[
{(Subscript[δ, h])==((Subscript[x, h,2])+((Subscript[x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[x, h,0])+((Subscript[x, h,1])/2))(((Subscript[x, h,1])/2)+(Subscript[x, h,2]))-(Subscript[x, h,1]))/2,(∑_(j=0)^2)(Subscript[x, h,j])==1},{(Subscript[x, h,0]),(Subscript[x, h,1]),(Subscript[x, h,2])}]//Simplify//Flatten
changeOfVarHOST2=Solve[{(Subscript[δ, h])==((Subscript[n2x, h,2])+((Subscript[n2x, h,1])/2))-1/2,(Subscript[F, A,h])==(2((Subscript[n2x, h,0])+((Subscript[n2x, h,1])/2))(((Subscript[n2x, h,1])/2)+(Subscript[n2x, h,2]))-(Subscript[n2x, h,1]))/2,(∑_(j=0)^2)(Subscript[n2x, h,j])==1},{(Subscript[δ, h]),(Subscript[F, A,h])}]//Simplify//Flatten
oneGenChangeH=Function[x,((x/.changeOfVarHOST2)-x)/.changeOfVarHOST];
changeOverOneGenH=Map[oneGenChangeH,{(Subscript[δ, h]),(Subscript[F, A,h])}];

Using Sally's code from Otto (2003) we can change the system of equations (for the parasites) into a new system of equations with all higher order associations, etc etc. Genotype labels in our model can be converted into those in Sally's model in the following way: {(Subscript[x, p,0])->x44,(Subscript[x, p,1])->2 x24,(Subscript[x, p,2])->x22,(Subscript[x, p,3])->2 x34,(Subscript[x, p,4])->2 x14,(Subscript[x, p,5])->2 x23,(Subscript[x, p,6])->2 x12,(Subscript[x, p,7])->x33,(Subscript[x, p,8])->2 x13,(Subscript[x, p,9])->x11}
The below functions DtoX converts from disequilbrium to genotype frequencies, and XtoD does the reverse conversion. DtoX is equivalent to 'subpD2' in Otto (2003) and XtoD is equivalent to 'subx2', except that they are written to work with our variable naming scheme.

DtoX=Function[{a,b,c,d,e,f,g,h,i,j},
Block[{pA1=((d/2)+(e/2)+(f/2)+(g/2)+h+i+j),pM1=((b/2)+c+(e/2)+(f/2)+g+(i/2)+j)},
{1->a+b+c+d+e+f+g+h+i+j,
pA->(d/2)+(e/2)+(f/2)+(g/2)+h+i+j,
pM->(b/2)+c+(e/2)+(f/2)+g+(i/2)+j,
FA->(h+(i/2)) (((1-pA1))^2)+((i/2)+j) (((1-pA1))^2)-((d/2)+(e/2)) (1-pA1) pA1-((d/2)+(f/2)) (1-pA1) pA1-((e/2)+(g/2)) (1-pA1) pA1-((f/2)+(g/2)) (1-pA1) pA1+(a+(b/2)) (((pA1))^2)+((b/2)+c) (pA1^2),
FM->(c+(g/2)) (((1-pM1))^2)+((g/2)+j) (((1-pM1))^2)-((b/2)+(e/2)) (1-pM1) pM1-((b/2)+(f/2)) (1-pM1) pM1-((e/2)+(i/2)) (1-pM1) pM1-((f/2)+(i/2)) (1-pM1) pM1+(a+(d/2)) (pM1^2)+((d/2)+h) (pM1^2),
cijcij->j (((1-pA1))^2) (((1-pM1))^2)-g (1-pA1) pA1 (((1-pM1))^2)+c (pA1^2) (((1-pM1))^2)-i (((1-pA1))^2) (1-pM1) pM1+e (1-pA1) pA1 (1-pM1) pM1+f (1-pA1) pA1 (1-pM1) pM1-b (pA1^2) (1-pM1) pM1+h (((1-pA1))^2) (pM1^2)-d (1-pA1) pA1 (pM1^2)+a (pA1^2) (pM1^2),
cijci->((g/2)+j) (1-pA1) (((1-pM1))^2)-(c+(g/2)) pA1 (((1-pM1))^2)-((e/2)+(i/2)) (1-pA1) (1-pM1) pM1-((f/2)+(i/2)) (1-pA1) (1-pM1) pM1+((b/2)+(e/2)) pA1 (1-pM1) pM1+((b/2)+(f/2)) pA1 (1-pM1) pM1+((d/2)+h) (1-pA1) (pM1^2)-(a+(d/2)) pA1 (pM1^2),
cijcj->((i/2)+j) (((1-pA1))^2) (1-pM1)-((e/2)+(g/2)) (1-pA1) pA1 (1-pM1)-((f/2)+(g/2)) (1-pA1) pA1 (1-pM1)+((b/2)+c) (pA1^2) (1-pM1)-(h+(i/2)) (((1-pA1))^2) pM1+((d/2)+(e/2)) (1-pA1) pA1 pM1+((d/2)+(f/2)) (1-pA1) pA1 pM1-(a+(b/2)) (pA1^2) pM1,
cicj->((f/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(e/2)+(g/2)) pA1 (1-pM1)-((d/2)+(e/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(f/2)) pA1 pM1,
cij->((e/2)+(g/2)+(i/2)+j) (1-pA1) (1-pM1)-((b/2)+c+(f/2)+(g/2)) pA1 (1-pM1)-((d/2)+(f/2)+h+(i/2)) (1-pA1) pM1+(a+(b/2)+(d/2)+(e/2)) pA1 pM1}]];

XtoD=Function[{a,b,c,d,e,f,g,h,i,j},
{a->1-2 cijci+cijcij-2 cijcj+FA+FM-2 pA+2 cijci pA-2 FM pA+(pA^2)+FM (pA^2)+2 cicj (-1+pA) (-1+pM)+2 cij (-1+pA) (-1+pM)-2 pM+2 cijcj pM-2 FA pM+4 pA pM-2 (pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
b->-2 (-2 cijci+cijcij-cijcj+FM+2 cijci pA-2 FM pA+FM (pA^2)-pM+2 cijcj pM-FA pM+2 pA pM-(pA^2) pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2)+cicj (-1+pA) (-1+2 pM)+cij (-1+pA) (-1+2 pM)),
c->cijcij+FM+2 cijci (-1+pA)-2 FM pA+FM (pA^2)-2 cicj pM-2 cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+(pM^2)+FA (pM^2)-2 pA (pM^2)+(pA^2) (pM^2),
d->-2 (-cijci+cijcij-2 cijcj+FA-pA+2 cijci pA-FM pA+(pA^2)+FM (pA^2)+cicj (-1+2 pA) (-1+pM)+cij (-1+2 pA) (-1+pM)+2 cijcj pM-2 FA pM+2 pA pM-2 (pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
e->2 (cijcij-cijcj-cicj pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM+2 cijcj pM-FA pM+pA pM+2 cicj pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cij (1-pM+pA (-1+2 pM))),
f->2 (cijcij-cijcj-cij pA-FM pA+FM (pA^2)+cijci (-1+2 pA)-cij pM+2 cijcj pM-FA pM+pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)+cicj (1-pM+pA (-1+2 pM))),
g->-2 (cijcij-FM pA+FM (pA^2)+cijci (-1+2 pA)-cicj pM-cij pM+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)-pA (pM^2)+(pA^2) (pM^2)),
h->cijcij+FA-2 cicj pA-2 cij pA+2 cijci pA+(pA^2)+FM (pA^2)+2 cijcj (-1+pM)-2 FA pM+2 cicj pA pM+2 cij pA pM-2 (pA^2) pM+FA (pM^2)+(pA^2) (pM^2),
i->-2 (cijcij-cicj pA-cij pA+2 cijci pA+FM (pA^2)-FA pM+2 cicj pA pM+2 cij pA pM-(pA^2) pM+FA (pM^2)+(pA^2) (pM^2)+cijcj (-1+2 pM)),
j->cijcij+2 cijci pA+FM (pA^2)+2 cijcj pM+2 cicj pA pM+2 cij pA pM+FA (pM^2)+(pA^2) (pM^2)}];

I can get the same thing as above from Sally's equations by doing the following, if I have the function 'subpD2' in the kernel (the first function converts a standard vector of parasite genotypes into the appropriate format to pass into Sally's functions):
convertToSallysNotation=Function[{a,b,c,d,e,f,g,h,i,j},{j,(g/2),(i/2),(e/2),c,(f/2),(b/2),h,(d/2),a}];
Apply[subpD2,convertToSallysNotation[(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3]),(Subscript[x, p,4]),(Subscript[x, p,5]),(Subscript[x, p,6]),(Subscript[x, p,7]),(Subscript[x, p,8]),(Subscript[x, p,9])]];

(*convertNotation={x44->(Subscript[x, p,0]),x24->((Subscript[x, p,1])/2),x22->(Subscript[x, p,2]),x34->((Subscript[x, p,3])/2),x14->((Subscript[x, p,4])/2),x23->((Subscript[x, p,5])/2),x12->((Subscript[x, p,6])/2),x33->(Subscript[x, p,7]),x13->((Subscript[x, p,8])/2),x11->(Subscript[x, p,9])};*)

Create a vector of genotype frequencies for the current generation, as well as the next generation:

currGen={(Subscript[x, p,0]),(Subscript[x, p,1]),(Subscript[x, p,2]),(Subscript[x, p,3]),(Subscript[x, p,4]),(Subscript[x, p,5]),(Subscript[x, p,6]),(Subscript[x, p,7]),(Subscript[x, p,8]),(Subscript[x, p,9])};
nextGen={(Subscript[n2x, p,0]),(Subscript[n2x, p,1]),(Subscript[n2x, p,2]),(Subscript[n2x, p,3]),(Subscript[n2x, p,4]),(Subscript[n2x, p,5]),(Subscript[n2x, p,6]),(Subscript[n2x, p,7]),(Subscript[n2x, p,8]),(Subscript[n2x, p,9])};

Again, the following is taken from Otto (2003). The first term in brackets (on each line) denotes the change in each disequilbrium term over a single generation (e.g., pA/.sub1 denotes the frequency of A in the next generation - and from it we subtract pA, the frequency of A in the current generation). All variables are then converted back into genotype frequencies by applying sub2. Lastly we switch from pA to (Subscript[δ, P]).

changeOfVarPARASITE=Apply[XtoD,currGen];
changeOfVarPARASITE2=Apply[DtoX,nextGen];
oneGenChangeP=Function[x,((x/.changeOfVarPARASITE2)-x)/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])];
changeOverOneGenP=Map[oneGenChangeP,{pA,pM,FA,FM,cij,cicj,cijcj,cijci,cijcij}];

Analysis of recursions

subsmall0={(Subscript[F, A,h])->FAh+(Subscript[F, A,h]),FA->a3+FA,FM->a4+FM,cij->a5+cij,cicj->a6+cicj,cijcj->a7+cijcj,cijci->a8+cijci,cijcij->a9+cijcij};

subsmall=Function[a,{(Subscript[F, A,h])->(Subscript[F, A,h])*(ϵ^a),FA->FA*(ϵ^a),FM->FM*(ϵ^a),cij->cij*(ϵ^a),cicj->cicj*(ϵ^a),cijcj->cijcj*(ϵ^a),cijci->cijci*(ϵ^a),cijcij->cijcij*(ϵ^a),(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[c, h])->(Subscript[c, h])ϵ,(Subscript[c, p1])->(Subscript[c, p1])ϵ,(Subscript[c, p2])->(Subscript[c, p2])ϵ}];

subAndSeriesH=Function[{x,order},Simplify[Normal[Series[changeOverOneGenH[[x]]/.changeOfVarPARASITE/.pA->(Subscript[δ, p])+1/2/.(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]) /.(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];
subAndSeriesP=Function[{x,order},Simplify[Normal[Series[changeOverOneGenP[[x]]/.changeOfVarHOST/.subsmall0/.suba/.subsmall[order],{ϵ,0,order}]]]];

Kept order  1  terms in the associations

toorder=0;

suba={FAh->0,a3->0,a4->0,a5->0,a6->0,a7->0,a8->0,a9->0};

eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]
Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Simplify//Flatten

eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={(Subscript[F, A,h])->0,FA->0,FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};

modChange=Simplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Kept order  ϵ  terms in the associations

toorder=1;

qlesoln={(Subscript[F, A,h])->0,FA->0,FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};
suba={FAh->(Subscript[F, A,h]),a3->FA,a4->FM,a5->cij,a6->cicj,a7->cijcj,a8->cijci,a9->cijcij}/.qlesoln;

eqn1H=subAndSeriesH[1,toorder]
eqn1P=subAndSeriesP[1,toorder]

Solve[eqn1H==0,(Subscript[δ, p])]//Simplify//Flatten
Solve[eqn1P==0,(Subscript[δ, h])]/.%//Simplify//Flatten

deltaSolns={(Subscript[δ, p])->(1/2)-((Sqrt[(Subscript[c, h])])/((Sqrt[(Subscript[f, mm])]) (Sqrt[(Subscript[α, h])]))),(Subscript[δ, h])->(((Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p]))-2 (Sqrt[-(Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p])) ((Subscript[c, p2])+(Subscript[f, mm]) ((Subscript[c, p1])+((Subscript[α, p])+(Subscript[β, p])) (-1+(Subscript[F, A,h]))))]))/(2 (Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p]))))};

eqn2=subAndSeriesP[2,toorder]
eqn3=subAndSeriesP[3,toorder]
eqn4=subAndSeriesP[4,toorder]
eqn5=subAndSeriesP[5,toorder]
eqn6=subAndSeriesP[6,toorder]
eqn7=subAndSeriesP[7,toorder]
eqn8=subAndSeriesP[8,toorder]
eqn9=subAndSeriesP[9,toorder]
Solve[{eqn3==0,eqn4==0,eqn5==0,eqn6==0,eqn7==0,eqn8==0,eqn9==0},{FA,FM,cij,cicj,cijcj,cijci,cijcij}]//Flatten//Simplify

Solve[eqn3==0,FA]//Flatten//Simplify

eqn2=subAndSeriesH[2,toorder]
Solve[eqn2==0,(Subscript[F, A,h])]//Simplify//Flatten

qlesoln={FA->(Subscript[F, A,p]),FM->0,cij->0,cicj->0,cijcj->0,cijci->0,cijcij->0};

modChange=FullSimplify[Normal[Series[changeOverOneGenP[[2]]/.changeOfVarHOST/.subsmall0/.suba/.qlesoln/.subsmall[toorder],{ϵ,0,toorder+1}]]]

Mean fitness analysis

modChange is what we have from our QLE analysis above

modChange=(1/16) (1-pM) pM ((1-2 pM) (Subscript[Δ, Mm])+pM (Subscript[Δ, MM])) (-16 (Subscript[s, fl])+(Subscript[β, p]) (-3+2 (Subscript[δ, h])) (1+2 (Subscript[δ, h]))+(Subscript[α, p]) (13+4 (-1+(Subscript[δ, h])) (Subscript[δ, h]))+4 ((Subscript[c, p1]) (-3+2 (Subscript[δ, p])) (1+2 (Subscript[δ, p]))+((Subscript[α, p])+(Subscript[β, p])) ((Subscript[F, A,h])+(-1+(Subscript[δ, p])) (Subscript[δ, p]) (-3+4 (-1+(Subscript[δ, h])) (Subscript[δ, h])+4 (Subscript[F, A,h])))))

Parasite genotypes: 0 = aamm, 1 = aaMm, 2 = aaMM, 3 = Aamm, 4 = AaMm, 5 = AamM, 6 = AaMM, 7 = AAmm, 8 = AAMm, 9 = AAMM

(Subscript[w, mm])=(fit[0]*(Subscript[x, p,0])+fit[3]*(Subscript[x, p,3])+fit[7]*(Subscript[x, p,7]))/((Subscript[x, p,0])+(Subscript[x, p,3])+(Subscript[x, p,7]));
(Subscript[w, Mm])=(fit[1]*(Subscript[x, p,1])+fit[4]*(Subscript[x, p,4])+fit[5]*(Subscript[x, p,5])+fit[8]*(Subscript[x, p,8]))/((Subscript[x, p,1])+(Subscript[x, p,4])+(Subscript[x, p,5])+(Subscript[x, p,8]));
(Subscript[w, MM])=(fit[2]*(Subscript[x, p,2])+fit[6]*(Subscript[x, p,6])+fit[9]*(Subscript[x, p,9]))/((Subscript[x, p,2])+(Subscript[x, p,6])+(Subscript[x, p,9]));

(Subscript[x, M])=((Subscript[x, p,1])/2)+(Subscript[x, p,2])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,6])+((Subscript[x, p,8])/2)+(Subscript[x, p,9]);
(Subscript[x, m])=(Subscript[x, p,0])+((Subscript[x, p,1])/2)+(Subscript[x, p,3])+((Subscript[x, p,4])/2)+((Subscript[x, p,5])/2)+(Subscript[x, p,7])+((Subscript[x, p,8])/2);

(Subscript[w, M])=(Subscript[x, M]) (Subscript[w, MM])+(Subscript[x, m]) (Subscript[w, Mm]);
(Subscript[w, m])=(Subscript[x, M]) (Subscript[w, Mm])+(Subscript[x, m]) (Subscript[w, mm]);

qlesoln={cij->0,FA->(Subscript[F, A,p]),FM->0,cijcj->0,cijci->0,cijcij->0,cicj->0};
orderAssumptions={(Subscript[Δ, Mm])->(Subscript[Δ, Mm])*ϵ,(Subscript[Δ, MM])->(Subscript[Δ, MM])*ϵ,(Subscript[α, h])->(Subscript[α, h])ϵ,(Subscript[α, p])->(Subscript[α, p])ϵ,(Subscript[β, p])->(Subscript[β, p])ϵ,(Subscript[s, fl])->(Subscript[s, fl])ϵ,(Subscript[c, h])->(Subscript[c, h])ϵ,(Subscript[c, p1])->(Subscript[c, p1])ϵ,(Subscript[c, p2])->(Subscript[c, p2])ϵ};

diffw=Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.Apply[XtoD,currGen]/.changeOfVarHOST/.qlesoln/.{pA->(Subscript[δ, p])+1/2,(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]),(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])}/.orderAssumptions,{ϵ,0,2}]]//FullSimplify

So our invasion term to put in ms (Table 2) is
((13 (Subscript[α, p])-3(Subscript[β, p]))/16) +(1/4) ((Subscript[α, p])+(Subscript[β, p])) ((Subscript[δ, h]^2) (((1-2 (Subscript[δ, p])))^2)-(Subscript[δ, h]) (((1-2 (Subscript[δ, p])))^2)-3 (-1+(Subscript[δ, p])) (Subscript[δ, p]))-((Subscript[c, p1]) ((1-(Subscript[δ, p])) (Subscript[δ, p])+(3/4)))
And with  (Subscript[F, A,h])
((13 (Subscript[α, p])-3(Subscript[β, p]))/16) +(1/4) ((Subscript[α, p])+(Subscript[β, p])) ((Subscript[δ, h]^2) (((1-2 (Subscript[δ, p])))^2)-(Subscript[δ, h]) (((1-2 (Subscript[δ, p])))^2)-3 (-1+(Subscript[δ, p])) (Subscript[δ, p])+(4 (Subscript[δ, h]^2)-4 (Subscript[δ, h])-3) (Subscript[F, A,p])+(((1-2 (Subscript[δ, p])))^2) (Subscript[F, A,h])+4(Subscript[F, A,h]) (Subscript[F, A,p]))-(Subscript[c, p1]) ((1-(Subscript[δ, p])) (Subscript[δ, p])+(3/4)-(Subscript[F, A,p])) 
where (Subscript[F, A,h])= (((1/4-(Subscript[δ, h]^2)))^2) ((Subscript[c, h])-(Subscript[f, mm]) (Subscript[α, h]) (((1/2-(Subscript[δ, p])))^2)) (1-(Subscript[ψ, h]))/(Subscript[ψ, h])
and (Subscript[F, A,p])=(((1/4-(Subscript[δ, p]^2)))^2)((Subscript[c, p2])+(Subscript[f, mm])(Subscript[c, p1])+(Subscript[f, mm]) (((Subscript[α, p])+(Subscript[β, p])) ((Subscript[δ, h]^2)-(Subscript[δ, h])-3/4)))  (1-(Subscript[ψ, p]))/(Subscript[ψ, p])

deltaSolns={(Subscript[δ, p])->(1/2)-((Sqrt[(Subscript[c, h])])/((Sqrt[(Subscript[f, mm])]) (Sqrt[(Subscript[α, h])]))),(Subscript[δ, h])->(((Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p]))-2 (Sqrt[-(Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p])) ((Subscript[c, p2])+(Subscript[f, mm]) ((Subscript[c, p1])+((Subscript[α, p])+(Subscript[β, p])) (-1+(Subscript[F, A,h]))))]))/(2 (Subscript[f, mm]) ((Subscript[α, p])+(Subscript[β, p]))))};

diffw=Normal[Series[(Subscript[w, M])-(Subscript[w, m])/.Apply[XtoD,currGen]/.changeOfVarHOST/.qlesoln/.{pA->(Subscript[δ, p])+1/2,(Subscript[f, Mm])->(Subscript[f, mm])+(Subscript[Δ, Mm]),(Subscript[f, MM])->(Subscript[f, mm])+(Subscript[Δ, MM])}/.deltaSolns/.orderAssumptions,{ϵ,0,2}]]//Simplify

diffw=-((((Subscript[c, h]) (Subscript[c, p2])+(Subscript[f, mm]^2) (Subscript[α, h]) ((Subscript[c, p1])+(Subscript[s, fl])-(Subscript[α, p]))))/((Subscript[f, mm]^2) (Subscript[α, h])));

For cP1 plots:

Normal[Series[diffw/.(Subscript[c, p2])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),0,-1}]]
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;
Normal[Series[diffw/.(Subscript[c, p2])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),1,0}]]//Simplify
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;

For cP2 plots:

Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),0,-1}]]
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),1,0}]]//Simplify
Solve[%==0,(Subscript[β, p])]//Simplify//Flatten;

-(((Subscript[c, h]) (Subscript[c, p2]))/(Subscript[α, h]))+(Subscript[α, p])/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.01
-(((Subscript[c, h]) (Subscript[c, p2]))/(Subscript[α, h]))+(Subscript[α, p])/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.05

fmLevels={0.1,0.3,0.5,0.7,0.9};
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),fmLevels[[1]],0}]]//Simplify;
Solve[(%/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.01)==0,(Subscript[α, p])]//Flatten
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),fmLevels[[2]],0}]]//Simplify;
Solve[(%/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.01)==0,(Subscript[α, p])]//Flatten
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),fmLevels[[3]],0}]]//Simplify;
Solve[(%/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.01)==0,(Subscript[α, p])]//Flatten
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),fmLevels[[4]],0}]]//Simplify;
Solve[(%/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.01)==0,(Subscript[α, p])]//Flatten
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),fmLevels[[5]],0}]]//Simplify;
Solve[(%/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.01)==0,(Subscript[α, p])]//Flatten

fmLevels={0.1,0.3,0.5,0.7,0.9};
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),fmLevels[[1]],0}]]//Simplify;
Solve[(%/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.05)==0,(Subscript[α, p])]//Flatten
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),fmLevels[[2]],0}]]//Simplify;
Solve[(%/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.05)==0,(Subscript[α, p])]//Flatten
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),fmLevels[[3]],0}]]//Simplify;
Solve[(%/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.05)==0,(Subscript[α, p])]//Flatten
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),fmLevels[[4]],0}]]//Simplify;
Solve[(%/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.05)==0,(Subscript[α, p])]//Flatten
Normal[Series[diffw/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0,{(Subscript[f, mm]),fmLevels[[5]],0}]]//Simplify;
Solve[(%/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.05)==0,(Subscript[α, p])]//Flatten

diffw

-(((Subscript[c, h]) (Subscript[c, p2])+(Subscript[f, mm]^2) (Subscript[α, h]) ((Subscript[c, p1])+(Subscript[s, fl])-(Subscript[α, p])))/((Subscript[f, mm]^2) (Subscript[α, h])))/.(Subscript[c, p1])->0/.(Subscript[s, fl])->0

Plot[(((Subscript[c, h]) (Subscript[c, p2])-(Subscript[f, mm]^2) (Subscript[α, h]) (Subscript[α, p]))/((Subscript[f, mm]^2) (Subscript[α, h])))/.(Subscript[α, h])->0.05/.(Subscript[c, h])->0.01/.(Subscript[c, p2])->0.01/. (Subscript[α, p])->0.01,{ (Subscript[f, mm]),0,1},PlotRange->{0,1}]