Correlation Dynamics and Probabilistic Cellular Automata

Test

Montpellier,October 26, 2001
Cambridge November 11, 2001
Paris May 15, 2002
Edinburgh, June 25. 2002
Paris, February 8, March 8, April 1 2003
Amsterdam, May 28, 2003
Paris, October 23, 2003
Paris, March 19, April 5, April 29, July 3, 2004
Paris, February 8, 2005

This Mathematica notebook gives an overview of what can be done with my cellular automaton and correlation dynamics packages.
More info on the pages on correlation dynamics on my personal website.

•Load Modules

Put the packages in Mathematica's preferred locations or place them together with the notebook. Modify the following so that Mathematica operates in the right directory

In[1]:=

SetDirectory[ToFileName[{"~", "Simus", "Demo-v31"}]] ;

In[2]:=

<< PCA.v28.m

Out[2]=

PCA.v28 February 2, 2005

In[3]:=

<< IPA.v16.m

Out[3]=

IPA.v16 June 23, 2004

•Define the Model

We are going to define a model where every site is either empty, occupied by a healthy (sus) or an infected (inf) host:

In[4]:=

omega = {emp, oc[sus], oc[inf]}

Out[4]=

{emp, oc[sus], oc[inf]}

The events that change the states of sites are

In[5]:=

eventList :=  {event[ {oc[i_], emp},  {oc[i_], oc[sus]}] :> phi b[i],  event[ {oc[i_], x_},  {emp, x_}] :> phi d[i],  event[ {oc[sus], oc[inf]},  {oc[inf], oc[inf]}] :> phi beta,  event[ {oc[i_], emp},  {emp, oc[i_]}] :> phi m[i]} ;

which represent reproduction, mortality, infection and movement.

In[6]:=

parameterValues :=  {phi -> 1/6, (* note : phi equals one over the number of neighbours *)  theta -> 2/5,  b[sus] -> b0,  b[inf] -> (1 - epsilon) b0,  d[sus] -> d0,  d[inf] -> d0 + alpha,  m[sus] -> 2,  m[inf] -> 4,  b0 -> 4,  d0 -> 1,  beta -> 20,  alpha -> 0.5,  epsilon -> 0.75,  init[emp] -> 1 - init[oc[sus]] - init[oc[inf]],  init[oc[sus]] -> 0.6,  init[oc[inf]] -> 0.001}

some definitions for displaying things:

In[7]:=

color[sus] = RGBColor[0, 0, 0] ; color[inf] = RGBColor[1, 0, 0] ; light[RGBColor[r_, g_, b_], f_: 0.5] := RGBColor[1 - f + f r, 1 - f + f g, 1 - f + f b]

some simulation specifications

In[10]:=

tfin = 25 ;

•Run mean field model

In[11]:=

mfState

Out[11]=

{p[{emp}], p[{oc[sus]}], p[{oc[inf]}]}

In[12]:=

{p[{emp}], p[{oc[sus]}], p[{oc[inf]}]}

Out[12]=

{p[{emp}], p[{oc[sus]}], p[{oc[inf]}]}

In[13]:=

mfGrad // TableForm

Out[13]//TableForm=

-b[inf] p[{emp}] p[{oc[inf]}] + d[inf] p[{emp}] p[{oc[inf]}] + d[inf] p[{oc[inf]}]^2 - b[sus] p[{emp}] p[{oc[sus]}] + d[sus] p[{emp}] p[{oc[sus]}] + d[inf] p[{oc[inf]}] p[{oc[sus]}] + d[sus] p[{oc[inf]}] p[{oc[sus]}] + d[sus] p[{oc[sus]}]^2
b[inf] p[{emp}] p[{oc[inf]}] + b[sus] p[{emp}] p[{oc[sus]}] - d[sus] p[{emp}] p[{oc[sus]}] - beta p[{oc[inf]}] p[{oc[sus]}] - d[sus] p[{oc[inf]}] p[{oc[sus]}] - d[sus] p[{oc[sus]}]^2
-d[inf] p[{emp}] p[{oc[inf]}] - d[inf] p[{oc[inf]}]^2 + beta p[{oc[inf]}] p[{oc[sus]}] - d[inf] p[{oc[inf]}] p[{oc[sus]}]

In[14]:=

mfGradN = mfGrad //. parameterValues ;

