Title: | Fast Approximation of Time-Varying Infectious Disease Transmission Rates |
---|---|
Description: | A fast method for approximating time-varying infectious disease transmission rates from disease incidence time series and other data, based on a discrete time approximation of an SEIR model, as analyzed in Jagan et al. (2020) <doi:10.1371/journal.pcbi.1008124>. |
Authors: | Mikael Jagan [aut, cre] |
Maintainer: | Mikael Jagan <[email protected]> |
License: | GPL (>= 2) |
Version: | 0.3.1 |
Built: | 2024-11-25 15:00:59 UTC |
Source: | CRAN |
An R package for approximating time-varying infectious disease transmission rates from disease incidence time series and other data.
The “main” function is fastbeta
.
To render a list of available help topics, use
help(package = "fastbeta")
.
To report a bug or request a change, use
bug.report(package = "fastbeta")
.
Mikael Jagan [email protected]
Performs a modified Richardson-Lucy iteration for the purpose of estimating incidence from reported incidence or mortality, conditional on a reporting probability and on a distribution of the time to reporting.
deconvolve(x, prob = 1, delay = 1, start, tol = 1, iter.max = 32L, complete = FALSE)
deconvolve(x, prob = 1, delay = 1, start, tol = 1, iter.max = 32L, complete = FALSE)
x |
a numeric vector of length |
prob |
a numeric vector of length |
delay |
a numeric vector of length |
start |
a numeric vector of length |
tol |
a tolerance indicating a stopping condition; see the reference. |
iter.max |
the maximum number of iterations. |
complete |
a logical flag indicating if the result should preserve successive
updates to |
A list with elements:
value |
the result of updating |
chisq |
the chi-squared statistics corresponding to |
iter |
the number of iterations performed. |
Goldstein, E., Dushoff, J., Ma, J., Plotkin, J. B., Earn, D. J. D., & Lipsitch, M. (2020). Reconstructing influenza incidence by deconvolution of daily mortality time series. Proceedings of the National Academy of Sciences U. S. A., 106(51), 21825-21829. doi:10.1073/pnas.0902958106
set.seed(2L) n <- 200L d <- 50L p <- 0.1 prob <- plogis(rlogis(d + n, location = qlogis(p), scale = 0.1)) delay <- diff(pgamma(0L:(d + 1L), 12, 0.4)) h <- function (x, a = 1, b = 1, c = 0) a * exp(-b * (x - c)^2) ans <- floor(h(seq(-60, 60, length.out = d + n), a = 1000, b = 0.001)) x0 <- rbinom(d + n, ans, prob) x <- tabulate(rep.int(1L:(d + n), x0) + sample(0L:d, size = sum(x0), replace = TRUE, prob = delay), d + n)[-(1L:d)] str(D0 <- deconvolve(x, prob, delay, complete = FALSE)) str(D1 <- deconvolve(x, prob, delay, complete = TRUE)) matplot(-(d - 1L):n, cbind(x0, c(rep.int(NA, d), x), prob * D0[["value"]], p * ans), type = c("p", "p", "p", "l"), col = c(1L, 1L, 2L, 4L), pch = c(16L, 1L, 16L, NA), lty = c(0L, 0L, 0L, 1L), lwd = c(NA, NA, NA, 3L), xlab = "Time", ylab = "Count") legend("topleft", NULL, c("actual", "actual+delay", "actual+delay+deconvolution", "p*h"), col = c(1L, 1L, 2L, 4L), pch = c(16L, 1L, 16L, NA), lty = c(0L, 0L, 0L, 1L), lwd = c(NA, NA, NA, 3L), bty = "n") plot(0L:D1[["iter"]], D1[["chisq"]], xlab = "Iterations", ylab = quote(chi^2)) abline(h = 1, lty = 2L)
set.seed(2L) n <- 200L d <- 50L p <- 0.1 prob <- plogis(rlogis(d + n, location = qlogis(p), scale = 0.1)) delay <- diff(pgamma(0L:(d + 1L), 12, 0.4)) h <- function (x, a = 1, b = 1, c = 0) a * exp(-b * (x - c)^2) ans <- floor(h(seq(-60, 60, length.out = d + n), a = 1000, b = 0.001)) x0 <- rbinom(d + n, ans, prob) x <- tabulate(rep.int(1L:(d + n), x0) + sample(0L:d, size = sum(x0), replace = TRUE, prob = delay), d + n)[-(1L:d)] str(D0 <- deconvolve(x, prob, delay, complete = FALSE)) str(D1 <- deconvolve(x, prob, delay, complete = TRUE)) matplot(-(d - 1L):n, cbind(x0, c(rep.int(NA, d), x), prob * D0[["value"]], p * ans), type = c("p", "p", "p", "l"), col = c(1L, 1L, 2L, 4L), pch = c(16L, 1L, 16L, NA), lty = c(0L, 0L, 0L, 1L), lwd = c(NA, NA, NA, 3L), xlab = "Time", ylab = "Count") legend("topleft", NULL, c("actual", "actual+delay", "actual+delay+deconvolution", "p*h"), col = c(1L, 1L, 2L, 4L), pch = c(16L, 1L, 16L, NA), lty = c(0L, 0L, 0L, 1L), lwd = c(NA, NA, NA, 3L), bty = "n") plot(0L:D1[["iter"]], D1[["chisq"]], xlab = "Iterations", ylab = quote(chi^2)) abline(h = 1, lty = 2L)
Generates a discrete approximation of a time-varying infectious disease transmission rate from an equally spaced disease incidence time series and other data.
fastbeta(series, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, init, ...)
fastbeta(series, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, init, ...)
series |
a “multiple time series” object, inheriting from class
|
sigma , gamma , delta
|
non-negative numbers. |
m |
a non-negative integer indicating a number of latent stages. |
n |
a positive integer indicating a number of infectious stages. |
init |
a numeric vector of length |
... |
optional arguments passed to |
The algorithm implemented by fastbeta
is based on an SEIR model
with
latent stages
(
,
);
infectious stages
(
,
);
time-varying rates ,
, and
of
transmission, birth, and natural death; and
constant rates ,
, and
of
removal from each latent, infectious, and recovered compartment, where
removal from the recovered compartment implies return to the
susceptible compartment (loss of immunity).
It is derived by linearizing of the system of ordinary differential equations
and substituting actual or estimated incidence and births for definite
integrals of and
. This procedure yields a
system of linear difference equations from which one recovers a discrete
approximation of
:
where we use the notation
and it is understood that the independent variable is a unitless
measure of time relative to the spacing of the substituted time series
of incidence and births.
A “multiple time series” object, inheriting from class
mts
, with 1+m+n+1+1
columns (named S
,
E
, I
, R
, and beta
) storing the result of the
iteration described in ‘Details’. It is completely parallel to
argument series
, having the same tsp
attribute.
Jagan, M., deJonge, M. S., Krylova, O., & Earn, D. J. D. (2020). Fast estimation of time-varying infectious disease transmission rates. PLOS Computational Biology, 16(9), Article e1008124, 1-39. doi:10.1371/journal.pcbi.1008124
if (requireNamespace("adaptivetau")) withAutoprint({ data(seir.ts02, package = "fastbeta") a <- attributes(seir.ts02) str(seir.ts02) plot(seir.ts02) ## We suppose that we have perfect knowledge of incidence, ## births, and the data-generating parameters series <- cbind(seir.ts02[, c("Z", "B")], mu = a[["mu"]](0)) colnames(series) <- c("Z", "B", "mu") # FIXME: stats:::cbind.ts mangles dimnames args <- c(list(series = series), a[c("sigma", "gamma", "delta", "m", "n", "init")]) str(args) X <- do.call(fastbeta, args) str(X) plot(X) plot(X[, "beta"], ylab = "Transmission rate") lines(a[["beta"]](time(X)), col = "red") # the "truth" })
if (requireNamespace("adaptivetau")) withAutoprint({ data(seir.ts02, package = "fastbeta") a <- attributes(seir.ts02) str(seir.ts02) plot(seir.ts02) ## We suppose that we have perfect knowledge of incidence, ## births, and the data-generating parameters series <- cbind(seir.ts02[, c("Z", "B")], mu = a[["mu"]](0)) colnames(series) <- c("Z", "B", "mu") # FIXME: stats:::cbind.ts mangles dimnames args <- c(list(series = series), a[c("sigma", "gamma", "delta", "m", "n", "init")]) str(args) X <- do.call(fastbeta, args) str(X) plot(X) plot(X[, "beta"], ylab = "Transmission rate") lines(a[["beta"]](time(X)), col = "red") # the "truth" })
A simple wrapper around fastbeta
using it to generate a
“primary” estimate of a time-varying transmission rate and
r
bootstrap estimates. Bootstrap estimates are computed for
incidence time series simulated using seir
, with
transmission rate defined as the linear interpolant of the primary
estimate.
fastbeta.bootstrap(r, series, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, init, ...)
fastbeta.bootstrap(r, series, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, init, ...)
r |
a non-negative integer indicating a number of replications. |
series |
a “multiple time series” object, inheriting from class
|
sigma , gamma , delta
|
non-negative numbers. |
m |
a non-negative integer indicating a number of latent stages. |
n |
a positive integer indicating a number of infectious stages. |
init |
a numeric vector of length |
... |
optional arguments passed to |
A “multiple time series” object, inheriting from class
mts
, with 1+r
columns storing the one primary
and r
bootstrap estimates. It is completely parallel to argument
series
, having the same tsp
attribute.
if (requireNamespace("adaptivetau")) withAutoprint({ data(seir.ts02, package = "fastbeta") a <- attributes(seir.ts02) str(seir.ts02) plot(seir.ts02) ## We suppose that we have perfect knowledge of incidence, ## births, and the data-generating parameters series <- cbind(seir.ts02[, c("Z", "B")], mu = a[["mu"]](0)) colnames(series) <- c("Z", "B", "mu") # FIXME: stats:::cbind.ts mangles dimnames args <- c(list(r = 100L, series = series), a[c("sigma", "gamma", "delta", "m", "n", "init")]) str(args) R <- do.call(fastbeta.bootstrap, args) str(R) plot(R) plot(R, level = 0.95) })
if (requireNamespace("adaptivetau")) withAutoprint({ data(seir.ts02, package = "fastbeta") a <- attributes(seir.ts02) str(seir.ts02) plot(seir.ts02) ## We suppose that we have perfect knowledge of incidence, ## births, and the data-generating parameters series <- cbind(seir.ts02[, c("Z", "B")], mu = a[["mu"]](0)) colnames(series) <- c("Z", "B", "mu") # FIXME: stats:::cbind.ts mangles dimnames args <- c(list(r = 100L, series = series), a[c("sigma", "gamma", "delta", "m", "n", "init")]) str(args) R <- do.call(fastbeta.bootstrap, args) str(R) plot(R) plot(R, level = 0.95) })
Calculates the coefficient matrix corresponding to one step of the
iteration carried out by fastbeta
:
y <- c(1, E, I, R, S) for (pos in seq_len(nrow(series) - 1L)) { L <- fastbeta.matrix(pos, series, ...) y <- L %*% y }
fastbeta.matrix(pos, series, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L)
fastbeta.matrix(pos, series, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L)
pos |
an integer indexing a row (but not the last row) of |
series |
a “multiple time series” object, inheriting from class
|
sigma , gamma , delta
|
non-negative numbers. |
m |
a non-negative integer indicating a number of latent stages. |
n |
a positive integer indicating a number of infectious stages. |
A lower triangular matrix of size 1+m+n+1+1
.
if (requireNamespace("adaptivetau")) withAutoprint({ data(seir.ts02, package = "fastbeta") a <- attributes(seir.ts02); p <- length(a[["init"]]) str(seir.ts02) plot(seir.ts02) ## We suppose that we have perfect knowledge of incidence, ## births, and the data-generating parameters series <- cbind(seir.ts02[, c("Z", "B")], mu = a[["mu"]](0)) colnames(series) <- c("Z", "B", "mu") # FIXME: stats:::cbind.ts mangles dimnames args <- c(list(series = series), a[c("sigma", "gamma", "delta", "init", "m", "n")]) str(args) X <- unclass(do.call(fastbeta, args))[, seq_len(p)] colnames(X) Y <- Y. <- cbind(1, X[, c(2L:p, 1L)], deparse.level = 2L) colnames(Y) args <- c(list(pos = 1L, series = series), a[c("sigma", "gamma", "delta", "m", "n")]) str(args) L <- do.call(fastbeta.matrix, args) str(L) symnum(L != 0) for (pos in seq_len(nrow(series) - 1L)) { args[["pos"]] <- pos L. <- do.call(fastbeta.matrix, args) Y.[pos + 1L, ] <- L. %*% Y.[pos, ] } stopifnot(all.equal(Y, Y.)) })
if (requireNamespace("adaptivetau")) withAutoprint({ data(seir.ts02, package = "fastbeta") a <- attributes(seir.ts02); p <- length(a[["init"]]) str(seir.ts02) plot(seir.ts02) ## We suppose that we have perfect knowledge of incidence, ## births, and the data-generating parameters series <- cbind(seir.ts02[, c("Z", "B")], mu = a[["mu"]](0)) colnames(series) <- c("Z", "B", "mu") # FIXME: stats:::cbind.ts mangles dimnames args <- c(list(series = series), a[c("sigma", "gamma", "delta", "init", "m", "n")]) str(args) X <- unclass(do.call(fastbeta, args))[, seq_len(p)] colnames(X) Y <- Y. <- cbind(1, X[, c(2L:p, 1L)], deparse.level = 2L) colnames(Y) args <- c(list(pos = 1L, series = series), a[c("sigma", "gamma", "delta", "m", "n")]) str(args) L <- do.call(fastbeta.matrix, args) str(L) symnum(L != 0) for (pos in seq_len(nrow(series) - 1L)) { args[["pos"]] <- pos L. <- do.call(fastbeta.matrix, args) Y.[pos + 1L, ] <- L. %*% Y.[pos, ] } stopifnot(all.equal(Y, Y.)) })
Approximates the state of an SEIR model at a reference time from an
equally spaced, -periodic incidence time series and other data.
The algorithm relies on a strong assumption: that the incidence time
series was generated by the asymptotic dynamics of an SEIR model
admitting a locally stable,
-periodic attractor. Hence do
interpret with care.
ptpi(series, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, init, start = tsp(series)[1L], end = tsp(series)[2L], tol = 1e-03, iter.max = 32L, backcalc = FALSE, complete = FALSE, ...)
ptpi(series, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, init, start = tsp(series)[1L], end = tsp(series)[2L], tol = 1e-03, iter.max = 32L, backcalc = FALSE, complete = FALSE, ...)
series |
a “multiple time series” object, inheriting from class
|
sigma , gamma , delta
|
non-negative numbers. |
m |
a non-negative integer indicating a number of latent stages. |
n |
a positive integer indicating a number of infectious stages. |
init |
a numeric vector of length |
start , end
|
start and end times for the iteration, whose difference should be approximately equal to an integer number of periods. One often chooses the time of the first peak in the incidence time series and the time of the last peak in phase with the first. |
tol |
a tolerance indicating a stopping condition; see ‘Details’. |
iter.max |
the maximum number of iterations. |
backcalc |
a logical indicating if the state at time |
complete |
a logical indicating if intermediate states should be recorded in an array. Useful mainly for didactic or diagnostic purposes. |
... |
optional arguments passed to |
ptpi
can be understood as an iterative application of
fastbeta
to a subset of series
. The basic
algorithm can be expressed in R code as:
w <- window(series, start, end); i <- nrow(s); j <- seq_along(init) diff <- Inf; iter <- 0L while (diff > tol && iter < iter.max) { init. <- init init <- fastbeta(w, sigma, gamma, delta, m, n, init)[i, j] diff <- sqrt(sum((init - init.)^2) / sum(init.^2)) iter <- iter + 1L } value <- init
Back-calculation involves solving a linear system of equations; the back-calculated result can mislead if the system is ill-conditioned.
A list with elements:
value |
an approximation of the state at time |
diff |
the relative difference between the last two approximations. |
iter |
the number of iterations performed. |
x |
if |
Jagan, M., deJonge, M. S., Krylova, O., & Earn, D. J. D. (2020). Fast estimation of time-varying infectious disease transmission rates. PLOS Computational Biology, 16(9), Article e1008124, 1-39. doi:10.1371/journal.pcbi.1008124
if (requireNamespace("deSolve")) withAutoprint({ data(seir.ts01, package = "fastbeta") a <- attributes(seir.ts01); p <- length(a[["init"]]) str(seir.ts01) plot(seir.ts01) ## We suppose that we have perfect knowledge of incidence, ## births, and the data-generating parameters, except for ## the initial state, which we "guess" series <- cbind(seir.ts01[, c("Z", "B")], mu = a[["mu"]](0)) colnames(series) <- c("Z", "B", "mu") # FIXME: stats:::cbind.ts mangles dimnames plot(series[, "Z"]) start <- 23; end <- 231 abline(v = c(start, end), lty = 2) set.seed(0L) args <- c(list(series = series), a[c("sigma", "gamma", "delta", "m", "n", "init")], list(start = start, end = end, complete = TRUE)) init <- seir.ts01[which.min(abs(time(seir.ts01) - start)), seq_len(p)] args[["init"]] <- init * rlnorm(p, 0, 0.1) str(args) L <- do.call(ptpi, args) str(L) S <- L[["x"]][, "S", ] plot(S, plot.type = "single") lines(seir.ts01[, "S"], col = "red", lwd = 4) # the "truth" abline(h = L[["value"]]["S"], v = start, col = "blue", lwd = 4, lty = 2) ## Relative error L[["value"]] / init - 1 })
if (requireNamespace("deSolve")) withAutoprint({ data(seir.ts01, package = "fastbeta") a <- attributes(seir.ts01); p <- length(a[["init"]]) str(seir.ts01) plot(seir.ts01) ## We suppose that we have perfect knowledge of incidence, ## births, and the data-generating parameters, except for ## the initial state, which we "guess" series <- cbind(seir.ts01[, c("Z", "B")], mu = a[["mu"]](0)) colnames(series) <- c("Z", "B", "mu") # FIXME: stats:::cbind.ts mangles dimnames plot(series[, "Z"]) start <- 23; end <- 231 abline(v = c(start, end), lty = 2) set.seed(0L) args <- c(list(series = series), a[c("sigma", "gamma", "delta", "m", "n", "init")], list(start = start, end = end, complete = TRUE)) init <- seir.ts01[which.min(abs(time(seir.ts01) - start)), seq_len(p)] args[["init"]] <- init * rlnorm(p, 0, 0.1) str(args) L <- do.call(ptpi, args) str(L) S <- L[["x"]][, "S", ] plot(S, plot.type = "single") lines(seir.ts01[, "S"], col = "red", lwd = 4) # the "truth" abline(h = L[["value"]]["S"], v = start, col = "blue", lwd = 4, lty = 2) ## Relative error L[["value"]] / init - 1 })
Simulates incidence time series based on an SEIR model with user-defined forcing and a simple model for observation error.
Note that simulation code depends on availability of suggested packages adaptivetau and deSolve. If the dependency cannot be loaded then an error is signaled.
seir(length.out = 1L, beta, nu = function(t) 0, mu = function(t) 0, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, init, stochastic = TRUE, prob = 1, delay = 1, aggregate = FALSE, useCompiled = TRUE, ...) ## A basic wrapper for the m=0L case: sir(length.out = 1L, beta, nu = function(t) 0, mu = function(t) 0, gamma = 1, delta = 0, n = 1L, init, stochastic = TRUE, prob = 1, delay = 1, aggregate = FALSE, useCompiled = TRUE, ...)
seir(length.out = 1L, beta, nu = function(t) 0, mu = function(t) 0, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, init, stochastic = TRUE, prob = 1, delay = 1, aggregate = FALSE, useCompiled = TRUE, ...) ## A basic wrapper for the m=0L case: sir(length.out = 1L, beta, nu = function(t) 0, mu = function(t) 0, gamma = 1, delta = 0, n = 1L, init, stochastic = TRUE, prob = 1, delay = 1, aggregate = FALSE, useCompiled = TRUE, ...)
length.out |
a non-negative integer indicating the time series length. |
beta , nu , mu
|
functions of one or more arguments returning transmission, birth, and natural death rates at the time point indicated by the first argument. Arguments after the first must be strictly optional. The functions need not be vectorized. |
sigma , gamma , delta
|
non-negative numbers. |
m |
a non-negative integer indicating a number of latent stages. |
n |
a positive integer indicating a number of infectious stages. |
init |
a numeric vector of length |
stochastic |
a logical indicating if the simulation should be stochastic; see ‘Details’. |
prob |
a numeric vector of length |
delay |
a numeric vector of positive length such that |
aggregate |
a logical indicating if latent and infectious compartments should be aggregated. |
useCompiled |
a logical indicating if derivatives should be computed by compiled
C functions rather than by R functions (which may
be byte-compiled). Set to |
... |
optional arguments passed to |
Simulations are based on an SEIR model with
latent stages
(
,
);
infectious stages
(
,
);
time-varying rates ,
, and
of
transmission, birth, and natural death; and
constant rates ,
, and
of
removal from each latent, infectious, and recovered compartment, where
removal from the recovered compartment implies return to the
susceptible compartment (loss of immunity).
seir(stochastic = FALSE)
works by numerically integrating the
system of ordinary differential equations
where it is understood that the independent variable is a
unitless measure of time relative to an observation interval. To get
time series of incidence and births, the system is augmented with two
equations describing cumulative incidence and births
and the augmented system is numerically integrated.
Observed incidence is simulated from incidence by scaling the latter
by prob
and convolving the result with delay
.
seir(stochastic = TRUE)
works by simulating a Markov process
corresponding to the augmented system, as described in the reference.
Observed incidence is simulated from incidence by binning binomial
samples taken with probabilities prob
over future observation
intervals according to multinomial samples taken with probabilities
delay
.
A “multiple time series” object, inheriting from class
mts
. Beneath the class, it is a
length.out
-by-1+m+n+1+2
numeric matrix with columns
S
, E
, I
, R
, Z
, and B
, where
Z
and B
specify incidence and births as the number of
infections and births since the previous time point.
If prob
or delay
is not missing, then there is an
additional column Z.obs
specifying observed incidence as
the number of infections observed since the previous time point.
The first length(delay)
elements of this column contain partial
counts.
Cao, Y., Gillespie, D. T., & Petzold, L. R. (2007). Adaptive explicit-implicit tau-leaping method with automatic tau selection. Journal of Chemical Physics, 126(22), Article 224101, 1-9. doi:10.1063/1.2745299
if (requireNamespace("adaptivetau")) withAutoprint({ beta <- function (t, a = 1e-01, b = 1e-05) b * (1 + a * sinpi(t / 26)) nu <- function (t) 1e+03 mu <- function (t) 1e-03 sigma <- 0.5 gamma <- 0.5 delta <- 0 init <- c(S = 50200, E = 1895, I = 1892, R = 946011) length.out <- 250L prob <- 0.1 delay <- diff(pgamma(0:8, 2.5)) set.seed(0L) X <- seir(length.out, beta, nu, mu, sigma, gamma, delta, init = init, prob = prob, delay = delay, epsilon = 0.002) ## ^^^^^ ## default epsilon = 0.05 allows too big leaps => spurious noise ## str(X) plot(X) r <- 10L Y <- do.call(cbind, replicate(r, simplify = FALSE, seir(length.out, beta, nu, mu, sigma, gamma, delta, init = init, prob = prob, delay = delay, epsilon = 0.002)[, "Z.obs"])) str(Y) # FIXME: stats:::cbind.ts mangles dimnames plot(window(Y, start = tsp(Y)[1L] + length(delay) / tsp(Y)[3L]), ## ^^^^^ ## discards points showing edge effects due to 'delay' ## plot.type = "single", col = seq_len(r), ylab = "Case reports") })
if (requireNamespace("adaptivetau")) withAutoprint({ beta <- function (t, a = 1e-01, b = 1e-05) b * (1 + a * sinpi(t / 26)) nu <- function (t) 1e+03 mu <- function (t) 1e-03 sigma <- 0.5 gamma <- 0.5 delta <- 0 init <- c(S = 50200, E = 1895, I = 1892, R = 946011) length.out <- 250L prob <- 0.1 delay <- diff(pgamma(0:8, 2.5)) set.seed(0L) X <- seir(length.out, beta, nu, mu, sigma, gamma, delta, init = init, prob = prob, delay = delay, epsilon = 0.002) ## ^^^^^ ## default epsilon = 0.05 allows too big leaps => spurious noise ## str(X) plot(X) r <- 10L Y <- do.call(cbind, replicate(r, simplify = FALSE, seir(length.out, beta, nu, mu, sigma, gamma, delta, init = init, prob = prob, delay = delay, epsilon = 0.002)[, "Z.obs"])) str(Y) # FIXME: stats:::cbind.ts mangles dimnames plot(window(Y, start = tsp(Y)[1L] + length(delay) / tsp(Y)[3L]), ## ^^^^^ ## discards points showing edge effects due to 'delay' ## plot.type = "single", col = seq_len(r), ylab = "Case reports") })
Calculate the basic reproduction number, endemic equilibrium, and Jacobian matrix of the SEIR model without forcing.
seir.R0 (beta, nu = 0, mu = 0, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, N = 1) seir.ee (beta, nu = 0, mu = 0, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, N = 1) seir.jacobian(beta, nu = 0, mu = 0, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L)
seir.R0 (beta, nu = 0, mu = 0, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, N = 1) seir.ee (beta, nu = 0, mu = 0, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L, N = 1) seir.jacobian(beta, nu = 0, mu = 0, sigma = 1, gamma = 1, delta = 0, m = 1L, n = 1L)
beta , nu , mu , sigma , gamma , delta
|
non-negative numbers. |
m |
a non-negative integer indicating a number of latent stages. |
n |
a positive integer indicating a number of infectious stages. |
N |
a non-negative number indicating a population size for the
|
If , then the basic reproduction
number is computed as
and the endemic equilibrium is computed as
where is chosen so that the sum is
.
If , then the basic reproduction
number is computed as
and the endemic equilibrium is computed as
where is chosen so that the sum is
,
the population size at equilibrium, and
and
.
Currently, none of the functions documented here are vectorized. Arguments must have length 1.
seir.R0
returns a numeric vector of length 1. seir.ee
returns a numeric vector of length 1+m+n+1
. seir.jacobian
returns a function of one argument x
(which must be a numeric
vector of length 1+m+n+1
) whose return value is a square numeric
matrix of size length(x)
.
seir
, for the system of ordinary differential equations
on which these computations are predicated.
Infectious disease time series simulated using seir
, for
use primarily in examples, tests, and vignettes. Users should not rely
on simulation details, which may change between package versions.
Note that simulation code depends on availability of suggested packages
adaptivetau and deSolve. If the dependency cannot be loaded
then the value of the data set is NULL
.
## if (requireNamespace("deSolve")) data(seir.ts01, package = "fastbeta") ## else ... ## if (requireNamespace("adaptivetau")) data(seir.ts02, package = "fastbeta") ## else ...
## if (requireNamespace("deSolve")) data(seir.ts01, package = "fastbeta") ## else ... ## if (requireNamespace("adaptivetau")) data(seir.ts02, package = "fastbeta") ## else ...
A “multiple time series” object, inheriting from class
mts
, always a subset of the result of a call to
seir
, discarding transient behaviour. Simulation
parameters may be preserved as attributes.
Scripts sourced by data
to reproduce the simulations are
located in subdirectory ‘data’ of the fastbeta installation;
see, e.g.
system.file("data", "seir.ts01.R", package = "fastbeta")
.
seir
.
if (requireNamespace("deSolve")) withAutoprint({ data(seir.ts01, package = "fastbeta") str(seir.ts01) plot(seir.ts01) }) if (requireNamespace("adaptivetau")) withAutoprint({ data(seir.ts02, package = "fastbeta") str(seir.ts02) plot(seir.ts02) })
if (requireNamespace("deSolve")) withAutoprint({ data(seir.ts01, package = "fastbeta") str(seir.ts01) plot(seir.ts01) }) if (requireNamespace("adaptivetau")) withAutoprint({ data(seir.ts02, package = "fastbeta") str(seir.ts02) plot(seir.ts02) })
Time series of deaths due to smallpox, deaths due to all causes, and births in London, England, from 1661 to 1930, as recorded in the London Bills of Mortality and the Registrar General's Weekly Returns.
data(smallpox, package = "fastbeta")
data(smallpox, package = "fastbeta")
A data frame with 13923 observations of 5 variables:
start date of the record.
length of the record, which is the number of days (typically 7) over which deaths and births were counted.
count of deaths due to smallpox.
count of deaths due to all causes.
count of births.
A precise description of the data set and its correspondence to the original source documents is provided in the reference.
A script generating the smallpox
data frame from a CSV file
accompanying the reference is available as
system.file("scripts", "smallpox.R", package = "fastbeta")
.
Krylova, O. & Earn, D. J. D. (2020). Patterns of smallpox mortality in London, England, over three centuries. PLOS Biology, 18(12), Article e3000506, 1-27. doi:10.1371/journal.pbio.3000506
data(smallpox, package = "fastbeta") str(smallpox) table(smallpox[["nday"]]) # not all 7 days, hence: plot(7 * smallpox / as.double(nday) ~ from, smallpox, type = "l")
data(smallpox, package = "fastbeta") str(smallpox) table(smallpox[["nday"]]) # not all 7 days, hence: plot(7 * smallpox / as.double(nday) ~ from, smallpox, type = "l")