N0h<-10000
rh<-0.3 - 0.35
rv<-0.3*1.6 - 0.35
res2 = data.table(expand.grid(t=seq(1,50,0.1), idr=idrSet))
res2[, ':='(Nv = Nv(t), NvIDR = idr * Nv(t), Nh = Nh(t), P.TRUE=p.true(t), P.OBS= p.obs(t,idr))]
res2[, ':='(AbsDiff=P.OBS-P.TRUE, RelDiff=P.OBS/P.TRUE-1)]
pEvolVariantAll = ggplot(res2, aes(x = t)) +
geom_line(aes(y = P.TRUE), color = "red", linetype = "dashed") +
geom_line(aes(y = P.OBS, color = idr, group = idr)) +
scale_y_continuous(name = NULL, labels = scales::percent) +
scale_x_continuous(name = NULL, limits = c(0,50)) +
scale_color_gradient(guide = NULL)+
theme_bw()
pEVAllg = ggplotGrob(pEvolVariantAll)
pEvolVariant = ggplot(res2[t<=25,], aes(x = t)) +
geom_line(aes(y = P.TRUE), color = "red", linetype = "dashed") +
geom_line(aes(y = P.OBS, color = idr, group = idr)) +
scale_y_continuous(name = "Proportion of variant", labels = scales::percent, limits=c(0,0.6)) +
scale_x_continuous(limits = c(0,25)) +
scale_color_gradient(guide = NULL)+
annotation_custom(grob = pEVAllg, xmin = 0, xmax = 15, ymin = 0.2, ymax = 0.6)+
theme_bw()
pAbsDiff=ggplot(res2[t<=25,], aes(x = t)) +
geom_line(aes(y = AbsDiff, group = idr, color = idr))+
scale_y_continuous(name = "Absolute difference", labels = scales::percent) +
scale_color_gradient(guide = NULL)+
scale_x_continuous(limits = c(0,25)) +
theme_bw()
pRelDiff=ggplot(res2[t<=25,], aes(x = t)) +
geom_line(aes(y = RelDiff, group = idr, color = idr))+
scale_y_continuous(name = "Relative difference", labels = scales::percent) +
scale_color_gradient(guide = NULL)+
scale_x_continuous(limits = c(0,25)) +
theme_bw()
pTrueVsObs = ggplot(res2) +
geom_line(aes(x = P.OBS, y = P.TRUE, group = idr, color = idr))+
scale_x_continuous(name = "Observed proportion", labels = scales::percent) +
scale_y_continuous(name = "True proportion", labels = scales::percent) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
ggrepel::geom_label_repel(size = 3, box.padding = 0.5, max.overlaps = Inf,
data = res2[, .SD[AbsDiff == max(AbsDiff) & idr >1,.(t, P.OBS, P.TRUE, AbsDiff)], by=idr],
aes(x = P.OBS, y = P.TRUE, label = paste0("Obs:", round(P.OBS*100,1),"%, True:",
round(P.TRUE*100,1),"%, diff:",
round(AbsDiff*100,1),"%")))+
scale_color_gradient(guide = NULL)+
theme_bw()
pNhv = ggplot(res2[t<=25,]) +
geom_line(aes(x = t, y = Nh), color = "black", linetype = "dashed")+
geom_line(aes(x = t, y = NvIDR, color = idr, group = idr))+
geom_line(aes(x = t, y = Nv)) +
geom_dl(aes(label=idr,x = t, y = NvIDR), size = 2, method = list(dl.combine("first.points", "last.points"), cex = 0.5))+
scale_y_continuous(name = "New cases", trans = "log10")+
scale_color_gradient(guide = NULL)+
scale_x_continuous(limits = c(0,25)) +
theme_bw()
pEvolNhv = ggplot(res2[t<=25,]) +
geom_line(aes(x = t, y = NvIDR+Nh, color = idr, group = idr))+
geom_line(aes(x = t, y = Nv+Nh))+
ggrepel::geom_label_repel(aes(x = x, y = y, label = label), size = 3, box.padding = 0.5, max.overlaps = Inf,
data = data.frame(x = res2[,.SD[NvIDR+Nh == min(NvIDR+Nh), t], by="idr"]$V1,
y = res2[,min(NvIDR+Nh), by="idr"]$V1,
label = paste0("t:",round(res2[,.SD[NvIDR+Nh == min(NvIDR+Nh), P.TRUE], by="idr"]$V1*100,0),"%,o:", round(res2[,.SD[NvIDR+Nh == min(NvIDR+Nh), P.OBS], by="idr"]$V1*100,0),"%")))+
geom_vline(xintercept = res2[,.SD[NvIDR+Nh == min(NvIDR+Nh), t], by="idr"]$V1, linetype = "dotted", color = "black")+
scale_y_continuous(name = NULL, trans = "log10")+
scale_color_gradient(guide = NULL)+
scale_x_continuous(limits = c(0,25)) +
theme_bw()
cowplot::plot_grid(pNhv, pEvolNhv, pEvolVariant, pRelDiff, pTrueVsObs, ncol = 2,
labels = "AUTO", label_size = 8, hjust = -6.5, vjust = 0.9)
Scenario Basecase: historical variant has a negative growth rate and new variant a positive one. Increased detection factor (idr) goes from 1 (no increase) to 1.6 (60% increase).
Fig 1A: Figure shows evolution in time of historical variant (dashed line) and new variant with various level of increased reporting (from 1 to 1.6). Increased reporting due to more severe symptoms does not change the growth rate, hence should not affect estimations of increased transmissibility.
Fig 1B: Figure shows the sum of new cases (hist. and variants). Increased reporting tend to change the timing of the inflection point, with larger over-reporting the inflection point comes sooner. Vertical dotted lines show the timing of the minimum incidence. Labels give the true and biased observed proportion of new variant at that moment.
Fig. 1C: Figures show the impact of the increased reporting on the proportion of variant in time. In absolute numbers, the increase is small at the beginning and reduces asymptotically when the new variant replaces the historical one.
Fig. 1D: In relative terms, by definition, the proportion of new variant is over reported by 60% at introduction for an increased severity of 60%. Since this bias is highest at the beginning of the spread of the new variant, early estimations will tend to be more biased than latter ones.
Fig. 1E: The absolute difference between the observed and the true proportion of new variants is maximum for values close to 50%, with a difference reacing 12% for an increased reporting rate of 60%.
Conclusion: An increased reporting of the new variant linked to its higher severity could bias observations of the proportion of cases. This increase does not change the growth rate (Fig 1 A), but may impact its estimation (Fig1B and C). It is maximum at introduction, hence early estimations of the spread could be affected (Fig 1D), but reduced with time. In absolute terms the impact of the bias is maximum when the variant is close to represent 50% of the cases.
N0h<-10000
rh<-0.3
rv<-rh*1.6
res = data.table(expand.grid(t=1:50, idr=idrSet))
res[, ':='(Nv = Nv(t), NvIDR = idr * Nv(t), Nh = Nh(t), P.TRUE=p.true(t), P.OBS= p.obs(t,idr))]
res[, ':='(AbsDiff=P.OBS-P.TRUE, RelDiff=P.OBS/P.TRUE-1)]
pEvolNhv = ggplot(res) +
geom_line(aes(x = t, y = NvIDR+Nh, color = idr, group = idr))+
geom_line(aes(x = t, y = Nv+Nh))+
scale_y_continuous(name = "Nb all new cases", trans = "log10")+
theme_bw()
pEvolVariant = ggplot(res, aes(x = t)) +
geom_line(aes(y = P.TRUE), color = "red", linetype = "dashed") +
geom_line(aes(y = P.OBS, color = idr, group = idr)) +
scale_y_continuous(name = "Proportion of variant", labels = scales::percent) +
theme_bw()
pAbsDiff=ggplot(res, aes(x = t)) +
geom_line(aes(y = AbsDiff, group = idr, color = idr))+
scale_y_continuous(name = "Absolute difference", labels = scales::percent) +
theme_bw()
pRelDiff=ggplot(res, aes(x = t)) +
geom_line(aes(y = RelDiff, group = idr, color = idr))+
scale_y_continuous(name = "Relative difference", labels = scales::percent) +
theme_bw()
pTrueVsObs = ggplot(res) +
geom_line(aes(x = P.OBS, y = P.TRUE, group = idr, color = idr))+
scale_x_continuous(name = "Observed proportion", labels = scales::percent) +
scale_y_continuous(name = "True proportion", labels = scales::percent) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
theme_bw()
pNhv = ggplot(res) +
geom_line(aes(x = t, y = Nh), color = "black", linetype = "dashed")+
geom_line(aes(x = t, y = NvIDR, color = idr, group = idr))+
geom_line(aes(x = t, y = Nv))+
scale_y_continuous(name = "Nb new cases", trans = "log10")+
theme_bw()
cowplot::plot_grid(pNhv, pEvolNhv, pEvolVariant, pAbsDiff, pRelDiff, pTrueVsObs, ncol = 2,
labels = "AUTO", label_size = 8, hjust = -6.5, vjust = 0.9)
Scenario: historical and new variant have a positive growth rate.