Nothing
library(loo)
SW <- suppressWarnings
context("psislw")
set.seed(123)
x <- matrix(rnorm(5000), 100, 50)
expect_deprecated <- function(object) {
testthat::expect_warning(object, "deprecated", ignore.case = TRUE)
}
test_that("psislw throws deprecation warning", {
expect_deprecated(psislw(x[, 1]))
})
test_that("psislw handles special cases, throws appropriate errors/warnings", {
expect_warning(
psis <- psislw(x[, 1], wcp = 0.01),
regexp = "All tail values are the same. Weights are truncated but not smoothed"
)
expect_true(is.infinite(psis$pareto_k))
expect_warning(
psislw(x[, 1], wcp = 0.01),
regexp = "Some Pareto k diagnostic values are too high. See help('pareto-k-diagnostic') for details",
fixed = TRUE
)
expect_error(
expect_deprecated(psislw(wcp = 0.2)),
regexp = "'lw' or 'llfun' and 'llargs' must be specified"
)
})
test_that("psislw returns expected results", {
psis <- SW(psislw(x[, 1]))
lw <- psis$lw_smooth
expect_equal(length(psis), 2L)
expect_equal(nrow(lw), nrow(x))
expect_equal(lw[1], -5.6655489517740527106)
expect_equal(lw[50], -5.188442371693668953)
expect_equal(range(lw), c(-7.4142421808626526314, -2.6902215137943321643))
expect_equal(psis$pareto_k, 0.17364505906017813075)
})
test_that("psislw function and matrix methods return same result", {
set.seed(024)
# fake data and posterior draws
N <- 50; K <- 10; S <- 100; a0 <- 3; b0 <- 2
p <- rbeta(1, a0, b0)
y <- rbinom(N, size = K, prob = p)
a <- a0 + sum(y); b <- b0 + N * K - sum(y)
draws <- rbeta(S, a, b)
data <- data.frame(y,K)
llfun <- function(i, data, draws) {
dbinom(data$y, size = data$K, prob = draws, log = TRUE)
}
psislw_with_fn <- SW(psislw(llfun = llfun, llargs = nlist(data, draws, N, S)))
# Check that we get same answer if using log-likelihood matrix
ll <- sapply(1:N, function(i) llfun(i, data[i,, drop=FALSE], draws))
psislw_with_mat <- SW(psislw(-ll))
expect_equal(psislw_with_fn, psislw_with_mat)
})
test_that("psislw_warnings helper works properly", {
k <- c(0, 0.1, 0.55, 0.75)
expect_silent(psislw_warnings(k[1:2]))
expect_warning(psislw_warnings(k[1:3]),
"Some Pareto k diagnostic values are slightly high")
expect_warning(psislw_warnings(k),
"Some Pareto k diagnostic values are too high")
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.