用 R 跨界建模丨EpiModel 快速上手传染病模型

点击上方蓝字

关注我们

（本文阅读时间：18分钟）

算法为王系列文章，涵盖了计算机算法，数据挖掘(机器学习)算法，统计算法，金融算法等的多种跨学科算法组合。在大数据时代的背景下，算法已经成为了金字塔顶的明星。算法为王的时代正式到来……

对于传染病学科中，已经有专业的团队开发出了专业的模型，所以其实我们不需要手动从头写代码，站在巨人的肩膀前进会让我们进步的更快。

本次将介绍的 EpiModel 包就是一个专业做传染病动力学模型的工具，不仅支持基本的 SI, SIS, SIR 模型，还支持扩展，自定义开发等酷炫功能，让我们进行传染病的模型开发和模拟，有非常大的帮助。

用 R 进行跨界建模，打破自己的知识壁垒。世界真奇妙，让我们用 R 来探索吧。

微软MVP实验室研究员

  //  

微软 MVP - 张丹

R语言实践者；北京青萌数海科技有限公司CTO

10年以上互联网应用架构经验，在 R、Java、NodeJS、大数据、数据挖掘等方面有深厚的积累。精通量化投资交易策略，熟悉中国金融二级市场、交易规则和投研体系。熟悉数据学科方法论，在外汇、海关、区块链等领域均有落地的应用。著有《R的极客理想：量化投资篇》、《R的极客理想：工具篇》、《R的极客理想：高级开发篇》，英文版图书被 CRC 出版集团引进，在美国发行。个人博客：http://fens.me 。

EpiModel 包介绍

EpiModel 提供了用于模拟和分析传染病动力学数学模型的工具，支持的流行病模型类包括确定性隔间模型、随机个体接触模型和随机网络模型。疾病类型包括有人口统计的 SI、SIR 和 SIS 流行病，可实现自定义可扩展的和模拟任意复杂性的流行病模型。EpiModel中 特有的网络模型，基于在 R 的 Statnet 软件套件中实现的时间指数随机图模型 (ERGM) 的统计框架。

• 官方网站

  http://www.epimodel.org/index.html

EpiModel 包整体架构

EpiModel包，支持三类流行病模型提供功能：

• 确定性隔间模型（Deterministic Compartmental Models）：模型是确定性的，时间是连续的，解是输入参数和初始条件的固定数学函数，在疾病和人口过渡过程中没有随机变异性。

• 随机个体接触模型（Stochastic Individual Contact Models）：参数是随机抽取，其中控制状态间转移的所有比率和风险都是随机抽取的，它们来自由这些比率或概率总结的分布，包括正态分布、泊松分布和二项分布。时间是离散的，ICMs 是在离散时间内模拟的，而 DCMs 是在连续时间内模拟的。

• 随机网络模型（Stochastic Network Models）：两个节点之间连边与否不再是确定的事情，而是根据一个概率决定。网络动力学和疾病传播动力学，这两个动态过程是被视为独立的或者相互依赖的。独立的网络模型假设疾病模拟对时间网络的结构没有影响，尽管时间网络的结构肯定会影响疾病。依赖网络模型允许流行病学和人口统计过程影响网络结构。

EpiModel 包，默认支持三种传染病类型，同时允许使用者自己扩展模型内核计算，本文介绍的 SEIR 模型，就是基于自定模块按公式自己开发的。

• SI：Susceptible-Infective，一种两种状态的疾病，其中存在终生感染而无法恢复。HIV/AIDS 就是一个例子，尽管在这种情况下，通常将感染阶段建模为单独的隔间。

• SIR：Susceptible-Infective-Removed，一种三期疾病，感染后可终生恢复并产生免疫力。麻疹就是一个例子，但该疾病的现代模型也需要考虑人群中的疫苗接种模式。

• SIS：Susceptible-Infective- Susceptible，一种两阶段疾病，其中一个人可能在一生中从易感状态到受感染状态来回转换。例子包括细菌性性传播疾病，如淋病。

EpiModel 包框架下，不仅提供了丰富的功能，有很好的扩展性，还支持自定模型的开发，允许多种状态的设计，支持确定计算的和随机的计算，可模拟真实的传染病传播过程。

