上海新冠疫情可视化面板
基本再生数\(R_0\) 是指在一个完全易感人群中,没有任何干预措施的情况下,一个被传染病病原体感染的个体所能引起的第二代感染病例数,常用于衡量病原体自身的传播力。(《流行病学专家解读 | 传染病的有效再生数与基本再生数》 , 不详 )
时变再生数\(R_t\) 可以理解为真实世界(往往有干预措施,人群不是完全易感)情形下,t时刻的再生数, 受干预措施,感染者及易感者比例等因素影响,随时间变化而变化。隔离等干预措施的目标在于将\(R_t\) 降低至1以下,\(R_t<1\) 意味着新增病例数将逐渐减少,疫情得到控制。
使用R语言EpiEstim
包估计\(R_t\) (Thompson 等 2019 ) ,需要假设系列间隔(serial interval)的分布,本文中假设系列间隔均值为4天,标准差为2天(《新型冠状病毒Omicron变异株的流行病学特征及其科学防控建议》 , 不详 ) 。使用EpiEstim
包默认的1周滑动窗进行分析。结果如下:
代码
library (tidyverse)
library (EpiEstim)
library (patchwork)
## load data
case.asym.wider.sh<- read.csv ('https://raw.githubusercontent.com/shalom-lab/covid.sh/main/local/share/case.asym.wider.sh.csv' )
# observation
cases<- case.asym.wider.sh %>%
select (date,pos) %>%
mutate (date= as.Date (date)) %>%
rename (I= pos,dates= date)
t_start <- seq (2 , nrow (cases)- 13 )
t_end <- t_start + 13
## make config
config <- make_config (
mean_si = 4 ,
std_si = 2 ,
t_start = t_start,
t_end = t_end
)
## estimate
res <- estimate_R (
incid = cases,
method = "parametric_si" ,
config = config
)
#plot(res)
res.r<- res$ R %>% as_tibble () %>%
rename (mean= ` Mean(R) ` ,std= ` Std(R) ` ,lbd= ` Quantile.0.025(R) ` ,ubd= ` Quantile.0.975(R) ` ) %>%
mutate (date= cases$ dates[res$ R$ t_end])
res.si <- as_tibble (list (time= as.integer (str_sub (names (res$ si_distr),2 )),
frequency= as.vector (res$ si_distr)))
p1<- ggplot (data = cases,aes (x= dates,y= I))+
geom_col (fill= "#AD002AFF" )+
scale_x_date (date_breaks = "2 days" ,date_labels = "%m/%d" ,expand = c (0 ,0.5 ))+
labs (x= "" ,y= "每日新增阳性数" ,title= "Epidemic curve" )+
theme_bw ()+
theme (axis.text.x = element_text (angle= 45 ,vjust= 0.5 ,hjust = 0.5 ))
p2<- ggplot (data = res.r,aes (x= date,y= mean))+
geom_ribbon (aes (ymin= lbd,ymax= ubd),fill= "#AD002AFF" ,alpha= 0.2 )+
geom_line (size= 1 ,colour= "#AD002AFF" )+
geom_hline (yintercept = 1 ,size= 1 ,lty= 2 )+
scale_x_date (date_breaks = "2 days" ,date_labels = "%m/%d" ,expand = c (0 ,0.5 ),limits = c (as.Date ('2022-03-09' ),Sys.Date ()- 1 ))+
labs (x= "" ,y= "时变再生数Rt" ,title= '' )+
theme_bw ()+
theme (axis.text.x = element_text (angle= 45 ,vjust= 0.5 ,hjust = 0.5 ))
p3<- ggplot (data = res.si,aes (x= time,y= frequency))+
geom_line ()+
labs (x= "Time" ,y= "Frequency" ,title= 'Assumptive Serial Interval Distribution' )+
theme_bw ()
p1+ p2+ plot_layout (ncol = 1 )
p3
结果显示目前时变再生数Rt已降至1以下,Rt持续处于1以下将表示疫情得到有效控制,希望继续保持,期待早日解封~
参考
Thompson, R. N., J. E. Stockwin, R. D. van Gaalen, J. A. Polonsky, Z. N. Kamvar, P. A. Demarsh, E. Dahlqwist, 等. 2019.
《Improved Inference of Time-Varying Reproduction Numbers During Infectious Disease Outbreaks》 .
Epidemics 29 (十二月): 100356.
https://doi.org/10.1016/j.epidem.2019.100356 .