inst/doc/twinstim.R

In surveillance: Temporal and Spatio-Temporal Modeling and Monitoring of Epidemic Phenomena

## ----include = FALSE---------------------------------------------------------------
## load the "cool" package
library("surveillance")

## Compute everything or fetch cached results?
message("Doing computations: ",
        COMPUTE <- !file.exists("twinstim-cache.RData"))
if (!COMPUTE) load("twinstim-cache.RData", verbose = TRUE)

## ----imdepi_components, echo=FALSE-------------------------------------------------
## extract components from imdepi to reconstruct
data("imdepi")
events <- SpatialPointsDataFrame(
    coords = coordinates(imdepi$events),
    data = marks(imdepi, coords=FALSE),
    proj4string = imdepi$events@proj4string  # ETRS89 projection (+units=km)
    )
stgrid <- imdepi$stgrid[,-1]

## ----load_districtsD, echo=FALSE---------------------------------------------------
load(system.file("shapes", "districtsD.RData", package = "surveillance"))

## ----imdepi_construct, results="hide", eval=FALSE----------------------------------
#  imdepi <- as.epidataCS(events = events, W = stateD, stgrid = stgrid,
#    qmatrix = diag(2), nCircle2Poly = 16)

## ----imdepi_events_echo, results="hide"--------------------------------------------
summary(events)

## ----imdepi_stgrid, echo=FALSE-----------------------------------------------------
.stgrid.excerpt <- format(rbind(head(stgrid, 3), tail(stgrid, 3)), digits=3)
rbind(.stgrid.excerpt[1:3,], "..."="...", .stgrid.excerpt[4:6,])

## ----imdepi_print------------------------------------------------------------------
imdepi

## ----imdepi_summary, include = FALSE-----------------------------------------------
(simdepi <- summary(imdepi))

## ----imdepi_stepfun, echo=2, fig.cap="Time course of the number of infectives assuming infectious periods of 30 days."----
par(mar = c(5, 5, 1, 1), las = 1)
plot(as.stepfun(imdepi), xlim = summary(imdepi)$timeRange, xaxs = "i",
  xlab = "Time [days]", ylab = "Current number of infectives", main = "")
#axis(1, at = 2557, labels = "T", font = 2, tcl = -0.3, mgp = c(3, 0.3, 0))

## ----imdepi_plot, fig.cap="Occurrence of the two finetypes viewed in the temporal and spatial dimensions.", fig.subcap=c("Temporal pattern.","Spatial pattern."), fig.width=5, fig.height=6, echo=c(2,4,5), out.width="0.5\\linewidth", fig.pos="!htb"----
par(las = 1)
plot(imdepi, "time", col = c("indianred", "darkblue"), ylim = c(0, 20))
par(mar = c(0, 0, 0, 0))
plot(imdepi, "space", lwd = 2,
  points.args = list(pch = c(1, 19), col = c("indianred", "darkblue")))
layout.scalebar(imdepi$W, scale = 100, labels = c("0", "100 km"), plot = TRUE)

## ----imdepi_animate_saveHTML, eval=FALSE-------------------------------------------
#  animation::saveHTML(
#    animate(subset(imdepi, type == "B"), interval = c(0, 365), time.spacing = 7),
#    nmax = Inf, interval = 0.2, loop = FALSE, title = "First year of type B")

## ----imdepi_untied-----------------------------------------------------------------
eventDists <- dist(coordinates(imdepi$events))
minsep <- min(eventDists[eventDists > 0])
set.seed(321)
imdepi_untied <- untie(imdepi, amount = list(s = minsep / 2))

## ----imdepi_untied_infeps----------------------------------------------------------
imdepi_untied_infeps <- update(imdepi_untied, eps.s = Inf)

## ----imdsts_plot, fig.cap="IMD cases (joint types) aggregated as an \\class{sts} object by month and district.", fig.subcap=c("Time series of monthly counts.", "Disease incidence (per 100\\,000 inhabitants)."), fig.width=5, fig.height=5, out.width="0.5\\linewidth", fig.pos="ht", echo=-2----
imdsts <- epidataCS2sts(imdepi, freq = 12, start = c(2002, 1), tiles = districtsD,
                        neighbourhood = NULL) # skip adjacency matrix (needs spdep)
par(las = 1, lab = c(7,7,7), mar = c(5,5,1,1))
plot(imdsts, type = observed ~ time)
plot(imdsts, type = observed ~ unit, population = districtsD$POPULATION / 100000)