确定性间隔模型的核心函数

本文中 SI,SIS,SIR,SEIR 都是基于确定性间隔模型实现的，因此需要重点了解一下确定性间隔模型的核心函数。

主要有4个：

• param.dcm()，用于设置确定性隔间模型传播参数

• init.dcm()，用于设置确定性隔间模型的人数相关的初始条件

• control.dcm()，用于设置确定性隔间模型的控制参数

• dcm()，加载参数变量，运行模型

查看 param.dcm() 函数定义

> param.dcm
function (inf.prob, inter.eff, inter.start, act.rate, rec.rate,
a.rate, ds.rate, di.rate, dr.rate, inf.prob.g2, act.rate.g2,
rec.rate.g2, a.rate.g2, ds.rate.g2, di.rate.g2, dr.rate.g2,
balance, ...)

参数列表：

查看 init.dcm() 函数定义

> init.dcm
function (s.num, i.num, r.num, s.num.g2, i.num.g2, r.num.g2, ...)

SI 模型实现

本文将直接介绍使用 EpiModel 包的具体实现，关于 SI,SIS,SIR 模型的具体数据公式和解释，请参考文章：用 R 语言解读传染病模型。

安装和加载 EpiModel 包

• 安装 EpiModel 包

> install.packages("EpiModel")

• 加载 EpiModel 包，并设定运行目录

> library(EpiModel)
> setwd("C:/work/R/covid19")

构建 SI 模型：初始：日感染率 inf.prob=0.5，日传播率 act.rate=0.5。初始易感染者s.num=500，初始已感染者 i.num=1，观察周期 nsteps=100。

• 设置模型传播参数

> param <- param.dcm(inf.prob = 0.5, act.rate = 0.5)

• 设置模型人群参数

> init <- init.dcm(s.num = 500, i.num = 1)

• 设置使用 SI 模型和观察周期

> control <- control.dcm(type = "SI", nsteps = 100)

在 param.dcm() 函数中，把传染率拆分成了2个值 inf.prob 和 act.rate，从源代码中这两个参数相乘就是日感染率，这里是给我们提供了一个额外的调解参数，并没有改变模型本身的算法。

运行模型，并查看模型计算结果。查看 mod 变量，会打印 SI 模型所有运行参数。

> mod <- dcm(param, init, control)
> mod
EpiModel Simulation
=======================
Model class: dcm
Simulation Summary
-----------------------
Model type: SI
No. runs: 1
No. time steps: 100
No. groups: 1
Model Parameters
-----------------------
inf.prob = 0.5
act.rate = 0.5
Model Output
-----------------------
Variables: s.num i.num si.flow num

模型结果，可视化输出，直接使用 plot() 函数即可。

> plot(mod)

上图中，蓝色线为易感染人数，红色线为已感染人数，从图中我们能看到人群的变化过程。

查看模型结果数据集，前10条计算结果，可以直接把 mod 转型为 data.frame 类型，来查看每一个周期的运行结果。

> head(as.data.frame(mod),10)
   time    s.num    i.num   si.flow num
1     1 500.0000 1.000000 0.2832895 501
2     2 499.7167 1.283290 0.3632782 501
3     3 499.3534 1.646568 0.4656817 501
4     4 498.8878 2.112249 0.5966712 501
5     5 498.2911 2.708921 0.7640466 501
6     6 497.5270 3.472967 0.9776201 501
7     7 496.5494 4.450587 1.2496619 501
8     8 495.2998 5.700249 1.5953944 501
9     9 493.7044 7.295644 2.0335064 501
10   10 491.6708 9.329150 2.5866250 501

如果想查看第20个观察周期的传播率、易感染者人数和已感染者人数时，可以使用 comp_plot() 进行画图，把这一时刻的传播关系可视化展示。

> comp_plot(mod, at = 20, digits = 2)

如果想查看第20个观察周期的具体的计算数值时，可以使用 summary() 函数，指定 at=20 来看模型的明细数据。

