Nothing
suppressMessages({
ep <- epiparameter_db(single_epiparameter = TRUE)
})
test_that("epiparameter works with minimal viable input", {
# message about missing citation suppressed
ebola_dist <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
expect_s3_class(ebola_dist, class = "epiparameter")
expect_length(ebola_dist, 10)
})
test_that("epiparameter works with all arguments set", {
# suppress message about citation
mers_dist <- suppressMessages(
epiparameter(
disease = "MERS",
pathogen = "MERS_CoV",
epi_name = "serial_interval",
prob_distribution = create_prob_distribution(
prob_distribution = "lnorm",
prob_distribution_params = c(meanlog = 2, sdlog = 1)
),
uncertainty = list(
meanlog = create_uncertainty(
ci_limits = c(1, 3),
ci = 95,
ci_type = "confidence interval"
),
sdlog = create_uncertainty(
ci_limits = c(0.1, 1.9),
ci = 95,
ci_type = "confidence interval"
)
),
summary_stats = create_summary_stats(
mean = 1,
mean_ci_limits = c(0.8, 1.2),
mean_ci = 95,
sd = 0.5,
sd_ci_limits = c(0.4, 0.6),
sd_ci = 95,
median = 1,
median_ci_limits = c(0.9, 1.1),
median_ci = 95,
lower_range = 0.1,
upper_range = 1.9,
quantiles = c(
"2.5" = 0.2, "5" = 0.3, "25" = 0.5, "75" = 0.7, "87.5" = 1.1,
"95" = 1.2, "97.5" = 1.5
)
), citation = create_citation(
author = person(given = "John", family = "Smith"),
year = 2002,
title = "A title",
journal = "A journal",
doi = "10.23271/176237.x",
pmid = 28372882
),
metadata = create_metadata(
units = "days",
sample_size = 100,
region = "UK",
transmission_mode = "vector_borne",
vector = NA,
extrinsic = FALSE,
inference_method = "MLE"
),
method_assess = create_method_assess(
censored = TRUE,
right_truncated = FALSE,
phase_bias_adjusted = FALSE
),
discretise = FALSE,
truncation = NA_real_,
notes = "No notes"
)
)
expect_s3_class(mers_dist, class = "epiparameter")
expect_length(mers_dist, 10)
})
test_that("epiparameter works with default helper functions", {
# message about missing citation suppressed
sars_dist <- suppressMessages(epiparameter(
disease = "SARS",
pathogen = "SARS_CoV",
epi_name = "onset_to_death",
prob_distribution = create_prob_distribution(
prob_distribution = "lnorm",
prob_distribution_params = c(meanlog = 2, sdlog = 1),
discretise = FALSE,
truncation = NA
),
uncertainty = list(
meanlog = create_uncertainty(),
sdlog = create_uncertainty()
),
summary_stats = create_summary_stats(),
citation = create_citation(),
metadata = create_metadata(),
method_assess = create_method_assess(),
notes = "No notes"
))
expect_s3_class(sars_dist, class = "epiparameter")
expect_length(sars_dist, 10)
})
test_that("epiparameter fails as expected", {
expect_error(
epiparameter(
disease = 1,
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
),
regexp = paste0(
"Assertion on 'disease' failed: Must be of type ",
"'string', not 'double'."
)
)
expect_error(
epiparameter(
disease = "ebola",
epi_name = 1,
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
),
regexp = paste0(
"Assertion on 'epi_name' failed: Must be of type ",
"'string', not 'double'."
)
)
expect_error(
suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = 1
)
),
regexp = "(<epiparameter> $prob_distribution must contain)*(<distribution>)"
)
expect_error(
# message about missing citation suppressed
suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = "gamma",
prob_distribution_params = c(shape = "NA", scale = 1)
),
regexp = paste0(
"(Assertion on 'prob_distribution_params' failed)*(Must be of type)*",
"(numeric)*(NULL)*(character)."
)
)
)
})
test_that("epiparameter.plot does not produce an error", {
# plotting changes global state of graphics pars so they are restored
op <- par(no.readonly = TRUE)
ebola_dist <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
expect_silent(plot(ebola_dist))
f <- function() plot(ebola_dist)
vdiffr::expect_doppelganger(
title = "epiparameter.plot",
fig = f
)
# restore graphics pars
par(op)
})
test_that("epiparameter.plot prints units in x-axis", {
# plotting changes global state of graphics pars so they are restored
op <- par(no.readonly = TRUE)
ebola_dist <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
),
metadata = create_metadata(units = "days")
))
expect_silent(plot(ebola_dist))
f <- function() plot(ebola_dist)
vdiffr::expect_doppelganger(
title = "epiparameter.plot units",
fig = f
)
# restore graphics pars
par(op)
})
test_that("epiparameter.plot works with non-default x-axis", {
# plotting changes global state of graphics pars so they are restored
op <- par(no.readonly = TRUE)
ebola_dist <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
expect_silent(
plot(
ebola_dist,
xlim = c(0, 20)
)
)
f <- function() {
plot(
ebola_dist,
xlim = c(0, 20)
)
}
vdiffr::expect_doppelganger(
title = "epiparameter.plot non-default range",
fig = f
)
# restore graphics pars
par(op)
})
test_that("new_epiparameter works with minimal viable input", {
epiparameter_obj <- suppressMessages(
new_epiparameter(
disease = "ebola",
pathogen = "ebola virus",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
),
uncertainty = list(
shape = create_uncertainty(
ci_limits = c(0, 2),
ci = 95,
ci_type = "confidence interval"
),
scale = create_uncertainty(
ci_limits = c(0, 2),
ci = 95,
ci_type = "confidence interval"
)
),
citation = create_citation(
author = person(given = "John", family = "Smith"),
year = 2002,
title = "Ebola incubation",
journal = "Journal of Epi"
),
notes = "No notes"
)
)
expect_s3_class(epiparameter_obj, class = "epiparameter")
expect_length(epiparameter_obj, 10)
expect_s3_class(assert_epiparameter(epiparameter_obj), class = "epiparameter")
})
test_that("assert_epiparameter & test_epiparameter passes when expected", {
expect_silent(assert_epiparameter(ep))
expect_invisible(assert_epiparameter(ep))
expect_silent(test_epiparameter(ep))
expect_true(test_epiparameter(ep))
})
test_that("assert_epiparameter & test_epiparameter fails when expected", {
ep_ <- ep
ep_$disease <- NULL
expect_error(
assert_epiparameter(ep_),
regexp = "(<epiparameter> must contain one disease)"
)
expect_false(suppressMessages(test_epiparameter(ep_)))
ep_$disease <- factor("disease")
expect_error(
assert_epiparameter(ep_),
regexp = "(<epiparameter> must contain one disease)"
)
expect_false(suppressMessages(test_epiparameter(ep_)))
ep_ <- ep
ep_$epi_name <- c("incubation", "period")
expect_error(
assert_epiparameter(ep_),
regexp = "(<epiparameter> must contain one epidemiological parameter)"
)
expect_false(suppressMessages(test_epiparameter(ep_)))
ep_ <- ep
ep_$citation <- "reference"
expect_error(
assert_epiparameter(ep_),
regexp = "(<epiparameter> \\$citation must be a <bibentry>)"
)
expect_false(suppressMessages(test_epiparameter(ep_)))
expect_error(
assert_epiparameter(1),
regexp = "(Object should be of class <epiparameter>)"
)
expect_false(suppressMessages(test_epiparameter(1)))
})
test_that("density works as expected on continuous epiparameter object", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
)
)
res <- stats::density(ebola_dist, at = 0.5)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- stats::density(ebola_dist, at = 0)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- stats::density(ebola_dist, at = 1.5)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- stats::density(ebola_dist, at = 10)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
})
test_that("density works as expected on discrete epiparameter object", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
)
)
res <- stats::density(ebola_dist, at = 0.5)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- stats::density(ebola_dist, at = 0)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- stats::density(ebola_dist, at = 1.5)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- stats::density(ebola_dist, at = 10)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
})
test_that("density works as expected on continuous epiparameter object with vector
input", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
)
)
res <- stats::density(ebola_dist, at = seq(0.1, 0.9, by = 0.1))
expect_length(res, 9)
expect_type(res, "double")
expect_true(all(res >= 0))
})
test_that("density works as expected on discrete epiparameter object with vector
input", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
)
)
res <- stats::density(ebola_dist, at = seq(0.1, 0.9, by = 0.1))
expect_length(res, 9)
expect_type(res, "double")
expect_true(all(res >= 0))
})
test_that("cdf works as expected on continuous epiparameter object", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
)
)
res <- distributional::cdf(ebola_dist, q = 0.5)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
expect_lte(res, 1)
res <- distributional::cdf(ebola_dist, q = 0)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
expect_lte(res, 1)
res <- distributional::cdf(ebola_dist, q = 1.5)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
expect_lte(res, 1)
res <- distributional::cdf(ebola_dist, q = 10)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
expect_lte(res, 1)
})
test_that("cdf works as expected on discrete epiparameter object", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
)
)
res <- distributional::cdf(ebola_dist, q = 0.5)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
expect_lte(res, 1)
res <- distributional::cdf(ebola_dist, q = 0)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
expect_lte(res, 1)
res <- distributional::cdf(ebola_dist, q = 1.5)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
expect_lte(res, 1)
res <- distributional::cdf(ebola_dist, q = 10)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
expect_lte(res, 1)
})
test_that("cdf works as expected on continuous epiparameter object with vector
input", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
)
)
res <- distributional::cdf(ebola_dist, q = seq(0.1, 0.9, by = 0.1))
expect_length(res, 9)
expect_type(res, "double")
expect_true(all(res >= 0))
expect_true(all(res <= 1))
})
test_that("cdf works as expected on discrete epiparameter object with vector
input", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
)
)
res <- distributional::cdf(ebola_dist, q = seq(0.1, 0.9, by = 0.1))
expect_length(res, 9)
expect_type(res, "double")
expect_true(all(res >= 0))
expect_true(all(res <= 1))
})
test_that("quantile works as expected on continuous epiparameter object", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
)
)
res <- quantile(ebola_dist, p = 0.5)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- quantile(ebola_dist, p = 0)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- quantile(ebola_dist, p = 1)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
})
test_that("quantile works as expected on discrete epiparameter object", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
)
)
res <- quantile(ebola_dist, p = 0.5)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- quantile(ebola_dist, p = 0)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- quantile(ebola_dist, p = 1)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
})
test_that("quantile works as expected on continuous epiparameter object with vector
input", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
)
)
res <- quantile(ebola_dist, p = seq(0.1, 0.9, by = 0.1))
expect_length(res, 9)
expect_type(res, "double")
expect_true(all(res >= 0))
})
test_that("quantile works as expected on discrete epiparameter object with vector
input", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
)
)
res <- quantile(ebola_dist, p = seq(0.1, 0.9, by = 0.1))
expect_length(res, 9)
expect_type(res, "double")
expect_true(all(res >= 0))
})
test_that("generate works as expected on continuous epiparameter object", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
)
)
res <- distributional::generate(ebola_dist, times = 1)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- distributional::generate(ebola_dist, times = 10)
expect_length(res, 10)
expect_type(res, "double")
expect_true(all(res >= 0))
})
test_that("generate works as expected on discrete epiparameter object", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
)
)
res <- distributional::generate(ebola_dist, times = 1)
expect_length(res, 1)
expect_type(res, "double")
expect_gte(res, 0)
res <- distributional::generate(ebola_dist, times = 10)
expect_length(res, 10)
expect_type(res, "double")
expect_true(all(res >= 0))
})
test_that("generate fails as expected on continuous epiparameter object with vector
input", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
)
)
expect_error(distributional::generate(ebola_dist, times = c(10, 15)))
})
test_that("generate fails as expected on discrete epiparameter object with vector
input", {
ebola_dist <- suppressMessages(
epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
)
)
expect_error(distributional::generate(ebola_dist, times = c(10, 15)))
})
test_that("is_epiparameter returns TRUE when expected", {
# suppress message about citation
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "serial_interval",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
expect_true(is_epiparameter(ep))
})
test_that("is_epiparameter returns FALSE when expected", {
false_ep <- list(
disease = "ebola",
epi_name = "serial_interval",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
)
expect_false(is_epiparameter(false_ep))
})
test_that("discretise works as expected on continuous gamma", {
# suppress message about citation
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
ep <- discretise(ep)
expect_s3_class(ep$prob_distribution, "distcrete")
expect_identical(ep$prob_distribution$parameters, list(shape = 1, scale = 1))
expect_identical(ep$prob_distribution$name, "gamma")
})
test_that("discretise works as expected on continuous lognormal", {
# suppress message about citation
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "lnorm",
prob_distribution_params = c(meanlog = 1, sdlog = 1)
)
))
ep <- discretise(ep)
expect_s3_class(ep$prob_distribution, "distcrete")
expect_identical(ep$prob_distribution$parameters, list(meanlog = 1, sdlog = 1))
expect_identical(ep$prob_distribution$name, "lnorm")
})
test_that("discretise works as expected on discretised dist", {
# suppress message about citation
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
))
expect_message(
discretise(ep),
regexp = "Distribution in `epiparameter` is already discretised"
)
expect_s3_class(ep$prob_distribution, "distcrete")
expect_identical(ep$prob_distribution$parameters, list(shape = 1, scale = 1))
expect_identical(ep$prob_distribution$name, "gamma")
})
test_that("discretise works as expected on truncated dist", {
# suppress message about citation
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
truncation = 10
)
))
expect_warning(
discretise(ep),
regexp = paste(
"Discretising a truncated continuous distribution,",
"returning non-truncated discretised distribution"
)
)
ep <- suppressWarnings(discretise(ep))
expect_s3_class(ep$prob_distribution, "distcrete")
expect_identical(ep$prob_distribution$parameters, list(shape = 1, scale = 1))
expect_identical(ep$prob_distribution$name, "gamma")
})
test_that("discretise fails as expected on non-epiparameter object", {
expect_error(
discretise("epiparameter"),
regexp = "No discretise method defined for class character"
)
expect_error(
discretise(c(1, 2, 3)),
regexp = "No discretise method defined for class numeric"
)
})
test_that("parameters works as expected on continuous gamma", {
# suppress message about citation
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
params <- get_parameters(ep)
expect_vector(params, ptype = numeric(), size = 2)
expect_named(params, expected = c("shape", "scale"))
})
test_that("parameters works as expected on continuous lognormal", {
# suppress message about citation
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "lnorm",
prob_distribution_params = c(meanlog = 1, sdlog = 1)
)
))
params <- get_parameters(ep)
expect_vector(params, ptype = numeric(), size = 2)
expect_named(params, expected = c("meanlog", "sdlog"))
})
test_that("parameters works as expected on discretised dist", {
# suppress message about citation
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
))
params <- get_parameters(ep)
expect_vector(params, ptype = numeric(), size = 2)
expect_named(params, expected = c("shape", "scale"))
})
test_that("parameters works as expected on truncated dist", {
# suppress message about citation
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
truncation = 10
)
))
params <- get_parameters(ep)
expect_vector(params, ptype = numeric(), size = 4)
expect_named(params, expected = c("shape", "scale", "lower", "upper"))
})
test_that("parameters fails as expected on non-epiparameter object", {
expect_error(
get_parameters("epiparameter"),
regexp = paste0(
"(no applicable method for)*(parameters)*",
"(applied to an object of class)*(character)"
)
)
expect_error(
get_parameters(c(1, 2, 3)),
regexp = paste0(
"(no applicable method for)*(parameters)*",
"(applied to an object of class)*(numeric)"
)
)
})
test_that("family works as expected for distributional", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "lnorm",
prob_distribution_params = c(meanlog = 1, sdlog = 1)
)
))
expect_identical(family(ep), "lnorm")
})
test_that("family works as expected for distcrete", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
))
expect_identical(family(ep), "gamma")
})
test_that("family works as expected for distributional truncated", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "weibull",
prob_distribution_params = c(shape = 1, scale = 1),
truncation = 10
)
))
expect_identical(family(ep), "truncated")
})
test_that("family works for distributional truncated with base_dist = TRUE", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "weibull",
prob_distribution_params = c(shape = 1, scale = 1),
truncation = 10
)
))
expect_identical(family(ep, base_dist = TRUE), "weibull")
})
test_that("is_truncated works as expected for continuous distributions", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
expect_false(is_truncated(ep))
})
test_that("is_truncated works as expected for discretised distributions", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
))
expect_false(is_truncated(ep))
})
test_that("is_truncated works as expected for truncated distributions", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
truncation = 10
)
))
expect_true(is_truncated(ep))
})
test_that("is_continuous works as expected for continuous distributions", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation period",
prob_distribution = create_prob_distribution(
prob_distribution = "lnorm",
prob_distribution_params = c(meanlog = 1, sdlog = 1)
)
))
expect_true(is_continuous(ep))
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
expect_true(is_continuous(ep))
})
test_that("is_continuous works as expected for discrete distributions", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "offspring distribution",
prob_distribution = create_prob_distribution(
prob_distribution = "nbinom",
prob_distribution_params = c(mean = 2, dispersion = 0.5)
)
))
expect_false(is_continuous(ep))
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1),
discretise = TRUE
)
))
expect_false(is_continuous(ep))
})
test_that("mean works as expected when mean is supplied", {
ep <- suppressMessages(
epiparameter(
disease = "Ebola",
epi_name = "incubation_period",
prob_distribution = "gamma",
summary_stats = create_summary_stats(mean = 5)
)
)
expect_identical(mean(ep), 5)
})
test_that("mean works as expected with params and no mean", {
ep <- suppressMessages(
epiparameter(
disease = "Ebola",
epi_name = "incubation_period",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
)
)
expect_identical(mean(ep), 1)
})
test_that("mean works as expected with no params and no mean", {
ep <- suppressMessages(
epiparameter(
disease = "Ebola",
epi_name = "incubation_period",
prob_distribution = "gamma"
)
)
expect_true(is.na(mean(ep)))
})
test_that("mean works for corrupted epiparameter", {
ep <- suppressMessages(
epiparameter(
disease = "Ebola",
epi_name = "incubation_period",
prob_distribution = "gamma"
)
)
ep$summary_stats <- list()
expect_true(is.na(mean(ep)))
})
test_that("as.function works as expected for density", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
ep_func <- as.function(ep, func_type = "density")
expect_type(ep_func, type = "closure")
expect_length(formals(ep_func), 1)
})
test_that("as.function works as expected for cdf", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
ep_func <- as.function(ep, func_type = "cdf")
expect_type(ep_func, type = "closure")
expect_length(formals(ep_func), 1)
})
test_that("as.function works as expected for generate", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
ep_func <- as.function(ep, func_type = "generate")
expect_type(ep_func, type = "closure")
expect_length(formals(ep_func), 1)
})
test_that("as.function works as expected for quantile", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
ep_func <- as.function(ep, func_type = "quantile")
expect_type(ep_func, type = "closure")
expect_length(formals(ep_func), 1)
})
test_that("as.function fails as expected", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
expect_error(
as.function(ep, func_type = "random"),
regexp = "(arg)*(should be one of)*(density)*(cdf)*(generate)*(quantile)"
)
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = "gamma"
))
expect_error(
as.function(ep),
regexp = "Cannot convert unparameterised <epiparameter> to distribution function"
)
})
test_that("as.data.frame works for <epiparameter>", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter(
disease = "ebola",
epi_name = "incubation",
prob_distribution = create_prob_distribution(
prob_distribution = "gamma",
prob_distribution_params = c(shape = 1, scale = 1)
)
))
df <- as.data.frame(ep)
expect_s3_class(df, class = "data.frame")
expect_identical(dim(df), c(1L, 10L))
expect_identical(
colnames(df),
c("disease", "pathogen", "epi_name", "prob_distribution",
"uncertainty", "summary_stats", "citation", "metadata", "method_assess",
"notes")
)
})
test_that("as.data.frame works for <epiparameter> from db", {
# message about missing citation suppressed
ep <- suppressMessages(epiparameter_db(single_epiparameter = TRUE))
df <- as.data.frame(ep)
expect_s3_class(df, class = "data.frame")
expect_identical(dim(df), c(1L, 10L))
expect_identical(
colnames(df),
c("disease", "pathogen", "epi_name", "prob_distribution",
"uncertainty", "summary_stats", "citation", "metadata", "method_assess",
"notes")
)
})
{
suppressMessages(
db <- epiparameter_db()
)
ep <- db[[1]]
}
test_that("c.epiparameter works as expected with two <epiparameter>s", {
res <- c(ep, ep)
expect_s3_class(res, class = "multi_epiparameter")
expect_length(res, 2)
expect_s3_class(res[[1]], class = "epiparameter")
})
test_that("c.epiparameter works as expected with one <epiparameter>", {
res <- c(ep)
expect_s3_class(res, class = "epiparameter")
expect_true(test_epiparameter(res))
})
test_that("c.epiparameter works with <epiparameter> & <multi_epiparameter>", {
res <- c(ep, db)
expect_s3_class(res, class = "multi_epiparameter")
expect_length(res, length(db) + 1)
expect_s3_class(res[[1]], class = "epiparameter")
})
test_that("c.multi_epiparameter works with two <multi_epiparameter>s", {
res <- c(db, db)
expect_s3_class(res, class = "multi_epiparameter")
expect_length(res, 250)
expect_s3_class(res[[1]], class = "epiparameter")
})
test_that("c.multi_epiparameter works with one <multi_epiparameter>", {
res <- c(db)
expect_s3_class(res, class = "multi_epiparameter")
expect_length(res, length(db))
})
test_that("c.multi_epiparameter works <multi_epiparameter> & <epiparameter>", {
res <- c(db, ep)
expect_s3_class(res, class = "multi_epiparameter")
expect_length(res, length(db) + 1)
expect_s3_class(res[[1]], class = "epiparameter")
})
test_that("c.epiparameter preserves input order", {
res <- c(ep, db, ep)
expect_s3_class(res, class = "multi_epiparameter")
expect_length(res, length(db) + 2)
expect_true(identical(res[[1]], res[[2]]))
expect_true(identical(res[[1]], res[[length(res)]]))
})
test_that("c.epiparameter fails as expected", {
expect_error(
c(ep, 1),
regexp = "Can only combine <epiparameter> or <multi_epiparameter> objects"
)
})
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.