Nothing
context("nextItem-KL")
load("cat_objects.Rdata")
test_that("ltm nextItem KL calculates correctly", {
ltm_cat@estimation <- "EAP"
ltm_cat@selection <- "KL"
ltm_cat@answers[1:7] <- c(0, 1, 0, 0, 1, 0, 0)
package_next <- selectItem(ltm_cat)
package_item <- package_next$next_item
package_est <- package_next$estimates[package_next$estimates$q_number == package_item,
"KL"]
delta <- qnorm(ltm_cat@z) * sqrt(fisherTestInfo(ltm_cat, estimateTheta(ltm_cat)))
catIrt_next <- catIrt::itChoose(cbind(8:40, it_ltm[8:40,1:3]),
mod = "brm",
numb = 1,
n.select = 1,
cat_par = it_ltm[1:7, 1:3],
cat_resp = ltm_cat@answers[1:7],
cat_theta = estimateTheta(ltm_cat),
select = "FI-KL",
delta = delta,
at = "theta")
catIrt_item <- as.numeric(catIrt_next$params[1,1])
catIrt_est <- catIrt_next$info
expect_equal(package_item, catIrt_item)
expect_equal(round(package_est, 3), round(catIrt_est, 3))
})
test_that("grm nextItem KL calculates correctly", {
grm_cat@estimation <- "EAP"
grm_cat@selection <- "KL"
grm_cat@answers[1:8] <- c(5, 4, 2, 2, 1, 2, 2, 3)
package_next <- selectItem(grm_cat)
package_item <- package_next$next_item
package_est <- package_next$estimates[package_next$estimates$q_number == package_item,
"KL"]
delta <- qnorm(grm_cat@z) * sqrt(fisherTestInfo(grm_cat, estimateTheta(grm_cat)))
catIrt_next <- catIrt::itChoose(cbind(9:18, it_grm[9:18,]),
mod = "grm",
numb = 1,
n.select = 1,
cat_par = it_grm[1:8, ],
cat_resp = grm_cat@answers[1:8],
cat_theta = estimateTheta(grm_cat),
select = "FI-KL",
delta = delta,
at = "theta")
catIrt_item <- as.numeric(catIrt_next$params[1,1])
catIrt_est <- catIrt_next$info
expect_equal(package_item, catIrt_item)
expect_equal(round(package_est, 1), round(catIrt_est, 1))
})
test_that("nextItem KL is actually the maximum estimate", {
ltm_cat@selection <- "KL"
ltm_cat@answers[1:5] <- c(1, 0, 1, 1, 1)
grm_cat@selection <- "KL"
grm_cat@answers[1:5] <- c(5, 4, 2, 2, 5)
gpcm_cat@selection <- "KL"
gpcm_cat@answers[1:5] <- c(1, 1, 2, 2, 4)
ltm_next <- selectItem(ltm_cat)
grm_next <- selectItem(grm_cat)
gpcm_next <- selectItem(gpcm_cat)
expect_equal(ltm_next$next_item, ltm_next$estimates[which(ltm_next$estimates[, "KL"] ==
max(ltm_next$estimates[, "KL"])), "q_number"])
expect_equal(grm_next$next_item, grm_next$estimates[which(grm_next$estimates[, "KL"] ==
max(grm_next$estimates[, "KL"])), "q_number"])
expect_equal(gpcm_next$next_item, gpcm_next$estimates[which(gpcm_next$estimates[, "KL"] ==
max(gpcm_next$estimates[, "KL"])), "q_number"])
})
test_that("nextItem KL correctly skips questions", {
ltm_cat@selection <- "KL"
grm_cat@selection <- "KL"
gpcm_cat@selection <- "KL"
ltm_cat@answers[1:10] <- c(rep(-1, 5), 1, 1, 0, 0, 1)
grm_cat@answers[1:5] <- c(-1, -1, 5, 4, 3)
gpcm_cat@answers[1:5] <- c(-1, -1, 5, 4, 3)
ltm_next <- selectItem(ltm_cat)
grm_next <- selectItem(grm_cat)
gpcm_next <- selectItem(gpcm_cat)
expect_equal(nrow(ltm_next$estimates) + sum(!is.na(ltm_cat@answers)),
length(ltm_cat@answers))
expect_equal(nrow(grm_next$estimates) + sum(!is.na(grm_cat@answers)),
length(grm_cat@answers))
expect_equal(nrow(gpcm_next$estimates) + sum(!is.na(gpcm_cat@answers)),
length(gpcm_cat@answers))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.