> summary(mod, at = 20)
EpiModel Summary
=======================
Model class: dcm
Simulation Summary
-----------------------
Model type: SI
No. runs: 1
No. time steps:
No. groups: 1
Model Statistics
------------------------------
Time: 20  Run: 1
------------------------------
n    pct
Suscept. 406.938  0.812
Infect. 94.062  0.188
Total 501.000  1.000
S -> I 20.601     NA
------------------------------

通过 EpiMdoel 包来计算 SI 模型的模拟运行，是非常方便的，省去了我们原来自定义微分方程的过程，而且 EpiModel 还集成是可视化图、传播链图，参数多样化等高级特性，让我们做传染病的模拟，仅需要几行代码就可以实现。

• 用 R 语言解读传染病模型
  http://blog.fens.me/r-infectious-disease/

SIR 模型实现

通过 SIR 模型，进行人口分析。在易感-感染-恢复 (SIR) 模型中，受感染的个体从疾病转变为终生恢复状态，在这种状态下他们将不再易感。

初始：日感染率 inf.prob=0.2，日传播率 act.rate=1，恢复率 rec.rate=1/20, 出生率 a.rate=1/95，死亡率 ds.rate=1/100，疾病死亡率 di.rate=1/80, 恢复率 dr.rate=1/100。易感染者 s.num=1000，已感染者 i.num=1，治愈 r.num=0，观察周期 nsteps=500。

• 设置模型传播参数

> param <- param.dcm(inf.prob = 0.2, act.rate = 1, rec.rate = 1/20,
+                    a.rate = 1/95, ds.rate = 1/100, di.rate = 1/80,  r.rate = 1/100)

• 设置模型人群参数

> init <- init.dcm(s.num = 1000, i.num = 1, r.num = 0)

• 设置使用 SIR 模型、观察周期、间隔步长

> control <- control.dcm(type = "SIR", nsteps = 500, dt = 0.5)

运行模型，并查看模型计算结果

> mod <- dcm(param, init, control)
> mod
EpiModel Simulation
=======================
Model class: dcm

Simulation Summary
-----------------------
Model type: SIR
No. runs: 1
No. time steps: 500
No. groups: 1

Model Parameters
-----------------------
inf.prob = 0.2
act.rate = 1
rec.rate = 0.05
a.rate = 0.01052632
ds.rate = 0.01
di.rate = 0.0125
dr.rate = 0.01

Model Output
-----------------------
Variables: s.num i.num r.num si.flow ir.flow a.flow 
ds.flow di.flow dr.flow num

模型结果，可视化输出

> par(mar = c(3.2, 3, 2, 1), mgp = c(2, 1, 0), mfrow = c(1, 2))
> plot(mod, popfrac = FALSE, alpha = 0.5, lwd = 4, main = "Compartment Sizes")
> plot(mod, y = "si.flow", lwd = 4, col = "firebrick", main = "Disease Incidence", legend = "n")

左图为 SIR 模型中三种人群的人群，蓝色线 s.num 易感染人数，红色约 i.num 为已感染人数，绿色 r.num 为已治愈人数，由于有了一定的治愈率 dr.rate ，因此在100周期后3条线基本稳定。右图为发病率，从易感人群到已感染的传播过程。

如果我们想查看在第49个观察周期的传播率数值，易感染者人数，已感染者人数，恢复者人数，以及各状态之间的传播数值。

> par(mfrow = c(1, 1))
> comp_plot(mod, at = 49, digits = 1)

查看前10条结果，和后10条结果。观察 num 数量，在 SIR 模型中，总人数增加了，因为出生率值高。

• 查看前10行

> head(as.data.frame(mod))
  time    s.num    i.num      r.num   si.flow    ir.flow   a.flow  ds.flow     di.flow       dr.flow      num
1  1.0 1000.000 1.000000 0.00000000 0.1034038 0.02587806 5.269111 5.000416 0.006469515 0.00006384888 1001.000
2  1.5 1000.165 1.071056 0.02581421 0.1107397 0.02771672 5.270491 5.001226 0.006929180 0.00019713443 1001.262
3  2.0 1000.324 1.147150 0.05333379 0.1185940 0.02968571 5.271870 5.002000 0.007421427 0.00033924715 1001.524
4  2.5 1000.475 1.228637 0.08268026 0.1270029 0.03179423 5.273250 5.002738 0.007948557 0.00049081575 1001.786
5  3.0 1000.619 1.315897 0.11398367 0.1360055 0.03405211 5.274629 5.003435 0.008513027 0.00065251323 1002.048
6  3.5 1000.754 1.409337 0.14738326 0.1456431 0.03646987 5.276008 5.004088 0.009117467 0.00082505998 1002.311

