tests/testthat/test-irt.R

In exametrika: Test Data Engineering

library(exametrika)

### model2
pl2Test <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT2pl_Test.csv"),
  check.names = FALSE
)
pl2Item <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT2pl_Item.csv"),
  check.names = FALSE
)
pl2Student <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT2pl_Student.csv"),
  check.names = FALSE
)
pl2Q3mat <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT2pl_Q3.csv"),
  check.names = FALSE
)

tmp <- dataFormat(J15S500, na = -99)
result2 <- IRT(model = 2, tmp)

test_that("2PL model Test Info", {
  expect <- pl2Test[13:28, 2] |>
    unlist() |>
    unname() |>
    as.numeric()
  expect <- expect[c(5, 1, 2, 6, 3, 7, 4, 8, 9, 10, 11, 12, 13, 14, 15, 16)]
  result <- result2$TestFitIndices |> as.numeric()
  expect_equal(result, expect, tolerance = 1e-4)
})

test_that("2PL model Item Params Info", {
  expect <- pl2Item[, 7:6] |>
    unlist() |>
    as.numeric()
  result <- result2$params |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl2Item$`PSD(Slope)` |>
    unlist() |>
    as.numeric()
  result <- result2$itemPSD[, 1] |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl2Item$`PSD(Loc)` |>
    unlist() |>
    as.numeric()
  result <- result2$itemPSD[, 2] |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})

test_that("2PL model Item FitIndices", {
  expect <- pl2Item$`Log-Likelihood(Benchmark Model)` |>
    unlist() |>
    as.numeric()
  result <- result2$ItemFitIndices$bench_log_like |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl2Item$`Log-Likelihood(Null Model)` |>
    unlist() |>
    as.numeric()
  result <- result2$ItemFitIndices$null_log_like |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl2Item$`Log-Likelihood(Analysis Model)` |>
    unlist() |>
    as.numeric()
  result <- result2$ItemFitIndices$model_log_like |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl2Item[, 18:26] |>
    unlist() |>
    as.numeric()
  result <- result2$ItemFitIndices |>
    unclass() |>
    as.data.frame()
  result <- result[, 8:16] |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})


test_that("2PL model Students", {
  expect <- pl2Student$`EAP Score` |>
    unlist() |>
    as.numeric()
  result <- result2$ability$EAP |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl2Student$`Posterior SD` |>
    unlist() |>
    as.numeric()
  result <- result2$ability$PSD |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})

test_that("2PL Q3mat", {
  expect <- pl2Q3mat[, -1] |>
    unlist() |>
    as.numeric()
  result <- result2$Q3mat |>
    unlist() |>
    as.numeric()
  # Q3 residual correlations include values near zero where relative
  # tolerance is unreliable. Use absolute difference comparison instead.
  max_abs_diff <- max(abs(result - expect))
  expect_true(max_abs_diff < 0.005,
    info = sprintf(
      "Max absolute difference in Q3 matrix: %.6f (threshold: 0.005)",
      max_abs_diff
    )
  )
})


# model3 ------------------------------------------------------------------
pl3Test <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT3pl_Test.csv"),
  check.names = FALSE
)
pl3Item <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT3pl_Item.csv"),
  check.names = FALSE
)
pl3Student <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT3pl_Student.csv"),
  check.names = FALSE
)
pl3Q3mat <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT3pl_Q3.csv"),
  check.names = FALSE
)


tmp <- dataFormat(J15S500, na = -99)
result3 <- IRT(model = 3, tmp)

test_that("3PL model Test Info", {
  expect <- pl3Test[13:28, 2] |>
    unlist() |>
    unname() |>
    as.numeric()
  expect <- expect[c(5, 1, 2, 6, 3, 7, 4, 8, 9, 10, 11, 12, 13, 14, 15, 16)]
  result <- result3$TestFitIndices |> as.numeric()
  expect_equal(result, expect, tolerance = 1e-4)
})

test_that("3PL model Item Params Info", {
  expect <- pl3Item[, 7:9] |>
    unlist() |>
    as.numeric()
  result <- result3$params |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl3Item[, 10:12] |>
    unlist() |>
    as.numeric()
  result <- result3$itemPSD |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})

test_that("3PL model Item FitIndices", {
  expect <- pl3Item$`Log-Likelihood(Benchmark Model)` |>
    unlist() |>
    as.numeric()
  result <- result3$ItemFitIndices$bench_log_like |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl3Item$`Log-Likelihood(Null Model)` |>
    unlist() |>
    as.numeric()
  result <- result3$ItemFitIndices$null_log_like |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl3Item$`Log-Likelihood(Analysis Model)` |>
    unlist() |>
    as.numeric()
  result <- result3$ItemFitIndices$model_log_like |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl3Item[, 20:28] |>
    unlist() |>
    as.numeric()
  result <- result3$ItemFitIndices |>
    unclass() |>
    as.data.frame()
  result <- result[, 8:16] |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})