In[15]:=

mfInitN = (init /@ omega) //. parameterValues ;

In[16]:=

MFsol = myNDSolve[mfGradN, mfState, mfInitN, {t, 0, 25}, MaxSteps -> 100000] ;

In[17]:=

pMF =  Plot[ {p[oc[sus], mf[t]], p[oc[inf], mf[t]]},  {t, 0, tfin},  PlotStyle -> {{Dashing[{0.03, 0.01}], color[sus]},  {Dashing[{0.03, 0.01}], color[inf]}},  PlotRange -> {0, Automatic}]

[Graphics:HTMLFiles/demo.nb_24.gif]

Out[17]=

-Graphics -

•Run correlation dynamics version

In[18]:=

ipaGradN = ipaGrad //. simulationRules ; ipaInitN = ipaInit //. simulationRules ; IPAsol = myNDSolve[ipaGradN, ipaState, ipaInitN, {t, 0, tfin}, MaxSteps -> 10000] ;

Global densities

In[21]:=

pIPA =  Plot[ {p[oc[sus], ipa[t]], p[oc[inf], ipa[t]]},  {t, 0, tfin},  PlotStyle -> {{Thickness[0.02], light[color[sus]]}, {Thickness[0.02], light[color[inf]]}},  PlotRange -> {0, 0.6}]

[Graphics:HTMLFiles/demo.nb_28.gif]

Out[21]=

-Graphics -

Densities as `seen' by the parasite

In[22]:=

qIPA =  Plot[ {q[oc[sus], oc[inf], ipa[t]], q[oc[inf], oc[inf], ipa[t]]},  {t, 0, tfin},  PlotStyle -> {{Thickness[0.02], light[color[sus]]}, {Thickness[0.02], light[color[inf]]}},  PlotRange -> {0, 0.6}]

[Graphics:HTMLFiles/demo.nb_31.gif]

Out[22]=

-Graphics -

•Correlation dynamics equations

In[23]:=

ipaState

Out[23]=

{p[{emp, emp}], p[{emp, oc[sus]}], p[{emp, oc[inf]}], p[{oc[sus], oc[sus]}], p[{oc[sus], oc[inf]}], p[{oc[inf], oc[inf]}]}

In[24]:=

{p[{emp, emp}], p[{emp, oc[sus]}], p[{emp, oc[inf]}], p[{oc[sus], oc[sus]}], p[{oc[sus], oc[inf]}], p[{oc[inf], oc[inf]}]}

Out[24]=

{p[{emp, emp}], p[{emp, oc[sus]}], p[{emp, oc[inf]}], p[{oc[sus], oc[sus]}], p[{oc[sus], oc[inf]}], p[{oc[inf], oc[inf]}]}

In[25]:=

ipaState[[3]]

Out[25]=

p[{emp, oc[inf]}]

In[26]:=

p[{emp, oc[inf]}]

Out[26]=

p[{emp, oc[inf]}]

In[27]:=

ipaGrad[[3]]

Out[27]=

p[{oc[inf], oc[inf]}] (d[inf] + ihp m[inf] q[emp, {oc[inf], oc[inf]}]) + p[{oc[sus], oc[inf]}] (d[sus] + ihp m[sus] q[emp, {oc[sus], oc[inf]}]) + ihp m[inf] p[{emp, emp}] q[oc[inf], {emp, emp}] + beta ihp p[{emp, oc[sus]}] q[oc[inf], {oc[sus], emp}] + p[{emp, oc[inf]}] (-phi b[inf] - d[inf] - ihp m[inf] q[emp, {oc[inf], emp}] - ihp b[inf] q[oc[inf], {emp, oc[inf]}] - ihp m[inf] q[oc[inf], {emp, oc[inf]}] - ihp b[sus] q[oc[sus], {emp, oc[inf]}] - ihp m[sus] q[oc[sus], {emp, oc[inf]}])

These equations can be worked a bit more to look like proper correlation dynamics equations, but Mathematica remains rather limited in its capacity to represent symbolic output.

•Run explicit PCA simulations

Define temporal...

In[28]:=

starttime = 0 ; stoptime = 5 ; dt = 1/8 ; dtout = 1/4 ; method = sloppy ;

... and spatial aspects of the simulation

In[33]:=

latticeType = triangular ; rows = 50 ; cols = 50 ;

where to store the results

In[36]:=

runName = "demo1" ;

... and put together parameter files instructing the external module simpca

In[37]:=

prepLattice[]

Creating New Lattice.

Seeding Lattice.

In[38]:=

Timing[simPCA[]]

Hold[time[]]   =   0.`