• 查看后10行

> tail(as.data.frame(mod)) 
     time    s.num    i.num    r.num  si.flow  ir.flow   a.flow  ds.flow   di.flow  dr.flow      num
994 497.5 348.0338 129.4081 632.5081 4.057928 3.235373 5.842185 1.740279 0.8088432 3.162722 1109.950
995 498.0 348.0778 129.4218 632.5807 4.058395 3.235716 5.842871 1.740499 0.8089290 3.163085 1110.080
996 498.5 348.1218 129.4355 632.6533 4.058862 3.236060 5.843557 1.740719 0.8090151 3.163448 1110.211
997 499.0 348.1658 129.4493 632.7260 4.059331 3.236405 5.844243 1.740939 0.8091014 3.163811 1110.341
998 499.5 348.2097 129.4631 632.7985 4.059801 3.236752 5.844930 1.741159 0.8091879 3.164174 1110.471
999 500.0 348.2537 129.4770 632.8711 4.059801 3.236752 5.844930 1.741159 0.8091879 3.164174 1110.602

SIS 模型实现

用 SIS 模型进行敏感性分析，在易感-感染-恢复 (SIS) 模型中，我们在一个封闭的群体中对此进行，感染力和恢复等式相互反映，因为个体在状态之间来回流动。

建模初始：日感染率 inf.prob=(0.1 0.1 0.2 0.1 0.2 0.2)，日传播率 act.rate=(0.2 0.4 0.4 0.6 0.6 1)，日治愈率 rec.rate=0.02。初始易感染者 s.num=500，初始已感染者 i.num=1，观察周期 nsteps=350。

> inf<-c(0.1, 0.1, 0.2, 0.1, 0.2,0.2)
> act<-c(0.2, 0.4, 0.4, 0.6, 0.6,1)

• 设置模型传播参数

> param <- param.dcm(inf.prob = inf, act.rate = act, rec.rate = 0.02)

• 设置模型人群参数

> init <- init.dcm(s.num = 500, i.num = 1)

• 设置使用 SIS 模型和观察周期

> control <- control.dcm(type = "SIS", nsteps = 350)

我们同时给出了6组数据，把6组数据的参数进行微调，可一次性得出结果。运行模型，并查看模型计算结果

> mod <- dcm(param, init, control)
> mod
EpiModel Simulation
=======================
Model class: dcm

Simulation Summary
-----------------------
Model type: SIS
No. runs: 6
No. time steps: 350
No. groups: 1

Model Parameters
-----------------------
inf.prob = 0.1 0.1 0.2 0.1 0.2 0.2
act.rate = 0.2 0.4 0.4 0.6 0.6 1
rec.rate = 0.02

Model Output
-----------------------
Variables: s.num i.num si.flow is.flow num

模型结果，可视化输出。同时输出6组结果，并画在一张图中，进行对比。

> par(mfrow = c(1,2), mar = c(3.2,3,2.5,1))
> plot(mod, alpha = 1, main = "Disease Prevalence",legend ="full") #已感染者数量
> plot(mod, y = "si.flow", col = "Greens", alpha = 0.8,
+      main = "Disease Incidence",legend = "full")

左图中，run1,run2,run3,run4,run5,run6分别表示6次运行结果，当inf.prob * act.prob 越大时，疾病从易感染者向易感染者传播越快、曲线越陡，因此 run6 是最高的曲线。从图中 run1 几乎没有传播率，是因为治愈率与传播率相等，相互低效了。右图中，为6次模拟的发病率。

SIS 在计算时，根据不同的参数输入，我们共跑了6次模型，如果想查看其中某次的计算结果，可以使用run参数。

• 查看第1次运行结果的前6行输出

> head(as.data.frame(mod, run = 1)) #提取输出
  run time    s.num     i.num    si.flow    is.flow num
