tests/testthat/tests.stan.R

In thurstonianIRT: Thurstonian IRT Models

context("Tests for TIRT models fitted with Stan")

test_that("Stan code for bernoulli responses works", {
  set.seed(1234)
  lambdas <- c(runif(6, 0.5, 1), runif(6, -1, -0.5))
  sdata <- sim_TIRT_data(
    npersons = 10,
    ntraits = 3,
    nblocks_per_trait = 4,
    gamma = 0,
    lambda = lambdas,
    Phi = diag(3),
    family = "bernoulli"
  )
  fit <- suppressWarnings(fit_TIRT_stan(sdata, chains = 1, iter = 500))
  expect_is(fit, "TIRTfit")
  pr <- predict(fit)
  pr_names <- c("id", "trait", "estimate", "se", "lower_ci", "upper_ci")
  expect_equal(names(pr), pr_names)
  expect_equal(length(unique(pr$id)), 10)

  # test predictions for new data
  new_sdata <- dplyr::filter(sdata, person %in% 1:5)
  pr_new <- predict(fit, new_sdata, chains = 1, iter = 500)
  expect_equal(names(pr_new), pr_names)
  expect_equal(length(unique(pr_new$id)), 5)
})

test_that("Stan code for ordinal responses works", {
  set.seed(1234)
  ncat <- 4
  gamma <- matrix(
    seq(-2, 2, length.out = max(ncat) - 1),
    nrow = 12,
    ncol = max(ncat) - 1,
    byrow = TRUE
  )
  lambdas <- c(runif(6, 0.5, 1), runif(6, -1, -0.5))
  sdata <- sim_TIRT_data(
    npersons = 10,
    ntraits = 3,
    nblocks_per_trait = 4,
    gamma = gamma,
    lambda = lambdas,
    Phi = diag(3),
    family = "cumulative"
  )
  fit <- suppressWarnings(fit_TIRT_stan(sdata, chains = 1, iter = 500))
  expect_is(fit, "TIRTfit")
  pr <- predict(fit)
  pr_names <- c("id", "trait", "estimate", "se", "lower_ci", "upper_ci")
  expect_equal(names(pr), pr_names)
  expect_equal(length(unique(pr$id)), 10)

  # test predictions for new data
  new_sdata <- dplyr::filter(sdata, person %in% 1:5)
  pr_new <- predict(fit, new_sdata, chains = 1, iter = 500)
  expect_equal(names(pr_new), pr_names)
  expect_equal(length(unique(pr_new$id)), 5)
})

test_that("Stan code for gaussian responses works", {
  set.seed(1234)
  lambdas <- c(runif(6, 0.5, 1), runif(6, -1, -0.5))
  sdata <- sim_TIRT_data(
    npersons = 10,
    ntraits = 3,
    nblocks_per_trait = 4,
    gamma = 0,
    lambda = lambdas,
    Phi = diag(3),
    family = "gaussian"
  )
  fit <- suppressWarnings(fit_TIRT_stan(sdata, chains = 1, iter = 500))
  expect_is(fit, "TIRTfit")
  pr <- predict(fit)
  pr_names <- c("id", "trait", "estimate", "se", "lower_ci", "upper_ci")
  expect_equal(names(pr), pr_names)
  expect_equal(length(unique(pr$id)), 10)

  # test predictions for new data
  new_sdata <- dplyr::filter(sdata, person %in% 1:5)
  pr_new <- predict(fit, new_sdata, chains = 1, iter = 500)
  expect_equal(names(pr_new), pr_names)
  expect_equal(length(unique(pr_new$id)), 5)
})