Nothing
library(bayesplot)
context("PPC: misc. functions")
source(test_path("data-for-ppc-tests.R"))
source(test_path("data-for-mcmc-tests.R"))
# melt_predictions ---------------------------------------------------------------
expect_molten_yrep <- function(yrep) {
y <- rnorm(ncol(yrep))
yrep <- validate_predictions(yrep, length(y))
x <- melt_predictions(yrep)
expect_equal(ncol(x), 5)
expect_equal(nrow(x), prod(dim(yrep)))
rep_nums <- rep(seq_len(nrow(yrep)), length(y))
obs_nums <- sort(rep(seq_len(length(y)), nrow(yrep)))
expect_identical(colnames(x), c("y_id", "y_name", "rep_id", "rep_label", "value"))
expect_equal(x$y_id, obs_nums)
expect_equal(x$rep_id, rep_nums)
expect_s3_class(x, "data.frame")
expect_s3_class(x$rep_label, "factor")
expect_type(x$rep_id, "integer")
expect_type(x$y_id, "integer")
expect_type(x$value, "double")
}
test_that("melt_predictions returns correct structure", {
expect_molten_yrep(yrep)
expect_molten_yrep(yrep2)
load(test_path("data-for-binomial.rda"))
expect_molten_yrep(Ey)
expect_molten_yrep(validate_predictions(yrep, length(y)))
})
# melt_and_stack ----------------------------------------------------------
test_that("melt_and_stack returns correct structure", {
molten_yrep <- melt_predictions(yrep)
d <- melt_and_stack(y, yrep)
expect_s3_class(d, "data.frame")
expect_equal(nrow(d), nrow(molten_yrep) + length(y))
sorted_names <- sort(c(colnames(molten_yrep), c("is_y", "is_y_label")))
expect_equal(sort(colnames(d)), sorted_names)
})
# is_whole_number, all_counts --------------------------------------------
test_that("is_whole_number works correctly", {
expect_equal(is_whole_number(c(1L, 2, 3/3, 4/5)),
c(rep(TRUE, 3), FALSE))
expect_true(!is_whole_number("1"))
})
test_that("all_counts works correctly", {
expect_true(all_counts(1))
expect_true(all_counts(0:5))
expect_true(all_counts(matrix(rpois(10, 1), 2, 5)))
expect_false(all_counts(rnorm(5)))
expect_false(all_counts(c("1", "2")))
expect_false(all_counts(c(1, 1.5)))
expect_false(all_counts(c(-1, 2)))
})
# adjust_gamma
test_that("adjust_gamma works with different adjustment methods", {
set.seed(8420)
expect_equal(
adjust_gamma(N = 100, K = 100, L = 1, prob = .99),
adjust_gamma(N = 100, K = 100, L = 1, prob = .99, interpolate_adj = TRUE),
tolerance = 1e-3
)
expect_equal(
adjust_gamma(N = 100, K = 100, L = 4, prob = .99, M = 1000),
adjust_gamma(N = 100, K = 100, L = 4, prob = .99, interpolate_adj = TRUE),
tolerance = 1e-3
)
set.seed(NULL)
})
# get_interpolation_values ------------------------------------------------
test_that("get_interpolation_values catches impossible values", {
expect_error(
get_interpolation_values(1000, 1000, 0, .5),
"No precomputed values to interpolate from for 'L' = 0."
)
expect_error(
get_interpolation_values(1000, 1000, 4, 0),
"No precomputed values to interpolate from for 'prob' = 0."
)
expect_error(
get_interpolation_values(1000, 0, 4, .95),
"No precomputed values available for interpolation for 'K' = 0."
)
expect_error(
get_interpolation_values(0, 1000, 4, .95),
"No precomputed values to interpolate from for sample length of 0."
)
expect_error(
get_interpolation_values(1e5, 10, 4, .95),
"No precomputed values to interpolate from for sample length of 1e+05",
fixed = TRUE
)
expect_error(
get_interpolation_values(100, 300, 4, .95),
"No precomputed values available for interpolation for 'K' = 300"
)
})
# ecdf_intervals ---------------------------------------------------------
test_that("ecdf_intervals returns right dimensions and values", {
lims <- ecdf_intervals(.0001, N = 100, K = 100, L = 1)
expect_named(lims, c("lower", "upper"))
expect_length(lims$upper, 101)
expect_length(lims$lower, 101)
expect_equal(min(lims$upper), 0)
expect_equal(max(lims$upper), 100)
expect_equal(min(lims$lower), 0)
expect_equal(max(lims$lower), 100)
})
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.