1   1    1 500.0000 1.0000000 0.01995968 0.01999960 501
2   1    2 500.0000 0.9999601 0.01995889 0.01999880 501
3   1    3 500.0001 0.9999202 0.01995809 0.01999800 501
4   1    4 500.0001 0.9998803 0.01995730 0.01999721 501
5   1    5 500.0002 0.9998403 0.01995650 0.01999641 501
6   1    6 500.0002 0.9998004 0.01995571 0.01999561 501

• 查看第6次运行结果的后6行输出

> tail(as.data.frame(mod, run = 6)) #提取输出
    run time s.num i.num si.flow is.flow num
345   6  345  50.1 450.9   9.018   9.018 501
346   6  346  50.1 450.9   9.018   9.018 501
347   6  347  50.1 450.9   9.018   9.018 501
348   6  348  50.1 450.9   9.018   9.018 501
349   6  349  50.1 450.9   9.018   9.018 501
350   6  350  50.1 450.9   9.018   9.018 501

SEIR 模型实现

易感-潜伏-感染-恢复 (SEIR) 模型，扩展了 SIR 模型以包括潜伏期但非传染性的类别，模型虑了开放人群中易感人群、潜伏人群、感染者的比例。适用于存在易感者、潜伏者、患病者和康复者四类人群，有潜伏期、治愈后获得终身免疫的疾病，如带状疱疹。

• S (Susceptible)，易感染者，指缺乏免疫能力健康人，与感染者接触后容易受到感染
  

• E (Exposed)，潜伏者 ，指接触过感染者但不存在传染性的人，可用于存在潜伏期的传染病

• I (Infectious)，已感染者，指有传染性的病人，可以传播给 S，将其变为 E 或 I

• R (Recovered)，康复者，指病愈后具有免疫力的人，如是终身免疫性传染病，则不可被重新变为 S 、E 或 I ，如果免疫期有限，就可以重新变为 S 类，进而被感染。

自定义 SEIR 模型的内核函数：

> SEIR <- function(t, t0, parms) {
+   with(as.list(c(t0, parms)), {
+     
+     # Population size
+     num <- s.num + e.num + i.num + r.num
+     
+     # Effective contact rate and FOI from a rearrangement of Beta * c * D
+     ce <- R0 / i.dur
+     lambda <- ce * i.num/num
+     
+     dS <- -lambda*s.num
+     dE <- lambda*s.num - (1/e.dur)*e.num
+     dI <- (1/e.dur)*e.num - (1 - cfr)*(1/i.dur)*i.num - cfr*(1/i.dur)*i.num
+     dR <- (1 - cfr)*(1/i.dur)*i.num
+     
+     # Compartments and flows are part of the derivative vector
+     # Other calculations to be output are outside the vector, but within the containing list
+     list(c(dS, dE, dI, dR, 
+            se.flow = lambda * s.num,
+            ei.flow = (1/e.dur) * e.num,
+            ir.flow = (1 - cfr)*(1/i.dur) * i.num,
+            d.flow = cfr*(1/i.dur)*i.num),
+          num = num,
+          i.prev = i.num / num,
+          ei.prev = (e.num + i.num)/num)
+   })
+ }

建模初始：初始繁殖数 R0 = 1.9, 潜伏状态的持续时间 e.dur = 10, 染状态的持续时间 i.dur = 14, 病死率 cfr = c(0.5, 0.7, 0.9)。初始易感染者 s.num=1000*1000，初始潜伏者人数 e.num=10，初始已感染者 i.num=0，初始治愈者 r.num=0。观察周期 nsteps=350，设置自定模型函数 SEIR。

• 设置模型传播参数

> param <- param.dcm(R0 = 1.9, e.dur = 10, i.dur = 14, cfr = c(0.5, 0.7, 0.9))

• 设置模型人群参数

> init <- init.dcm(s.num = 1e6, e.num = 10, i.num = 0, r.num = 0,
+                  se.flow = 0, ei.flow = 0, ir.flow = 0, d.flow = 0)

• 设置使用 SEIR 模型和观察周期

> control <- control.dcm(nsteps = 500, dt = 1, new.mod = SEIR)

运行模型，并查看模型计算结果