## ----endemic_formula---------------------------------------------------------------
(endemic <- addSeason2formula(~offset(log(popdensity)) + I(start / 365 - 3.5),
  period = 365, timevar = "start"))

## ----imdfit_endemic, results="hide"------------------------------------------------
imdfit_endemic <- twinstim(endemic = endemic, epidemic = ~0,
  data = imdepi_untied, subset = !is.na(agegrp))

## ----strip.white.output=TRUE-------------------------------------------------------
summary(imdfit_endemic)

## ----imdfit_Gaussian, results="hide", eval=COMPUTE---------------------------------
#  imdfit_Gaussian <- update(imdfit_endemic, epidemic = ~type + agegrp,
#    siaf = siaf.gaussian(), cores = 2 * (.Platform$OS.type == "unix"))

## ----tab_imdfit_Gaussian, echo=FALSE, results="asis"-------------------------------
print(xtable(imdfit_Gaussian,
             caption="Estimated rate ratios (RR) and associated Wald confidence intervals (CI) for endemic (\\code{h.}) and epidemic (\\code{e.}) terms. This table was generated by \\code{xtable(imdfit\\_Gaussian)}.",
             label="tab:imdfit_Gaussian"),
      sanitize.text.function=NULL, sanitize.colnames.function=NULL,
      sanitize.rownames.function=function(x) paste0("\\code{", x, "}"))

## ----------------------------------------------------------------------------------
R0_events <- R0(imdfit_Gaussian)
tapply(R0_events, marks(imdepi_untied)[names(R0_events), "type"], mean)

## ----imdfit_exponential, results="hide", eval=COMPUTE, include=FALSE---------------
#  imdfit_exponential <- update(imdfit_Gaussian, siaf = siaf.exponential())

## ----imdfit_powerlaw, results="hide", eval=COMPUTE, include=FALSE------------------
#  imdfit_powerlaw <- update(imdfit_Gaussian, siaf = siaf.powerlaw(),
#    data = imdepi_untied_infeps,
#    start = c("e.(Intercept)" = -6.2, "e.siaf.1" = 1.5, "e.siaf.2" = 0.9))

## ----imdfit_step4, results="hide", eval=COMPUTE, include=FALSE---------------------
#  imdfit_step4 <- update(imdfit_Gaussian,
#    siaf = siaf.step(exp(1:4 * log(100) / 5), maxRange = 100))

## ----imdfit_siafs, fig.cap="Various estimates of spatial interaction (scaled by the epidemic intercept $\\gamma_0$).", fig.pos="!ht", echo=FALSE----
par(mar = c(5,5,1,1))
set.seed(2)  # Monte-Carlo confidence intervals
plot(imdfit_Gaussian, "siaf", xlim=c(0,42), ylim=c(0,5e-5), lty=c(1,3),
     xlab = expression("Distance " * x * " from host [km]"))
plot(imdfit_exponential, "siaf", add=TRUE, col.estimate=5, lty = c(5,3))
plot(imdfit_powerlaw, "siaf", add=TRUE, col.estimate=4, lty=c(2,3))
plot(imdfit_step4, "siaf", add=TRUE, col.estimate=3, lty=c(4,3))
legend("topright", legend=c("Power law", "Exponential", "Gaussian", "Step (df=4)"),
       col=c(4,5,2,3), lty=c(2,5,1,4), lwd=3, bty="n")

## ----------------------------------------------------------------------------------
exp(cbind("Estimate" = coef(imdfit_Gaussian)["e.siaf.1"],
          confint(imdfit_Gaussian, parm = "e.siaf.1")))

## ----------------------------------------------------------------------------------
exp(cbind("Estimate" = coef(imdfit_powerlaw)[c("e.siaf.1", "e.siaf.2")],
          confint(imdfit_powerlaw, parm = c("e.siaf.1", "e.siaf.2"))))

## ----------------------------------------------------------------------------------
quantile(getSourceDists(imdepi_untied_infeps, "space"), c(1,2,4,8)/100)

## ----imdfits_AIC-------------------------------------------------------------------
AIC(imdfit_endemic, imdfit_Gaussian, imdfit_exponential, imdfit_powerlaw, imdfit_step4)

## ----imdfit_endemic_sel, results="hide", include=FALSE-----------------------------
## Example of AIC-based stepwise selection of the endemic model
imdfit_endemic_sel <- stepComponent(imdfit_endemic, component = "endemic")
## -> none of the endemic predictors is removed from the model

