Exercise 5: the evolution of aggressivity under limited dispersal

Clear["Global`*"]

Relatedness in the moran model  with n = 2

solr2 = Flatten@Solve[ r2 ==  (1/n)r2+((n-1)/n)(1-m)((1/n)+((n-1)/n)r2),r2] /. n-> 2 //Simplify

Payoffs

PayoffFocal = y x ((v/2)-c)+ y (1-x)v + (1-y)x *0 + (1-y)(1-x)(v/2)  /. y-> zFocal/. x-> z1  ;
PayoffNeighbour = y x ((v/2)-c)+ y (1-x)v + (1-y)x *0 + (1-y)(1-x)(v/2) /. y-> z1/. x-> zFocal ;
PayoffFResident= y x ((v/2)-c)+ y (1-x)v + (1-y)x *0 + (1-y)(1-x)(v/2) /. y-> x  ;

Individual fitness

w = (1/2) +(1/2)(1+δ PayoffFocal)(((1-m)/((1/2)(1-m)(1+δ PayoffFocal+1+δ PayoffNeighbour)+m (1+δ PayoffFResident)))+(m/( (1+δ PayoffFResident)))) ;

(* sanity check *)
w ==1/. zFocal-> x/.z1->x //Simplify
D[w,zFocal] + D[w,z1] + D[w,x] == 0  /. zFocal-> x/.z1->x //Simplify

Selection gradient

D[w,zFocal] + r2 D[w,z1]  /. zFocal-> x/.z1->x  /. solr2//Simplify
Series[%,{δ,0,1}] //Normal 
S = % /. δ-> 1

equi = Flatten@Solve[S == 0,x]

-(v/(2 c (-2+m))) == (v/(2 c))(1/((2-m))) //Simplify
(* where (v/(2 c)) is the equilibrium in a well mixed population. This shows limited dispersal can reduce by half the probability of being aggressive *)

D[S,x] /. equi
(* which is always negative *)

Hessian

D[w,zFocal,zFocal] +2 r2 D[w,zFocal,z1] + r2 D[w,z1,z1]    /. zFocal-> x/.z1->x  /. solr2 /. equi//Simplify
Series[%,{δ,0,2}] //Normal  ;
H = % /. δ-> 1

Plot[H /. v-> 1 /. c-> 1,{m,0,1}]

(* which shows that limited dispersal tends to make selection more stabilising. This is because kin selection tends to favour more even distribution of ressources. *)

Exercise 6: the evolution of altruism for survival

Clear["Global`*"]

Relatedness in the moran model  with n = 2

solr2 = Flatten@Solve[ r2 ==  (1/n)r2+((n-1)/n)(1-m)((1/n)+((n-1)/n)r2),r2] /. n->2 //Simplify

Fitness of focal with arbitrary survival and fecundity effects  with n = 2

w = ((s[zFocal,z1])/(s[zFocal,z1]+s[z1,zFocal] )) +(1/2)f[zFocal,z1](((1-m)/((((f[zFocal,z1]+f[z1,zFocal])(1-m))/2)+m f[x,x]))+(m/(f[x,x]))) ;

(* sanity check *)
w ==1/. zFocal-> x/.z1->x //Simplify
D[w,zFocal] + D[w,z1] + D[w,x] == 0  /. zFocal-> x/.z1->x //Simplify

General selection gradient

S = D[w,zFocal]+r2 D[w,z1]/. zFocal-> x/.z1->x /. solr2 //FullSimplify ;

Fecundity benefits and costs

f[x,x] S /. f->Function[{z1,z2},1+b z2 - c z1] /.s-> Function[{z1,z2},s]  // FullSimplify ; 
% ==(( (3-m) m)/(2 (1+m)))(b ((1-m)/(3-m))-c )//Simplify

Survival benefits and costs

s[x,x] S /. f->Function[{z1,z2},f] /.s-> Function[{z1,z2},1+b z2 - c z1 ]  // FullSimplify ;
% ==(m/(2 (1+m)))(-b-c) //Simplify

(* so selection always acts against altruism here. This is because kin competition is very intense as you only compete against death within patches *)

Survival costs and fecundity benefits

S /. f->Function[{z1,z2},1+b z2 ] /.s-> Function[{z1,z2},1- c z1 ]  // FullSimplify

equi = Flatten@Solve[%==0,x]

D[S,x] /. f->Function[{z1,z2},1+b z2 ] /.s-> Function[{z1,z2},1- c z1 ]/. equi // FullSimplify

(* so now there exsists a stable intermediate level of altruism that increases with limited dispersal *)

Plot[Evaluate[x/. equi/.c->.1 /.b->.5],{m,0,1},AxesOrigin->{0,0}]