> mod <- dcm(param, init, control)
> mod
EpiModel Simulation
=======================
Model class: dcm

Simulation Summary
-----------------------
No. runs: 3
No. time steps: 500

Model Parameters
-----------------------
R0 = 1.9
e.dur = 10
i.dur = 14
cfr = 0.5 0.7 0.9

Model Output
-----------------------
Variables: s.num e.num i.num r.num se.flow ei.flow ir.flow 
d.flow num i.prev ei.prev

模型结果，可视化输出。通过可视化可分别描述4种状态的人群分布曲线。

par(mfrow = c(2, 2))
plot(mod, y = "i.num", run = 2, main = "患病率")
plot(mod, y = "se.flow", run = 2, main = "发病率")
plot(mod, y = "i.num", main = "感染人数")
plot(mod, y = "i.prev", main = "感染百分比", ylim = c(0, 0.5), legend = "full")

基于 SI 模型实现组间交叉传染

EpiMoel 除了能做单模型的计算，还能进行分组，做组间模型的传播实验。

我们接下来，基于 SI 模型实现组间交叉传播的模拟，在当前结构的两组模型中，组之间的混合纯粹是异质的：一个组只与另一组有联系，没有组内联系。

比如，在异性恋疾病传播，其中群体代表性别，我们可以将第 1 组建模为女性，将第 2 组建模为男性。

建模初始：日感染率女性 inf.prob=0.4，男性 inf.prob.g2=0.1。易感染者女性 s.num=500，男性 s.num.g2=500，已感染者女性 i.num=1，男性 i.num.g2=0 ，观察周期 nsteps=500。

• 设置模型传播参数

> param <- param.dcm(inf.prob = 0.4,inf.prob.g2 = 0.1, act.rate = 0.25,
+ balance = "g1",a.rate = 1/100, a.rate.g2 = NA, ds.rate = 1/100,
+ ds.rate.g2 = 1/100, di.rate = 1/50, di.rate.g2 = 1/50)

• 设置模型人群参数

> init <- init.dcm(s.num = 500, i.num = 1, s.num.g2 = 500, i.num.g2 = 0)

• 设置使用 SI 模型和观察周期

> control <- control.dcm(type = "SI", nsteps = 500)

运行模型，并查看模型计算结果

> mod <- dcm(param, init, control)
> mod
EpiModel Simulation
=======================
Model class: dcm

Simulation Summary
-----------------------
Model type: SI
No. runs: 1
No. time steps: 500
No. groups: 2

Model Parameters
-----------------------
inf.prob = 0.4
act.rate = 0.25
a.rate = 0.01
ds.rate = 0.01
di.rate = 0.02
inf.prob.g2 = 0.1
a.rate.g2 = NA
ds.rate.g2 = 0.01
di.rate.g2 = 0.02
balance = g1

Model Output
-----------------------
Variables: s.num i.num s.num.g2 i.num.g2 si.flow a.flow 
ds.flow di.flow si.flow.g2 a.flow.g2 ds.flow.g2 di.flow.g2 
num num.g2

模型结果，可视化输出

> par(mfrow = c(1, 1))
> plot(mod)

上图中，实线为女性组，虚线为男性组。

查看第20个观察周期的数据值

> summary(mod, at = 20)
EpiModel Summary
=======================
Model class: dcm

Simulation Summary
-----------------------
Model type: SI
No. runs: 1
No. time steps:
No. groups: 2

Model Statistics
------------------------------------------------------------
Time: 20   Run: 1 
------------------------------------------------------------ 
                   n:g1  pct:g1     n:g2  pct:g2
Suscept.        499.803   0.998  499.746   0.999
Infect.           1.016   0.002    0.376   0.001
Total           500.819   1.000  500.122   1.000
S -> I            0.038      NA    0.026      NA
Arrival ->        5.008      NA    5.008      NA
S Departure ->    4.998      NA    4.997      NA
I Departure ->    0.021      NA    0.008      NA
------------------------------------------------------------

网格模型实现

使用 EpiModel 的基本网络模型，是基于时间指数随机图模型的框架构建任意复杂的联系或伙伴关系结构，这些结构会随着时间的推移而形成和消散。

