sir4.mws

sir4.mws

This Maple worksheet derives the diffusion approximation of a bivariate Markov population process that serves as an SIR model, accounting for differential death rate. NOTE that this model uses the proper infection rate!

The file "abc.m" contains the three procedures equ, cov, denote used below. The source code for these procedures is contained in the Maple worksheet abc.mws

> restart;
with(linalg,matrix,jacobian);
read "C:/mydocu~1/ingemar/maple/desto/abc.m";
unprotect(gamma);

[matrix, jacobian]

Reparametrize! Express old parameters in terms of new ones:

> gamma:=mu*(alpha1-delta1); beta:=mu*alpha1*R0; mu1:=mu*(delta1-1);

gamma := mu*(alpha1-delta1)

beta := mu*alpha1*R0

mu1 := mu*(delta1-1)

The transition rates (for scaled state variables x1=S/N, x2=I/N, x3=R/N) are stored in the table trans :

> trans:=table([[1,0,0]=mu,[-1,1,0]=beta*x1*x2/(x1+x2+x3),[-1,0,0]=mu*x1,[0,-1,1]=gamma*x2,[0,-1,0]=(mu+mu1)*x2,[0,0,-1]=mu*x3]);

trans := TABLE([[1, 0, 0] = mu, [-1, 1, 0] = mu*alp...
trans := TABLE([[1, 0, 0] = mu, [-1, 1, 0] = mu*alp...
trans := TABLE([[1, 0, 0] = mu, [-1, 1, 0] = mu*alp...
trans := TABLE([[1, 0, 0] = mu, [-1, 1, 0] = mu*alp...

The RHSs of the three deterministic ODEs are determined via the procedure equ :

> eq1:=equ(1,trans);
eq2a:=equ(2,trans);
eq3:=equ(3,trans);

eq1 := mu-mu*alpha1*R0*x1*x2/(x1+x2+x3)-mu*x1

eq2a := mu*alpha1*R0*x1*x2/(x1+x2+x3)-mu*(alpha1-de...

eq3 := mu*(alpha1-delta1)*x2-mu*x3

Check the op # here!

> eq2:=op(1,eq2a)+simplify(eq2a-op(1,eq2a));

eq2 := mu*alpha1*R0*x1*x2/(x1+x2+x3)-mu*x2*alpha1

The local covariance matrix Sx is determined by the procedure cov:

> Sx:=cov(trans);

Sx := matrix([[mu+mu*alpha1*R0*x1*x2/(x1+x2+x3)+mu*...

Check the op # here!

> Sx[2,2]:=op(1,Sx[2,2])+simplify(Sx[2,2]-op(1,Sx[2,2]));

Sx[2,2] := mu*alpha1*R0*x1*x2/(x1+x2+x3)+mu*x2*alph...

Critical points:

> crit:=[solve({eq1,eq2,eq3},{x1,x2,x3})];

crit := [{x1 = 1, x2 = 0, x3 = 0}, {x1 = (1+alpha1-...

Denote the critical point that corresponds to endemic infection by x10, x20, x30:

> xx:=denote(crit):
x10:=xx[1]; x20:=xx[2]; x30:=xx[3];

x10 := (1+alpha1-delta1)/(alpha1*R0-delta1+1)

x20 := (R0-1)/(alpha1*R0-delta1+1)

x30 := (R0-1)*(alpha1-delta1)/(alpha1*R0-delta1+1)

The Jacobian:

> Bx:=jacobian([eq1,eq2,eq3],[x1,x2,x3]);

Bx := matrix([[-mu*alpha1*R0*x2/(x1+x2+x3)+mu*alpha...

Evaluate the Jacobian at the critical point:

> B:=simplify(subs({x1=x10,x2=x20,x3=x30},evalm(Bx)));

B := matrix([[-mu*(alpha1*R0^2-alpha1*R0+alpha1+R0-...

Evaluate the local covariance matrix at the critical point:

> S:=simplify(subs(x1=x10,x2=x20,x3=x30,evalm(Sx)));

S := matrix([[2*mu, -mu*(R0-1)*alpha1/(alpha1*R0-de...

Now proceed to solve B*SIG+SIG*BT=-S:

> SIG:=matrix([[s11,s12,s13],[s12,s22,s23],[s13,s23,s33]]):

> A:=evalm(B&*SIG+SIG&*transpose(B)):

A and S are symmetric. Formulate 6 equations:

> e1:=A[1,1]=-S[1,1]: e2:=A[1,2]=-S[1,2]: e3:=A[1,3]=-S[1,3]:
e4:=A[2,2]=-S[2,2]: e5:=A[2,3]=-S[2,3]: e6:=A[3,3]=-S[3,3]:

Solve for the elements of the covariance matrix SIG:

> solve({e1,e2,e3,e4,e5,e6},{s11,s12,s13,s22,s23,s33}):

> assign(%);

Asymptotic approximations for alpha1 large. Use subscript a.

> x10a:=map(simplify,convert(asympt(x10,alpha1,2),polynom));
x20a:=map(simplify,convert(asympt(x20,alpha1,3),polynom));
x30a:=map(simplify,convert(asympt(x30,alpha1,2),polynom));

x10a := 1/R0

x20a := (R0-1)/(R0*alpha1)+(R0-1)*(delta1-1)/(alpha...

x30a := (R0-1)/R0-(R0-1)*(R0*delta1-delta1+1)/(alph...

> s11a:=map(simplify,convert(asympt(s11,alpha1,1),polynom));

s11a := alpha1/(R0^2)-(-R0^2+2*R0*delta1-2*R0-3*del...

> s12a:=map(simplify,convert(asympt(s12,alpha1,2),polynom));

s12a := -1/R0+(R0^2*delta1-R0*delta1-delta1+1)/(R0^...

> s13a:=map(simplify,convert(asympt(s13,alpha1,1),polynom));

s13a := -alpha1/(R0^2)+(R0^2-3*R0+3*R0*delta1-3*del...

> s22a:=map(simplify,convert(asympt(s22,alpha1,2),polynom));

s22a := (R0-1)/(R0^2)-(-R0^3+R0^2*delta1+2*R0+2*del...

> s23a:=map(simplify,convert(asympt(s23,alpha1,2),polynom));

s23a := 1/(R0^2)-(R0^2-3*R0+3*R0*delta1-3*delta1+3)...

> s33a:=map(simplify,convert(asympt(s33,alpha1,1),polynom));

s33a := alpha1/(R0^2)-(-R0^3+2*R0^2-3*R0+4*R0*delta...

Compute the mean and variance of x1+x2+x3:

> ma1:=map(simplify,convert(asympt(x10+x20+x30,alpha1,3),polynom));
ma:=simplify(ma1-op(3,ma1))+factor(op(3,ma1));

ma1 := 1/R0+(R0-1)/R0-(R0*delta1-R0-delta1+1)/(R0*a...

ma := 1-(R0-1)*(delta1-1)/(alpha1*R0)

> va1:=convert(asympt(simplify(s11+s22+s33+2*s12+2*s13+2*s23),alpha1,2),polynom):
va:=map(factor,va1);

va := 1+(delta1-1)*(delta1-R0^2+R0-1)/(alpha1*R0^2)...