tests/testthat/test-param-estimates.R

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

test_that("dina model works", {
  expect_s3_class(rstn_dina, "measrfit")
  expect_s3_class(rstn_dina, "measrdcm")
  expect_equal(names(rstn_dina),
               c("data", "type", "prior", "stancode", "method", "algorithm",
                 "backend", "model", "respondent_estimates", "fit", "criteria",
                 "reliability", "file", "version"))
  expect_equal(names(rstn_dina$data),
               c("data", "qmatrix", "resp_id", "item_id"))
  expect_equal(rstn_dina$data$data,
               dina_data %>%
                 tidyr::pivot_longer(-resp_id, names_to = "item_id",
                                     values_to = "score") %>%
                 dplyr::mutate(resp_id = factor(resp_id),
                               item_id = factor(item_id,
                                                levels = unique(item_id))))
  expect_equal(rstn_dina$data$qmatrix,
               q_matrix %>%
                 dplyr::rename(item_id = item) %>%
                 dplyr::mutate(item_id = factor(item_id,
                                                levels = unique(item_id))))
  expect_equal(rstn_dina$type, "dina")
  expect_equal(rstn_dina$prior, default_dcm_priors(type = "dina"))
  expect_snapshot(rstn_dina$stancode, variant = "dina-code")
  expect_equal(rstn_dina$method, "optim")
  expect_equal(rstn_dina$algorithm, "LBFGS")
  expect_type(rstn_dina$model, "list")
  expect_equal(names(rstn_dina$model),
               c("par", "value", "return_code", "theta_tilde"))
  expect_type(rstn_dina$respondent_estimates, "list")
  expect_type(rstn_dina$fit, "list")
  expect_type(rstn_dina$criteria, "list")
  expect_type(rstn_dina$reliability, "list")
  expect_null(rstn_dina$file)
  expect_equal(names(rstn_dina$version),
               c("R", "measr", "rstan", "StanHeaders"))

  dina_comp <- tibble::enframe(rstn_dina$model$par) %>%
    dplyr::filter(grepl("^Vc|slip|guess", .data$name)) %>%
    dplyr::mutate(name = gsub("Vc", "nu", .data$name)) %>%
    dplyr::left_join(true_dinoa, by = c("name" = "param"))

  comp_cor <- cor(dina_comp$value, dina_comp$true)
  comp_dif <- abs(dina_comp$value - dina_comp$true)

  expect_gte(comp_cor, 0.85)
  expect_lte(max(comp_dif), 0.2)
})

test_that("dino model works", {
  expect_s3_class(rstn_dino, "measrfit")
  expect_s3_class(rstn_dino, "measrdcm")
  expect_equal(names(rstn_dino),
               c("data", "type", "prior", "stancode", "method", "algorithm",
                 "backend", "model", "respondent_estimates", "fit", "criteria",
                 "reliability", "file", "version"))
  expect_equal(names(rstn_dino$data),
               c("data", "qmatrix", "resp_id", "item_id"))
  expect_equal(rstn_dino$data$data,
               dino_data %>%
                 tidyr::pivot_longer(-resp_id, names_to = "item_id",
                                     values_to = "score") %>%
                 dplyr::mutate(resp_id = factor(resp_id),
                               item_id = factor(item_id,
                                                levels = unique(item_id))))
  expect_equal(rstn_dino$data$qmatrix,
               q_matrix %>%
                 dplyr::rename(item_id = item) %>%
                 dplyr::mutate(item_id = factor(item_id,
                                                levels = unique(item_id))))
  expect_equal(rstn_dino$type, "dino")
  expect_equal(rstn_dino$prior, default_dcm_priors(type = "dino"))
  expect_snapshot(rstn_dino$stancode, variant = "dino-code")
  expect_equal(rstn_dino$method, "optim")
  expect_equal(rstn_dino$algorithm, "LBFGS")
  expect_type(rstn_dino$model, "list")
  expect_equal(names(rstn_dino$model),
               c("par", "value", "return_code", "theta_tilde"))
  expect_type(rstn_dino$respondent_estimates, "list")
  expect_type(rstn_dino$fit, "list")
  expect_type(rstn_dino$criteria, "list")
  expect_type(rstn_dino$reliability, "list")
  expect_null(rstn_dino$file)
  expect_equal(names(rstn_dino$version),
               c("R", "measr", "rstan", "StanHeaders"))

  dino_comp <- tibble::enframe(rstn_dino$model$par) %>%
    dplyr::filter(grepl("^Vc|slip|guess", .data$name)) %>%
    dplyr::mutate(name = gsub("Vc", "nu", .data$name)) %>%
    dplyr::left_join(true_dinoa, by = c("name" = "param"))

  comp_cor <- cor(dino_comp$value, dino_comp$true)
  comp_dif <- abs(dino_comp$value - dino_comp$true)

  expect_gte(comp_cor, 0.85)
  expect_lte(max(comp_dif), 0.2)
})