官方例子：血清监测：疾病状况影响伴侣选择——人口统计过程(出生、死亡和迁移)——接触网络过程必须适应人口规模和组成的变化。对于独立模型，在每次疫情模拟开始时对全动态网络进行模拟。对于相关模型，在每个时间步长的情况下，网络被重新模拟成变化的种群大小和变化的节点属性的函数。

设置网络模型

> nw <-network.initialize(n = 1000, directed = FALSE)
> nw <-set.vertex.attribute(nw, "race", rep(0:1, each = 500))
> formation <-~edges + nodefactor("race") + nodematch("race") +concurrent
> target.stats <- c(250, 375, 225, 100)
> coef.diss <-dissolution_coefs(dissolution = ~offset(edges), duration = 25)
> est1 <- netest(nw, formation,target.stats, coef.diss, edapprox = TRUE)
Starting maximum pseudolikelihood estimation (MPLE):
Evaluating the predictor and response matrix.
Maximizing the pseudolikelihood.
Finished MPLE.
Starting Monte Carlo maximum likelihood estimation (MCMLE):
Iteration 1 of at most 60:
Optimizing with step length 1.0000.
The log-likelihood improved by 0.1944.
Estimating equations are not within tolerance region.
Iteration 2 of at most 60:
Optimizing with step length 1.0000.
The log-likelihood improved by 0.0656.
Convergence test p-value: 0.4882. Not converged with 99% confidence; increasing sample size.
Iteration 3 of at most 60:
Optimizing with step length 1.0000.
The log-likelihood improved by 0.1167.
Estimating equations are not within tolerance region.
Iteration 4 of at most 60:
Optimizing with step length 1.0000.
The log-likelihood improved by 0.0288.
Convergence test p-value: 0.0892. Not converged with 99% confidence; increasing sample size.
Iteration 5 of at most 60:
Optimizing with step length 1.0000.
The log-likelihood improved by 0.0142.
Convergence test p-value: 0.0555. Not converged with 99% confidence; increasing sample size.
Iteration 6 of at most 60:
Optimizing with step length 1.0000.
The log-likelihood improved by 0.0154.
Convergence test p-value: 0.0138. Not converged with 99% confidence; increasing sample size.
Iteration 7 of at most 60:
Optimizing with step length 1.0000.
The log-likelihood improved by 0.0047.
Convergence test p-value: 0.0002. Converged with 99% confidence.
Finished MCMLE.
This model was fit using MCMC.  To examine model diagnostics and check for degeneracy, use the
mcmc.diagnostics() function.

进行模型诊断

> #模型诊断
> dx <- netdx(est1, nsims = 5, nsteps =500,
+             nwstats.formula = ~edges + nodefactor("race", base = 0) + nodematch("race") + concurrent)

Network Diagnostics
-----------------------
- Simulating 5 networks
  |In term ‘nodefactor’ in package ‘ergm’: Argument ‘base’ has been superseded by ‘levels’, and it is recommended to use the latter.  Note that its interpretation may be different.
*****|
- Calculating formation statistics
- Calculating duration statistics
- Calculating dissolution statistics

设置模型参数

> param <- param.net(inf.prob = 0.1,act.rate = 5, rec.rate = 0.02)
> status.vector <- c(rbinom(500, 1, 0.1),rep(0, 500)) # 二项分布
> status.vector <- ifelse(status.vector ==1, "i", "s")
> init <- init.net(status.vector =status.vector)
> control <- control.net(type ="SIS", nsteps = 500, nsims = 10, epi.by = "race")

模型构建，进行各个阶段在10个周期的传播。(时间较长)

> sim1 <- netsim(est1, param, init,control)
Epidemic Simulation
----------------------------
Simulation: 10/10
Timestep: 500/500
Prevalence: 459
Population Size: 1000
----------------------------

# 查看模型运行状态和参数
> sim1
EpiModel Simulation
=======================
Model class: netsim

Simulation Summary
-----------------------
Model type: SIS
No. simulations: 10
No. time steps: 500
No. NW groups: 1

Fixed Parameters
---------------------------
inf.prob = 0.1
act.rate = 5
rec.rate = 0.02
groups = 1

