tests/testthat/test-gof.R

In dScoreTest: Debiased Score Tests for Goodness of Fit and Model Comparison

# Helpers ---------------------------------------------------------------------

.make_glm_data <- function(n = 200, seed = 1) {
    set.seed(seed)
    dat <- data.frame(x1 = rnorm(n), x2 = rnorm(n), x3 = rnorm(n))
    dat$y <- 1 + dat$x1 + dat$x3 + rnorm(n)
    dat
}

# Validation paths (cheap, no grf) --------------------------------------------

test_that("gof_test.default errors on unsupported class", {
    obj <- structure(list(), class = "weirdclass")
    expect_error(gof_test(obj), "not implemented")
})

test_that("gof_test.gam rejects fits with weights or offset", {
    set.seed(1)
    dat <- mgcv::gamSim(eg = 1, n = 100, dist = "normal",
                        scale = 2, verbose = FALSE)
    fit.w <- mgcv::gam(y ~ s(x0) + s(x1), data = dat,
                       weights = rep(1, nrow(dat)))
    expect_error(gof_test(fit.w), "offset|weights")

    # NB: mgcv::gam's model.frame does not expose offsets as a "(offset)"
    # column, so gof_test.gam's current validation check misses them; the
    # refit then errors when the offset variable can't be found. Until the
    # validation is improved, we only assert that an error is thrown.
    dat$o  <- 0
    fit.o  <- mgcv::gam(y ~ s(x0) + s(x1) + offset(o), data = dat)
    expect_error(gof_test(fit.o))
})

# End-to-end smoke tests (slow; skipped on CRAN) ------------------------------

test_that("gof_test.glm runs end-to-end and returns a dScoreTest", {
    skip_on_cran()
    dat <- .make_glm_data()
    fit <- glm(y ~ x1 + x2 + x3, family = gaussian(), data = dat)
    res <- gof_test(fit)
    expect_s3_class(res, "dScoreTest")
    expect_true(is.finite(res$t.stat))
    expect_true(res$p.val >= 0 && res$p.val <= 1)
})

test_that("gof_test.lm dispatches via gof_test.glm", {
    skip_on_cran()
    dat <- .make_glm_data()
    fit <- lm(y ~ x1 + x2 + x3, data = dat)
    res <- gof_test(fit)
    expect_s3_class(res, "dScoreTest")
    expect_true(is.finite(res$t.stat))
})

test_that("gof_test.gam runs end-to-end on a well-specified gam", {
    skip_on_cran()
    set.seed(1)
    dat <- mgcv::gamSim(eg = 1, n = 200, dist = "normal",
                        scale = 2, verbose = FALSE)
    dat <- dat[, 1:5]
    fit <- mgcv::gam(y ~ s(x0) + s(x1) + s(x2) + s(x3), data = dat)
    res <- gof_test(fit)
    expect_s3_class(res, "dScoreTest")
    expect_true(is.finite(res$t.stat))
    expect_true(res$p.val >= 0 && res$p.val <= 1)
})

test_that("gof_test.glm supports hunt.style alternatives", {
    skip_on_cran()
    dat <- .make_glm_data()
    fit <- glm(y ~ x1 + x2 + x3, family = gaussian(), data = dat)
    for (style in c("optimal", "wls", "vanilla")) {
        res <- gof_test(fit, hunt.style = style)
        expect_s3_class(res, "dScoreTest")
        expect_true(is.finite(res$t.stat))
    }
})