Skip to content

autocorrelation for elimination #20

@atredennick

Description

@atredennick

Need to add an analysis that implements Eamon's approach for quantifying autocorrelation as outlined in the Distance to epidemic threshold paper. It should serve as the EWS for elimination, not lag-1 autocorrelation as currently presented.

Snippet of code here:

get_fit <- function(y, tstep = 1/52, est_K = FALSE, cutoff = .06) {
  x <- (seq_along(y) - 1) * tstep
  start <- list()
  im <- match(TRUE, abs(y) < cutoff)
  xs <- x[1:(im - 1)]
  ys <- y[1:(im - 1)]
  start$gamma <- try(unname(coef(lm(log(I(abs(ys))) ~ xs))["xs"]))
  if (!inherits(start$gamma, "try-error")){
    spec <- spectrum(y, plot = FALSE, na.action = na.exclude)
    start$omega <- spec$freq[which.max(spec$spec)] / tstep
    start$a <- 0
    fit_osc <- try(minpack.lm::nlsLM(
      y~sqrt(1 + a^2) * exp(x * gamma) * sin(x * omega + atan2(1, a)),
      start = start, na.action = na.exclude,
      control = minpack.lm::nls.lm.control(maxiter = 1000)))
    if (est_K) {
      fit_decay <- try(minpack.lm::nlsLM(y~K * exp(x * gamma),
                                         start = list(gamma = start$gamma, K = y[1]), na.action = na.exclude,
                                         control = minpack.lm::nls.lm.control(maxiter = 1000)))
    } else {
      K <- y[1]
      fit_decay <- try(minpack.lm::nlsLM(y~K * exp(x * gamma),
                                         start = list(gamma = start$gamma),na.action = na.exclude,
                                         control = minpack.lm::nls.lm.control(maxiter = 1000)))
    }
    if (inherits(fit_osc , "try-error")) {
      e_osc <- Inf
    } else {
      e_osc <- fit_osc$m$resid()
    }
    if (inherits(fit_decay, "try-error")) {
      e_decay <- Inf
    } else {
      e_decay <- fit_decay$m$resid()
    }
    nll <- function(resids) {
      n <- length(resids)
      (sum(resids ^ 2))
    }
    aic <- c(constant = nll(y), fit_decay = nll(e_decay) + 2 * (1 + est_K),
             fit_osc = nll(e_osc) + 2 * 3)
    fits <- list(constant = "constant_y=0", fit_decay = fit_decay, fit_osc = fit_osc)
    
    coefests <- try(coef(fits[[which.min(aic)]])[c("omega", "gamma", "a")])
    if (inherits(coefests, "try-error")){
      coefests <- c(NA, NA, NA)
    }
    names(coefests) <- c("omega", "gamma", "a")
    c(list(coef = coefests), fits)
  } else {
    c(list(coef = c("omega" = NA, "gamma" = NA, "a" = NA),
           fits = list(constant = "contant_y=0",
                       fit_decay = NA, fit_osc = NA)))
  }
}

cases <- readRDS(datafile)
cases <- cases %>%
  filter(year > 1994) %>%
  filter(region == "Maradi (City)") %>%
  pull(cases)

y <- acf(cases, lag.max = length(cases)-30, plot = TRUE)
acf_fits <- get_fit(y = as.numeric(y[[1]]))
g <- coef(acf_fits$fit_osc)["gamma"]
w <- coef(acf_fits$fit_osc)["omega"]
distance_to_threshold <- sqrt((g)^2 + (w)^2)

Metadata

Metadata

Assignees

Labels

TODOThings to todo

Type

No type

Projects

No projects

Milestone

No milestone

Relationships

None yet

Development

No branches or pull requests

Issue actions