# Initialisation ----------------------------------------------------------
(2021)
(warn = -1)
N_patient <- 5
t_max <- (N_patient, 15)
N <- (t_max)
max_score <- 100
param <- EczemaPred::list_parameters("BinMC")
param$Test <-
N_parameters <- N * (param$PatientTime) + N_patient * (param$Patient) + (param$Population)
model <- EczemaPred::EczemaModel("BinMC", max_score = max_score)
fit_prior <- EczemaPred::sample_prior(model, N_patient = N_patient, t_max = t_max, chains = 1, refresh = 0)
yrep <- rstan::extract(fit_prior, pars = "y_rep")[1]]
idx <- EczemaPred::get_index2(t_max = t_max)
fd <- idx %>% mutate(Score = yrep[5, ])
fit_fake <- EczemaPred::EczemaFit(model, train = fd, test = , chains = 1, refresh = 0)
# Test summary_statistics -------------------------------------------------------------------
par_prior <- (fit_prior, pars = (param))
par_fake <- (fit_fake, pars = (param))
test_that("summary_statistics returns the right content", {
expect_equal((par_fake), (par_prior))
expect_equal((par_fake), N_parameters)
expect_equal((par_fake[par_fake$Variable == "p10", ]), N_patient)
expect_equal((par_fake[par_fake$Variable == "y_rep", ]), N)
expect_equal((par_fake$Index[par_fake$Variable == "p10"]), 1:N_patient)
expect_true(((par_fake$Index[par_fake$Variable %in% param$Population])))
})
test_that("summary_statistics catches wrong inputs", {
expect_error(((1e3), ""))
expect_error((fit_fake, param, ((5, 95, 5), "%")))
expect_error((fit_fake, "parameter_not_in_model"))
expect_error((fit_fake, 1))
})
# Test combine_prior_posterior --------------------------------------------
test_that("combine_prior_posterior works", {
cpp1 <- (par_prior, par_fake, pars = , match_exact = )
expect_true((cpp1))
expect_true(((par_prior) %in% (cpp1)))
expect_true(((par_fake) %in% (cpp1)))
expect_true("Distribution" %in% (cpp1))
expect_true((((cpp1"Distribution"]])) %in% ("Prior", "Posterior")))
expect_true(((cpp1"Variable"]]) %in% (param)))
cpp2 <- (par_prior, par_fake, pars = "p10", match_exact = )
expect_equal(((cpp2"Variable"]])), "p10")
par_prior2 <- par_prior %>% drop_na() %>% mutate(Variable = (Variable, "[", Index, "]")) %>% select(-Index)
par_fake2 <- par_fake %>% drop_na() %>% mutate(Variable = (Variable, "[", Index, "]")) %>% select(-Index)
cpp3 <- (par_prior2, par_prior2, pars = "p10", match_exact = )
expect_equal(((cpp2"Variable"]])), "p10")
expect_equal((cpp2), (cpp3))
expect_error((par_prior2, par_prior2, pars = "p10", match_exact = ))
})
# Test plot_prior_posterior -----------------------------------------------
test_that("plot_prior_posterior returns a ggplot object", {
expect_is((par_prior, par_fake, pars = param$Population), "ggplot")
})
test_that("plot_prior_posterior identifies incorrect inputs", {
expect_error((par_prior, (par_fake), pars = param$Population))
expect_error(((par_prior), par_fake, pars = param$Population))
expect_error(((par_prior), par_fake, pars = param$Population))
expect_error((par_prior, par_fake, pars = (param$Population)))
expect_error((par_prior, par_fake, pars = "parameter_not_in_model"))
tmp1 <- par_prior
tmp1"5%"]] <-
tmp2 <- par_fake
tmp2"5%"]] <-
expect_error((tmp1, tmp2, pars = param$Population))
})
# Test prior_influence --------------------------------------------
test_that("compute_prior_influence returns correct values", {
prior <- (Variable = ("a", "b", "b"),
Index = (, 1, 2),
Mean = (0, 1, ),
= (1, 2, )) # test that prior for b[2] does not matter
post <- (Variable = ("a", "b", "b"),
Index = (, 1, 2),
Mean = (0, 1, 1.5),
= (0.1, 1, 2))
expected_output <- (Variable = ("a", "b", "b"),
Index = (, 1, 2),
PostShrinkage = (0.99, 0.75, 0),
DistPrior = (0, 0, 0.25))
expect_equal((prior, post, ("a", "b")),
expected_output)
})
test_that("plot_prior_influence returns a ggplot object", {
expect_is((par_prior, par_fake, pars = (param[c("Population", "Patient")])), "ggplot")
expect_is((par_prior, par_fake, pars = (param[c("Population", "Patient")])), "ggplot")
})
test_that("check_model_sensitivity identifies incorrect inputs", {
expect_error((par_prior, (par_fake), pars = param$Population))
expect_error(((par_prior), par_fake, pars = param$Population))
expect_error(((par_prior), par_fake, pars = param$Population))
expect_error((par_prior, par_fake, pars = (param$Population)))
})
# Test PPC_group_distribution ----------------------------------------------------
test_that("PPC_group_distribution returns a ggplot object for different inputs", {
expect_is((fit_fake, "p10", 1), "ggplot")
expect_is((fit_fake, "p10", 100), "ggplot")
expect_is((rstan::extract(fit_fake, pars = "p10")[1]], "p10", 1), "ggplot")
expect_is((((1e3), = 10), "p10", 10), "ggplot")
})
test_that("PPC_group_distribution incorrect inputs", {
expect_error((fit_fake, 1))
expect_error((fit_fake, "p10", 0))
expect_error((fit_fake, "p10", 1e5))
expect_error((fit_fake, ("p10", "y_rep")))
expect_error((fit_fake, "parameter_not_in_model"))
})
# Test compute_rsquared ---------------------------------------------------
test_that("compute_rsquared runs", {
rsq <- (yrep)
expect_true(dplyr::between(rsq, 0, 1))
})
test_that("compute_rsquared catches incorrect input", {
expect_error(((yrep)))
expect_error((yrep, 1]))
})
# extract_distribution with stanfit object --------------------------------
test_that("extract_distribution works with stanfit object", {
<- (fit_fake, parName = "y_rep", = "discrete", support = (0, max_score))
expect_true((("Value", "Probability", "Index", "Variable") %in% ()))
expect_equal((("Index"]])), N)
expect_equal(("Value"]]), (0, max_score))
})
test_that("process_replications output is in the correct support", {
pred_cont <- (fit_fake, idx = idx, parName = "y_rep", bounds = (0, max_score), = "discrete")
expect_equal((pred_cont"y_rep"]]), (0, max_score))
})
test_that("process_replications truncation works", {
bd <- (0, (max_score / 5))
pred_eti <- (fit_fake, idx = idx, parName = "y_rep", bounds = bd, = "eti", CI_level = .99)
expect_true(!(!(dplyr::between(pred_eti"Lower"]], bd[1], bd[2]),
dplyr::between(pred_eti"Upper"]], bd[1], bd[2])),
na.rm = ))
})
test_that("process_replications failures and warnings", {
expect_warning((fit_fake, idx = , parName = "y_rep", bounds = )) # support warning from extract_distribution
expect_error(((1e3), idx = , parName = "y_rep")) # fit is not a stanfit object
})
# extract_parameters_from_draw (deprecated) --------------------------------------------------------------
tmp <- (fit_fake, (param), 1)
test_that("extract_parameters_from_draw returns dataframe of correct size", {
expect_equal((tmp), N_parameters)
})
test_that("extract_parameters_from_draw extract all parameters", {
expect_equal((((param))),
(((tmp"Parameter"]]))))
})
test_that("extract_parameters_from_draw catches incorrect inputs", {
expect_error(((1e3), "x", 1)) # not stanfit
expect_warning((fit_fake, "p10", (1, 2))) # multiple draws
})
