deconvolve: Richardson-Lucy Deconvolution

In davidearn/fastbeta: Fast Estimation of Time-Varying Infectious Disease Transmission Rates

Richardson-Lucy Deconvolution

Description

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.

Usage

deconvolve(x, prob = 1, delay = 1,
           start, tol = 1, iter.max = 32L, complete = FALSE)

Arguments

x	a numeric vector of length n giving the number of infections or deaths reported during n observation intervals of equal duration.
prob	a numeric vector of length d+n such that prob[d+i] is the probability that an infection during interval i is eventually reported. prob of length 1 is recycled.
delay	a numeric vector of length d+1 such that delay[j] is the probability that an infection during interval i is reported during interval i+j-1, given that it is eventually reported. delay need not sum to 1 but must not sum to 0.
start	a numeric vector of length d+n giving a starting value for the iteration. start[d+i] estimates the expected number of infections during interval i that are eventually reported. If missing, then a starting value is generated by padding x on the left and right with d-d0 and d0 zeros, choosing d0=which.max(delay)-1.
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 start.

Value

A list with elements:

value	the result of updating start iter times then dividing by prob. If complete = TRUE, then value is a (d+n)-by-(iter+1) matrix containing start and the iter successive updates, each divided by prob.
chisq	the chi-squared statistic(s) corresponding to value.
iter	the number of iterations performed.

References

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. \Sexpr[results=rd]{tools:::Rd_expr_doi("10.1073/pnas.0902958106")}

Examples

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)

davidearn/fastbeta documentation built on April 30, 2024, 2:35 a.m.