Hold[time[]]   =   0.25`

Hold[time[]]   =   0.5`

Hold[time[]]   =   0.75`

Hold[time[]]   =   1.`

Hold[time[]]   =   1.25`

Hold[time[]]   =   1.5`

Hold[time[]]   =   1.75`

Hold[time[]]   =   2.`

Hold[time[]]   =   2.25`

Hold[time[]]   =   2.5`

Hold[time[]]   =   2.75`

Hold[time[]]   =   3.`

Hold[time[]]   =   3.25`

Hold[time[]]   =   3.5`

Hold[time[]]   =   3.75`

Hold[time[]]   =   4.`

Hold[time[]]   =   4.25`

Hold[time[]]   =   4.5`

Hold[time[]]   =   4.75`

Hold[time[]]   =   5.`

Hold[time[]]   =   5.`

Out[38]=

{460.46` Second, Null}

(This takes a long time, but using Mathematica for this kind of simulation is like using a gun to kill a mosquito, whatever its original author might say)

Global and local densities:

In[39]:=

pPCA1 =  Plot[ {p[oc[sus], pca[t]], p[oc[inf], pca[t]]},  {t, 0, stoptime},  PlotStyle -> {{Thickness[0.01], color[sus]}, {Thickness[0.01], color[inf]}},  PlotRange -> {0, 0.8}]

[Graphics:HTMLFiles/demo.nb_74.gif]

Out[39]=

-Graphics -

In[40]:=

qPCA1 =  Plot[ {q[oc[sus], oc[inf], pca[t]], q[oc[inf], oc[inf], pca[t]]},  {t, 0, stoptime},  PlotPoints -> 50,  PlotStyle -> {{Thickness[0.01], color[sus]}, {Thickness[0.01], color[inf]}},  PlotRange -> {0, 0.8}]

[Graphics:HTMLFiles/demo.nb_77.gif]

Out[40]=

-Graphics -

•Run external PCA simulations

In[41]:=

stoptime = tfin ;

Where to store the results

In[42]:=

runName = "demo2" ;

... and put together parameter files instructing the external module simpca

In[43]:=

prepLattice[]

Creating New Lattice.

Seeding Lattice.

In[44]:=

prepExternal[]

Creating parameter file simpca.in

Creating lattice file demo2.lat

Creating initial state file demo2.sig

... Ready

In[45]:=

! simpca29

The following two commands read from file the simulation results

In[46]:=

readLattice[]

In[47]:=

readRun[]

Global and local densities

In[48]:=

pPCA2 =  Plot[ {p[oc[sus], pca[t]], p[oc[inf], pca[t]]},  {t, 0, tfin},  PlotStyle -> {{Thickness[0.01], color[sus]}, {Thickness[0.01], color[inf]}},  PlotRange -> {0, 0.8}]

[Graphics:HTMLFiles/demo.nb_93.gif]

Out[48]=

-Graphics -

In[49]:=

qPCA2 =  Plot[ {q[oc[sus], oc[inf], pca[t]], q[oc[inf], oc[inf], pca[t]]},  {t, 0, tfin},  PlotPoints -> 50,  PlotStyle -> {{Thickness[0.01], color[sus]}, {Thickness[0.01], color[inf]}},  PlotRange -> {0, 0.8}]

[Graphics:HTMLFiles/demo.nb_96.gif]

Out[49]=

-Graphics -

•Compare the results

with mean field model

In[50]:=

Show[pMF, pPCA1, pPCA2, PlotRange -> {{0, tfin}, {0, 0.8}}]

[Graphics:HTMLFiles/demo.nb_99.gif]

Out[50]=

-Graphics -

with correlation dynamics model

In[51]:=

Show[pIPA, pPCA1, pPCA2, PlotRange -> {{0, tfin}, {0, 0.8}}]

[Graphics:HTMLFiles/demo.nb_102.gif]

Out[51]=

-Graphics -

Now, compare predictions about the local environment of parasites

In[52]:=

