tests/testthat/test-extract.R

In wjakethompson/measr: Bayesian Psychometric Measurement Using 'Stan'

test_that("errors for unknown", {
  err <- rlang::catch_cnd(measr_extract(rstn_dina, "tswift"))
  expect_s3_class(err, "rlang_error")
  expect_match(err$message, "Cannot extract element `tswift`")
})

test_that("extract item parameters", {
  dina_param <- measr_extract(rstn_dina, "item_param")
  expect_equal(nrow(dina_param), 70)
  expect_equal(colnames(dina_param),
               c("item", "class", "coef", "estimate"))
  expect_true(all(dina_param$item %in% q_matrix$item))
  expect_equal(dina_param$class,
               rep(c("slip", "guess"), 35))
  expect_equal(dina_param$coef,
               get_parameters(q_matrix, item_id = "item", type = "dina") %>%
                 dplyr::filter(class != "structural") %>%
                 dplyr::pull("coef"))
  expect_s3_class(dina_param$estimate, "rvar")
  expect_true(all(!is.na(dina_param$estimate)))
})

test_that("extract structural parameters", {
  dina_param <- measr_extract(rstn_dina, "strc_param")
  expect_equal(nrow(dina_param), 32)
  expect_equal(dina_param$class, dplyr::pull(profile_labels(5), "class"))
  expect_s3_class(dina_param$estimate, "rvar")
  expect_true(all(!is.na(dina_param$estimate)))
})

test_that("extract priors", {
  dina_param <- measr_extract(rstn_dina, "prior")
  expect_equal(dina_param, default_dcm_priors(type = "dina"))
})

test_that("extract classes", {
  dino_param <- measr_extract(rstn_dino, "classes")
  expect_equal(colnames(dino_param), c("class", paste0("att", 1:5)))
  expect_equal(dino_param$class, dplyr::pull(profile_labels(5), "class"))

  exp_label <- dino_param %>%
    dplyr::mutate(new_label = paste0("[", att1, ",", att2, ",", att3, ",",
                                     att4, ",", att5, "]")) %>%
    dplyr::pull("new_label")
  expect_equal(dino_param$class, exp_label)
})