Epidemic simulation

Needs["IGraphM`"];

When performing a single simulation, IGSIRProcess returns a TimeSeries expression of {s,i,r} values. When multiple runs are requested, the resulting time series are combined into a TemporalData expression.

SeedRandom[42];
g=IGWattsStrogatzGame[100, 0.05]

Perform a single SIR simulation:

ts=IGSIRProcess[g,{5,1}]

Plot the results with a legend:

ListLinePlot[ts,PlotLegends->ts["ComponentNames"]]

Plot only the number of infected nodes:

ListLinePlot[ts["PathComponent","I"],
AxesLabel->{"time","infected"},PlotStyle->ColorData[97][2]]

Find the number of susceptible, infected and recovered nodes at a specific time point:

ts[1.0]

Perform 100 simulations simultaneously:

td=IGSIRProcess[g,{5,1},100]

Plot the median number of susceptible, infected and recovered nodes:

Show[
ListLinePlot[#,PlotStyle->GrayLevel[0,0.1],PlotRange->{0,VertexCount[g]}],
Quiet@Plot[Median[#[t]],{t,0,4},PlotStyle->Red]
]&/@td["PathComponents"]//GraphicsColumn

In the next example, we compare epidemic spreading on a periodic grid, i.e. a network that only has spatially local connections, with a rewired version of the same network which also includes long range links. We rewire 5% of links while ensuring that the graph stays connected.

IGSquareLattice[{30,30}]

g1=IGSquareLattice[{30,30},"Periodic"->True]
g2=IGTryUntil[IGConnectedQ][IGRewireEdges[g1,0.05]];
Graph[g2,VertexCoordinates->GraphEmbedding[g1]]

Generate 1000 simulations for each network.

r1=IGSIRProcess[g1,{1,1},1000];
r2=IGSIRProcess[g2,{1,1},1000];

Plot the histogram of the total duration of the epidemic.

Histogram[{r1["LastTimes"],r2["LastTimes"]},ChartLegends->{"grid","rewired"}]

Plot the fraction of recovered nodes at the end of the epidemic.

tmax=Max[r1["MaximumTime"],r2["MaximumTime"]];
Histogram[
{r1["PathComponent",3]["SliceData",tmax]/VertexCount[g1],
r2["PathComponent",3]["SliceData",tmax]/VertexCount[g2]}//Quiet,
{0,1,0.02},
ChartLegends->{"grid","rewired"}
]