## ----imdfit_powerlaw_model---------------------------------------------------------
imdfit_powerlaw <- update(imdfit_powerlaw, model = TRUE)

## ----imdfit_powerlaw_intensityplot_time, fig.cap="Fitted ``ground'' intensity process aggregated over space and both types.", fig.pos="ht", echo=FALSE----
par(mar = c(5,5,1,1), las = 1)
intensity_endprop <- intensityplot(imdfit_powerlaw, aggregate="time",
                                   which="endemic proportion", plot=FALSE)
intensity_total <- intensityplot(imdfit_powerlaw, aggregate="time",
                                 which="total", tgrid=501, lwd=2,
                                 xlab="Time [days]", ylab="Intensity")
curve(intensity_endprop(x) * intensity_total(x), add=TRUE, col=2, lwd=2, n=501)
#curve(intensity_endprop(x), add=TRUE, col=2, lty=2, n=501)
text(2500, 0.36, labels="total", col=1, pos=2, font=2)
text(2500, 0.08, labels="endemic", col=2, pos=2, font=2)

## ----echo=FALSE, eval=FALSE--------------------------------------------------------
#  meanepiprop <- integrate(intensityplot(imdfit_powerlaw, which="epidemic proportion"),
#                           50, 2450, subdivisions=2000, rel.tol=1e-3)$value / 2400

## ----imdfit_powerlaw_intensityplot_space, fig.cap="Epidemic proportion of the fitted intensity process accumulated over time by type.", fig.subcap=c("Type B.", "Type C."), fig.width=5, fig.height=5, out.width="0.47\\linewidth", fig.pos="p", echo=FALSE----
for (.type in 1:2) {
    print(intensityplot(imdfit_powerlaw, aggregate="space", which="epidemic proportion",
                        types=.type, tiles=districtsD, sgrid=1000,
                        # scales=list(draw=TRUE), # default (sp>=2 uses 'sf', with a fallback)
                        xlab="x [km]", ylab="y [km]", at=seq(0,1,by=0.1),
                        col.regions=rev(hcl.colors(10,"Reds")),
                        colorkey=list(title="Epidemic proportion")))
}

## ----imdfit_checkResidualProcess, fig.cap="\\code{checkResidualProcess(imdfit\\_powerlaw)}. The left-hand plot shows the \\code{ecdf} of the transformed residuals with a 95\\% confidence band obtained by inverting the corresponding Kolmogorov-Smirnov test (no evidence for deviation from uniformity). The right-hand plot suggests absence of serial correlation.", results="hide", fig.pos="p", echo=FALSE----
par(mar = c(5, 5, 1, 1))
checkResidualProcess(imdfit_powerlaw)

## ----imdsim, results="hide"--------------------------------------------------------
imdsim <- simulate(imdfit_powerlaw, nsim = 1, seed = 1, t0 = 2191, T = 2555,
  data = imdepi_untied_infeps, tiles = districtsD)

## ----imdsim_plot, fig.cap = "Simulation-based forecast of the cumulative number of cases by finetype in the last two years. The black lines correspond to the observed numbers.", fig.pos="bht", echo=FALSE----
.t0 <- imdsim$timeRange[1]
.cumoffset <- c(table(subset(imdepi, time < .t0)$events$type))
par(mar = c(5,5,1,1), las = 1)
plot(imdepi, ylim = c(0, 20), col = c("indianred", "darkblue"),
     subset = time < .t0, cumulative = list(maxat = 336),
     xlab = "Time [days]")
plot(imdsim, add = TRUE, legend.types = FALSE,
     col = adjustcolor(c("indianred", "darkblue"), alpha.f = 0.5),
     subset = !is.na(source),  # exclude events of the prehistory
     cumulative = list(offset = .cumoffset, maxat = 336, axis = FALSE),
     border = NA, density = 0) # no histogram for simulations
plot(imdepi, add = TRUE, legend.types = FALSE,
     col = 1, subset = time >= .t0,
     cumulative = list(offset = .cumoffset, maxat = 336, axis = FALSE),
     border = NA, density = 0) # no histogram for the last year's data
abline(v = .t0, lty = 2, lwd = 2)

## ----strip.white.output=TRUE-------------------------------------------------------
table(imdsim$events$source > 0, exclude = NULL)