tests/testthat/test-confint.R

#context("confint.spm")

my_tol <- 1e-5

# =================================== spm ====================================

res <- spm(newlyn, 100)

ci1 <- confint(res, type = "cholesky")
ci2 <- confint(res, type = "spectral")
test_that("sliding: cholesky and spectral are identical", {
  testthat::expect_identical(ci1$cis, ci2$cis)
})

# Check that the estimates of theta in res and returned from
# chandwich::adjust_loglik()

test_that("estimates of theta agree, sliding", {
  testthat::expect_equal(res$theta_sl, ci1$theta, tolerance = my_tol)
})

ci1 <- confint(res, maxima = "disjoint", interval_type = "both",
               type = "cholesky")
ci2 <- confint(res, maxima = "disjoint", interval_type = "both",
               type = "spectral")
test_that("disjoint: cholesky and spectral are identical", {
  testthat::expect_identical(ci1$cis, ci2$cis)
})

# Check estimates of theta

test_that("estimates of theta agree, disjoint", {
  testthat::expect_equal(res$theta_dj, ci1$theta, tolerance = my_tol)
})

ci3 <- confint(res, maxima = "disjoint", type = "cholesky",
               interval_type = "both", conf_scale = "log")

which_rows <- c("N2015lik", "BB2018lik")
test_that("spm lik intervals don't depend on conf_scale", {
  testthat::expect_identical(ci1$cis[which_rows, ], ci3$cis[which_rows, ])
})

# ============================= plot.confint.spm =============================

#context("plot.confint_spm")

# Check that plot.confint_spm works

# No legend position via legend_pos

cis <- confint(res, interval_type = "both")
ciplot <- plot(cis)
test_that("plot.confint_spm works, sliding", {
  testthat::expect_identical(ciplot, NULL)
})

ciplot <- plot(cis, estimator = "BB2018", title = "BB2018 only")
test_that("plot.confint_spm works, sliding, BB2018 only, add leg title", {
  testthat::expect_identical(ciplot, NULL)
})

ciplot <- plot(cis, estimator = "BB2018b", legend = c("cool", "neat"))
test_that("plot.confint_spm works, sliding, BB2018b only, add legend", {
  testthat::expect_identical(ciplot, NULL)
})

ciplot <- plot(cis, estimator = c("N2015", "BB2018"),
               main = "N2015 and BB2018", legend = c("cool", "neat"),
               title = "2 ests")
test_that("plot.confint_spm works, sliding, 2 ests, user legend & title", {
  testthat::expect_identical(ciplot, NULL)
})

# Change legend position via legend_pos

cis <- confint(res, interval_type = "both")
ciplot <- plot(cis, legend_pos = "bottomright")
test_that("plot.confint_spm works, sliding", {
  testthat::expect_identical(ciplot, NULL)
})

ciplot <- plot(cis, estimator = "BB2018", title = "BB2018 only",
               legend_pos = "bottomright")
test_that("plot.confint_spm works, sliding, BB2018 only, add leg title & pos", {
  testthat::expect_identical(ciplot, NULL)
})

ciplot <- plot(cis, estimator = "BB2018b", legend = c("cool", "neat"),
               legend_pos = "bottomright")
test_that("plot.confint_spm works, sliding, BB2018b only, add leg & pos", {
  testthat::expect_identical(ciplot, NULL)
})

ciplot <- plot(cis, estimator = c("BB2018", "BB2018b"),
               main = "BB2018 and BB2018b", legend = c("cool", "neat"),
               title = "2 ests", legend_pos = "bottomright")
test_that("plot.confint_spm works, sliding, 2 ests, user leg & title & pos", {
  testthat::expect_identical(ciplot, NULL)
})

cis <- confint(res, interval_type = "both", maxima = "disjoint")
ciplot <- plot(cis, xlab = "my xlab", lwd = 2, col = "blue")
test_that("plot.confint_spm works, user plot args, disjoint", {
  testthat::expect_identical(ciplot, NULL)
})

# Extreme example where b is so small that the SEs for the sliding blocks
# version of the estimator cannot be calculated

# b = 7 makes BB2018 SE missing, and the plot should work
res_small_b <- spm(newlyn, 7)
cis <- confint(res_small_b, interval_type = "lik")
ciplot <- plot(cis, xlab = "my xlab", lwd = 2, col = "blue")
test_that("plot.confint_spm works, user plot args, disjoint", {
  testthat::expect_identical(ciplot, NULL)
})

# b = 4 makes both N2015 and BB2018 SE missing, and plot.confint_spm()
# should stop
res_small_b <- spm(newlyn, 4)
cis <- confint(res_small_b, interval_type = "lik")
ciplot <- try(plot(cis, xlab = "my xlab", lwd = 2, col = "blue"),
              silent = TRUE)
test_that("plot.confint_spm works, user plot args, disjoint", {
  testthat::expect_identical(class(ciplot), "try-error")
})

# ================================== kgaps ===================================

#context("confint.kgaps")

u <- quantile(newlyn, probs = 0.90)

res <- kgaps(newlyn, u)
res1 <- confint(res)
res2 <- confint(res, conf_scale = "log")
test_that("kgaps lik intervals don't depend on conf_scale", {
  testthat::expect_identical(res1$cis["lik", ], res2$cis["lik", ])
})

# Repeat for inc_cens = TRUE

res <- kgaps(newlyn, u, inc_cens = TRUE)
res1 <- confint(res)
res2 <- confint(res, conf_scale = "log")
test_that("kgaps lik intervals don't depend on conf_scale", {
  testthat::expect_identical(res1$cis["lik", ], res2$cis["lik", ])
})

# ================================== dgaps ===================================

#context("confint.dgaps")

u <- quantile(newlyn, probs = 0.90)

res <- dgaps(newlyn, u)
res1 <- confint(res)
res2 <- confint(res, conf_scale = "log")
test_that("dgaps lik intervals don't depend on conf_scale", {
  testthat::expect_identical(res1$cis["lik", ], res2$cis["lik", ])
})

# Repeat for inc_cens = TRUE

res <- dgaps(newlyn, u, inc_cens = TRUE)
res1 <- confint(res)
res2 <- confint(res, conf_scale = "log")
test_that("dgaps lik intervals don't depend on conf_scale", {
  testthat::expect_identical(res1$cis["lik", ], res2$cis["lik", ])
})

Try the exdex package in your browser

Any scripts or data that you put into this service are public.

exdex documentation built on Sept. 10, 2023, 5:06 p.m.