tests/testthat/test-createLambda.R

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

data("measlesWeserEms")

## a simple endemic model
measlesFit0 <- hhh4(measlesWeserEms, list(
    end = list(f = addSeason2formula(~1), offset = population(measlesWeserEms)),
    family = "NegBin1"
))

test_that("endemic-only model has zero-valued Lambda matrix", {
    res <- getMaxEV_season(measlesFit0)
    expect_equal(res$maxEV.const, 0)
    zeromat <- matrix(0, measlesFit0$nUnit, measlesFit0$nUnit)
    expect_equal(res$Lambda.const, zeromat)
    expect_equal(surveillance:::createLambda(measlesFit0)(2), zeromat)
})

## + AR component
measlesFit1 <- update(measlesFit0, ar = list(f = addSeason2formula(~1)))

test_that("autoregressive model has a diagonal Lambda matrix", {
    res <- getMaxEV_season(measlesFit1)
    expect_equal(res$Lambda.const, diag(res$maxEV.const, measlesFit1$nUnit))
    expect_equal(surveillance:::createLambda(measlesFit1)(2),
                 diag(res$maxEV.season[2], measlesFit1$nUnit))
})

## + NE component
measlesFit2 <- update(measlesFit1,
    ne = list(f = ~1, weights = neighbourhood(measlesWeserEms) == 1)) # symmetric
measlesFit3 <- update(measlesFit2,
    ne = list(normalize = TRUE)) # asymetric

test_that("getMaxEV() and getMaxEV_season() agree", {
    expect_equal(getMaxEV_season(measlesFit2)$maxEV.season,
                 getMaxEV(measlesFit2)[seq_len(measlesWeserEms@freq)])
    expect_equal(getMaxEV_season(measlesFit3)$maxEV.season,
                 getMaxEV(measlesFit3)[seq_len(measlesWeserEms@freq)])
})

## AR within NE + unit-specific epidemic covariate
measlesFit4 <- update(measlesFit0,
    ne = list(f = ~pop, weights = (neighbourhood(measlesWeserEms)+1)^-2,
              normalize = TRUE),
    data = list(pop = population(measlesWeserEms)))

## calculate "nu + Lambda Y_{t-1}" and compare to fitted(object)
check_createLambda <- function (object)
{
    mname <- deparse(substitute(object))
    model <- terms(object)
    means <- meanHHH(object$coefficients, model, subset = seq_len(model$nTime))
    expect_equal(means$mean[model$subset,,drop=FALSE], fitted(object),
                 expected.label = paste0("fitted(", mname, ")"))
    Lambda <- surveillance:::createLambda(object)
    if (any(object$lags != 1, na.rm = TRUE))
        stop("check not implemented for lags != 1")
    meansByLambda <- t(vapply(
        X = object$control$subset,
        FUN = function(t) means$endemic[t,] + Lambda(t) %*% model$response[t-1,],
        FUN.VALUE = numeric(object$nUnit), USE.NAMES = FALSE))
    expect_equal(meansByLambda, unname(fitted(object)),
                 expected.label = paste0("fitted(", mname, ")"))
}

test_that("multivariate formulation using Lambda agrees with fitted values", {
    check_createLambda(measlesFit0)
    check_createLambda(measlesFit1)
    check_createLambda(measlesFit2)
    check_createLambda(measlesFit3)  # failed in surveillance < 1.13.1
    check_createLambda(measlesFit4)  # failed in surveillance < 1.13.1
})