diff --git a/tests/testthat/test-ecpe.R b/tests/testthat/test-ecpe.R index 907c11d..5f52154 100644 --- a/tests/testthat/test-ecpe.R +++ b/tests/testthat/test-ecpe.R @@ -1,18 +1,22 @@ -if (!identical(Sys.getenv("NOT_CRAN"), "true")) skip("No MCMC on CRAN") - -out <- capture.output( - suppressMessages( - cmds_ecpe_lcdm <- measr_dcm( - data = ecpe_data, missing = NA, qmatrix = ecpe_qmatrix, - resp_id = "resp_id", item_id = "item_id", type = "lcdm", - method = "optim", seed = 63277, backend = "cmdstanr", - prior = c(prior(uniform(-15, 15), class = "intercept"), - prior(uniform(0, 15), class = "maineffect"), - prior(uniform(-15, 15), class = "interaction"))) +if (!identical(Sys.getenv("NOT_CRAN"), "true")) { + skip("No MCMC on CRAN") +} else { + out <- capture.output( + suppressMessages( + cmds_ecpe_lcdm <- measr_dcm( + data = ecpe_data, missing = NA, qmatrix = ecpe_qmatrix, + resp_id = "resp_id", item_id = "item_id", type = "lcdm", + method = "optim", seed = 63277, backend = "cmdstanr", + prior = c(prior(uniform(-15, 15), class = "intercept"), + prior(uniform(0, 15), class = "maineffect"), + prior(uniform(-15, 15), class = "interaction"))) + ) ) -) +} test_that("lcdm model works for ecpe", { + skip_on_cran() + expect_s3_class(cmds_ecpe_lcdm, "measrfit") expect_s3_class(cmds_ecpe_lcdm, "measrdcm") expect_equal(names(cmds_ecpe_lcdm), @@ -64,6 +68,8 @@ test_that("lcdm model works for ecpe", { }) test_that("extract ecpe", { + skip_on_cran() + lcdm_param <- measr_extract(cmds_ecpe_lcdm, "item_param") all_param <- get_parameters(ecpe_qmatrix, item_id = "item_id", type = "lcdm") %>% @@ -105,6 +111,8 @@ test_that("extract ecpe", { }) test_that("ecpe probabilities are accurate", { + skip_on_cran() + ecpe_preds <- predict(cmds_ecpe_lcdm, newdata = ecpe_data, resp_id = "resp_id") @@ -176,6 +184,8 @@ test_that("ecpe probabilities are accurate", { }) test_that("ecpe reliability", { + skip_on_cran() + ecpe_reli <- reliability(cmds_ecpe_lcdm) # list naming @@ -247,6 +257,8 @@ test_that("ecpe reliability", { }) test_that("m2 calculation is correct", { + skip_on_cran() + m2 <- fit_m2(cmds_ecpe_lcdm) expect_equal(m2$m2, 507.0756, tolerance = 0.1) @@ -262,6 +274,8 @@ test_that("m2 calculation is correct", { }) test_that("mcmc requirements error", { + skip_on_cran() + err <- rlang::catch_cnd(add_fit(cmds_ecpe_lcdm, method = "ppmc")) expect_s3_class(err, "error_bad_method") expect_match(err$message, "`method = \"mcmc\"`") diff --git a/tests/testthat/test-mcmc.R b/tests/testthat/test-mcmc.R index 05a0f32..4f7bf17 100644 --- a/tests/testthat/test-mcmc.R +++ b/tests/testthat/test-mcmc.R @@ -1,33 +1,37 @@ -if (!identical(Sys.getenv("NOT_CRAN"), "true")) skip("No MCMC on CRAN") - -out <- capture.output( - suppressMessages( - cmds_mdm_lcdm <- measr_dcm( - data = mdm_data, missing = NA, qmatrix = mdm_qmatrix, - resp_id = "respondent", item_id = "item", type = "lcdm", - method = "mcmc", seed = 63277, backend = "cmdstanr", - iter_sampling = 500, iter_warmup = 1000, chains = 2, - parallel_chains = 2, - prior = c(prior(uniform(-15, 15), class = "intercept"), - prior(uniform(0, 15), class = "maineffect"))) +if (!identical(Sys.getenv("NOT_CRAN"), "true")) { + skip("No MCMC on CRAN") +} else { + out <- capture.output( + suppressMessages( + cmds_mdm_lcdm <- measr_dcm( + data = mdm_data, missing = NA, qmatrix = mdm_qmatrix, + resp_id = "respondent", item_id = "item", type = "lcdm", + method = "mcmc", seed = 63277, backend = "cmdstanr", + iter_sampling = 500, iter_warmup = 1000, chains = 2, + parallel_chains = 2, + prior = c(prior(uniform(-15, 15), class = "intercept"), + prior(uniform(0, 15), class = "maineffect"))) + ) ) -) - -out <- capture.output( - suppressMessages( - cmds_mdm_dina <- measr_dcm( - data = mdm_data, missing = NA, qmatrix = mdm_qmatrix, - resp_id = "respondent", item_id = "item", type = "dina", - attribute_structure = "independent", - method = "mcmc", seed = 63277, backend = "rstan", - iter = 1500, warmup = 1000, chains = 2, - cores = 2, - prior = c(prior(beta(5, 17), class = "slip"), - prior(beta(5, 17), class = "guess"))) + + out <- capture.output( + suppressMessages( + cmds_mdm_dina <- measr_dcm( + data = mdm_data, missing = NA, qmatrix = mdm_qmatrix, + resp_id = "respondent", item_id = "item", type = "dina", + attribute_structure = "independent", + method = "mcmc", seed = 63277, backend = "rstan", + iter = 1500, warmup = 1000, chains = 2, + cores = 2, + prior = c(prior(beta(5, 17), class = "slip"), + prior(beta(5, 17), class = "guess"))) + ) ) -) +} test_that("as_draws works", { + skip_on_cran() + draws <- as_draws(cmds_mdm_dina) expect_s3_class(draws, "draws_array") @@ -48,6 +52,8 @@ test_that("as_draws works", { }) test_that("get_mcmc_draws works as expected", { + skip_on_cran() + test_draws <- get_mcmc_draws(cmds_mdm_lcdm) expect_equal(posterior::ndraws(test_draws), 1000) expect_equal(posterior::nvariables(test_draws), 10) @@ -60,6 +66,8 @@ test_that("get_mcmc_draws works as expected", { }) test_that("log_lik is calculated correctly", { + skip_on_cran() + log_lik <- prep_loglik_array(cmds_mdm_lcdm) # expected value from 2-class LCA fit in Mplus @@ -67,6 +75,8 @@ test_that("log_lik is calculated correctly", { }) test_that("loo and waic work", { + skip_on_cran() + err <- rlang::catch_cnd(loo(rstn_dina)) expect_s3_class(err, "error_bad_method") expect_match(err$message, "`method = \"mcmc\"`") @@ -83,6 +93,8 @@ test_that("loo and waic work", { }) test_that("loo and waic can be added to model", { + skip_on_cran() + err <- rlang::catch_cnd(measr_extract(cmds_mdm_lcdm, "loo")) expect_s3_class(err, "rlang_error") expect_match(err$message, "LOO criterion must be added") @@ -114,6 +126,8 @@ test_that("loo and waic can be added to model", { }) test_that("model comparisons work", { + skip_on_cran() + err <- rlang::catch_cnd(loo_compare(cmds_mdm_lcdm, cmds_mdm_dina)) expect_s3_class(err, "error_missing_criterion") expect_match(err$message, "does not contain a precomputed") @@ -147,6 +161,8 @@ test_that("model comparisons work", { }) test_that("ppmc works", { + skip_on_cran() + test_ppmc <- fit_ppmc(cmds_mdm_lcdm, model_fit = character(), item_fit = character()) expect_equal(test_ppmc, list()) @@ -214,6 +230,8 @@ test_that("ppmc works", { }) test_that("ppmc extraction errors", { + skip_on_cran() + err <- rlang::catch_cnd(measr_extract(cmds_mdm_lcdm, "ppmc_raw_score")) expect_s3_class(err, "rlang_error") expect_match(err$message, "Model fit information must be added") @@ -237,6 +255,8 @@ test_that("ppmc extraction errors", { }) test_that("model fit can be added", { + skip_on_cran() + test_model <- cmds_mdm_dina expect_equal(test_model$fit, list()) @@ -321,6 +341,8 @@ test_that("model fit can be added", { }) test_that("respondent probabilities are correct", { + skip_on_cran() + mdm_preds <- predict(cmds_mdm_lcdm, newdata = mdm_data, resp_id = "respondent", summary = TRUE) mdm_full_preds <- predict(cmds_mdm_lcdm, summary = FALSE)