Model Output
-----------------------
Variables: s.num s.num.race0 s.num.race1 i.num i.num.race0 
i.num.race1 num num.race0 num.race1 si.flow is.flow
Networks: sim1 ... sim10
Transmissions: sim1 ... sim10

Formation Diagnostics
----------------------- 
                  Target Sim Mean Pct Diff Sim SD
edges                250  250.084    0.034 14.896
nodefactor.race.1    375  375.007    0.002 25.379
nodematch.race       225  225.192    0.085 14.044
concurrent           100   99.629   -0.371 10.772


Dissolution Diagnostics
----------------------- 
               Target Sim Mean Pct Diff Sim SD
Edge Duration   25.00   24.743   -1.026  0.295
Pct Edges Diss   0.04    0.040    0.614  0.001

查看模型运行结果

> head(as.data.frame(sim1), 10)
   sim time s.num s.num.race0 s.num.race1 i.num i.num.race0 i.num.race1  num num.race0 num.race1 si.flow is.flow
1    1    1   938         438         500    62          62           0 1000       500       500      NA      NA
2    1    2   933         434         499    67          66           1 1000       500       500       6       1
3    1    3   933         435         498    67          65           2 1000       500       500       2       2
4    1    4   933         438         495    67          62           5 1000       500       500       4       4
5    1    5   927         436         491    73          64           9 1000       500       500       7       1
6    1    6   928         438         490    72          62          10 1000       500       500       3       4
7    1    7   926         437         489    74          63          11 1000       500       500       3       1
8    1    8   924         438         486    76          62          14 1000       500       500       3       1
9    1    9   925         440         485    75          60          15 1000       500       500       2       3
10   1   10   926         440         486    74          60          14 1000       500       500       1       2

• 获得网络状态
  

> nw <- get_network(sim1, sim = 1)

• 获得每个时间点的时间状态

get_transmat(sim1, sim = 1)

画图输出2个时间点的网络状态：

> par(mfrow = c(1,2), mar = c(0,0,1,0))
> plot(sim1, type = "network", at =1, col.status = TRUE,
+      main = "Prevalence at t1")
> plot(sim1, type = "network", at =500, col.status = TRUE,
+      main = "Prevalence at t500")

上图中左边为第1个周期的状态，右边为第500个周期的状态。

查看第500个周期的数值

> summary(sim1,at=500)

EpiModel Summary
=======================
Model class: netsim

Simulation Details
-----------------------
Model type: SIS
No. simulations: 10
No. time steps: 500
No. NW groups: 1

Model Statistics
------------------------------
Time: 500 
------------------------------ 
            mean      sd    pct
Suscept.   529.4  13.066  0.529
Infect.    470.6  13.066  0.471
Total     1000.0   0.000  1.000
S -> I      10.8   2.821     NA
I -> S       8.5   2.915     NA
------------------------------

通过使用 EpiMdoel 包，让我们做传染病模型的传播模拟，快速、高效。在掌握了传染病的基础知识后，少量的代码就可以让我们做出专业性很强的结果，确实是站在巨人的肩膀，让知识传播更快、更高效。

文本完整的代码，已经上传 GitHub，可以自由下载使用。

• 完整的代码：
  https://github.com/bsspirit/infect/blob/main/code/model-epi.r

*未经授权请勿私自转载此文章及图片。

微软最有价值专家（MVP）

微软最有价值专家是微软公司授予第三方技术专业人士的一个全球奖项。29年来，世界各地的技术社区领导者，因其在线上和线下的技术社区中分享专业知识和经验而获得此奖项。MVP是经过严格挑选的专家团队，他们代表着技术最精湛且最具智慧的人，是对社区投入极大的热情并乐于助人的专家。MVP致力于通过演讲、论坛问答、创建网站、撰写博客、分享视频、开源项目、组织会议等方式来帮助他人，并最大程度地帮助微软技术社区用户使用 Microsoft 技术。更多详情请登录官方网站：
https://mvp.microsoft.com/zh-cn

  谢谢你读完了本文！欢迎在评论区留言分享你的想法，并且转发到朋友圈。

长按识别二维码关注微软开发者MSDN  

点击「阅读原文」加入微软 MVP~