Show[pMF, qIPA, qPCA1, qPCA2, PlotRange -> {{0, tfin}, {0, 0.8}}]

[Graphics:HTMLFiles/demo.nb_105.gif]

Out[52]=

-Graphics -

•Make snapshot of lattice

In[53]:=

plotState[emp, pos_] := {GrayLevel[1], Disk[pos, 0.4]} plotState[oc[x_], pos_] := {color[x], Disk[pos, 0.4]}

In[55]:=

readSigma[tfin]

Out[55]=

True

In[56]:=

showLattice[]

[Graphics:HTMLFiles/demo.nb_111.gif]

Out[56]=

-Graphics -

In[57]:=

If[1 == 2, makeAnimation[runName, 0, stoptime, dt]]

•An Allee effect

To show how vital rates can be density dependent, let us introduce an Allee effect

In[58]:=

eventList :=  {event[ {oc[i_], emp},  {oc[i_], oc[sus]}] :> phi b[i] (phi 2 (1 - nb[emp, $focus]))^2,  event[ {oc[i_], x_},  {emp, x_}] :> phi d[i],  event[ {oc[sus], oc[inf]},  {oc[inf], oc[inf]}] :> phi beta,  event[ {oc[i_], emp},  {emp, oc[i_]}] :> phi m[i]} ;

here it is assumed that birth rates increase with double the square of local density (phi is one over the number of neighbours)

In[59]:=

ipaGradN = ipaGrad //. simulationRules ; ipaInitN = ipaInit //. simulationRules ; IPAsol = myNDSolve[ipaGradN, ipaState, ipaInitN, {t, 0, tfin}, MaxSteps -> 10000] ;

Global densities

In[62]:=

pIPA3 =  Plot[ {p[oc[sus], ipa[t]], p[oc[inf], ipa[t]]},  {t, 0, tfin},  PlotStyle -> {{Thickness[0.02], light[color[sus]]}, {Thickness[0.02], light[color[inf]]}},  PlotRange -> {0, 0.6}]

[Graphics:HTMLFiles/demo.nb_117.gif]

Out[62]=

-Graphics -

Densities as `seen' by the parasite

In[63]:=

qIPA3 =  Plot[ {q[oc[sus], oc[inf], ipa[t]], q[oc[inf], oc[inf], ipa[t]]},  {t, 0, tfin},  PlotStyle -> {{Thickness[0.02], light[color[sus]]}, {Thickness[0.02], light[color[inf]]}},  PlotRange -> {0, 0.6}]

[Graphics:HTMLFiles/demo.nb_120.gif]

Out[63]=

-Graphics -

In[64]:=

runName = "demo3" ;

In[65]:=

prepLattice[]

Creating New Lattice.

Seeding Lattice.

In[66]:=

prepExternal[]

Creating parameter file simpca.in

Creating lattice file demo3.lat

Creating initial state file demo3.sig

... Ready

In[67]:=

! simpca29

In[68]:=

readLattice[]

In[69]:=

readRun[]

Results

In[70]:=

pPCA3 =  Plot[ {p[oc[sus], pca[t]], p[oc[inf], pca[t]]},  {t, 0, tfin},  PlotStyle -> {{Thickness[0.01], color[sus]}, {Thickness[0.01], color[inf]}},  PlotRange -> {0, 0.8}]

[Graphics:HTMLFiles/demo.nb_135.gif]

Out[70]=

-Graphics -

In[71]:=

qPCA3 =  Plot[ {q[oc[sus], oc[inf], pca[t]], q[oc[inf], oc[inf], pca[t]]},  {t, 0, tfin},  PlotPoints -> 50,  PlotStyle -> {{Thickness[0.01], color[sus]}, {Thickness[0.01], color[inf]}},  PlotRange -> {0, 0.8}]

[Graphics:HTMLFiles/demo.nb_138.gif]

Out[71]=

-Graphics -

In[72]:=

Show[qIPA3, qPCA3]

[Graphics:HTMLFiles/demo.nb_141.gif]

Out[72]=

-Graphics -

In[73]:=

readSigma[tfin]

Out[73]=

True

In[74]:=

showLattice[]

[Graphics:HTMLFiles/demo.nb_146.gif]

Out[74]=

-Graphics -


Converted by Mathematica  (February 8, 2005)