test_that("3PL model Students", {
  expect <- pl3Student$`EAP Score` |>
    unlist() |>
    as.numeric()
  result <- result3$ability$EAP |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl3Student$`Posterior SD` |>
    unlist() |>
    as.numeric()
  result <- result3$ability$PSD |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})


# model4 ------------------------------------------------------------------
pl4Test <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT4pl_Test.csv"),
  check.names = FALSE
)
pl4Item <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT4pl_Item.csv"),
  check.names = FALSE
)
pl4Student <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT4pl_Student.csv"),
  check.names = FALSE
)
pl4Q3mat <- read.csv(
  test_path("fixtures", "mathematica_reference", "Chapter04IRT4pl_Q3.csv"),
  check.names = FALSE
)


tmp <- dataFormat(J15S500, na = -99)
result4 <- IRT(model = 4, tmp)

test_that("4PL model Test Info", {
  expect <- pl4Test[13:28, 2] |>
    unlist() |>
    unname() |>
    as.numeric()
  expect <- expect[c(5, 1, 2, 6, 3, 7, 4, 8, 9, 10, 11, 12, 13, 14, 15, 16)]
  result <- result4$TestFitIndices |> as.numeric()
  expect_equal(result, expect, tolerance = 1e-4)
})


test_that("4PL model Item Params", {
  expect <- pl4Item[, 7:10] |>
    unlist() |>
    as.numeric()
  result <- result4$params |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})

test_that("4PL model Item PSD", {
  expect <- pl4Item[, 11:14] |>
    unlist() |>
    as.numeric()
  result <- result4$itemPSD |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})

test_that("4PL log-lik Bench", {
  expect <- pl4Item$`Log-Likelihood(Benchmark Model)` |>
    unlist() |>
    as.numeric()
  result <- result4$ItemFitIndices$bench_log_like |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})

test_that("4PL log-lik Null", {
  expect <- pl4Item$`Log-Likelihood(Null Model)` |>
    unlist() |>
    as.numeric()
  result <- result4$ItemFitIndices$null_log_like |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})
test_that("4PL log-lik Analysis", {
  expect <- pl4Item$`Log-Likelihood(Analysis Model)` |>
    unlist() |>
    as.numeric()
  result <- result4$ItemFitIndices$model_log_like |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})

test_that("4PL Standardized FIdx", {
  expect <- pl4Item[, 22:30] |>
    unlist() |>
    as.numeric()
  result <- result4$ItemFitIndices |>
    unclass() |>
    as.data.frame()
  result <- result[, 8:16] |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})


test_that("4PL model Students", {
  expect <- pl4Student$`EAP Score` |>
    unlist() |>
    as.numeric()
  result <- result4$ability$EAP |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)

  expect <- pl4Student$`Posterior SD` |>
    unlist() |>
    as.numeric()
  result <- result4$ability$PSD |>
    unlist() |>
    as.numeric()
  expect_equal(result, expect, tolerance = 1e-3)
})

test_that("3PL Q3mat", {
  # the reference existed but nothing read it; 2PL was the only arm checked.
  # Same absolute-difference comparison as 2PL: Q3 residual correlations pass
  # through zero, where a relative tolerance is meaningless.
  expect <- pl3Q3mat[, -1] |>
    unlist() |>
    as.numeric()
  result <- result3$Q3mat |>
    unlist() |>
    as.numeric()
  max_abs_diff <- max(abs(result - expect))
  expect_true(max_abs_diff < 0.005,
    info = sprintf(
      "Max absolute difference in Q3 matrix: %.6f (threshold: 0.005)",
      max_abs_diff
    )
  )
})

test_that("4PL Q3mat", {
  # the reference existed but nothing read it; 2PL was the only arm checked.
  # Same absolute-difference comparison as 2PL: Q3 residual correlations pass
  # through zero, where a relative tolerance is meaningless.
  expect <- pl4Q3mat[, -1] |>
    unlist() |>
    as.numeric()
  result <- result4$Q3mat |>
    unlist() |>
    as.numeric()
  max_abs_diff <- max(abs(result - expect))
  expect_true(max_abs_diff < 0.005,
    info = sprintf(
      "Max absolute difference in Q3 matrix: %.6f (threshold: 0.005)",
      max_abs_diff
    )
  )
})