#########################
# Binary Response Model #
#########################
set.seed(888)
# generating random theta:
thetas <- rnorm(50)
# generating an item bank under a 2-parameter binary response model:
b.params <- cbind(a = runif(100, .5, 1.5), b = rnorm(100, 0, 2), c = 0)
# simulating responses:
b.resp <- simIrt(thetas = thetas, params = b.params, mod = "brm")$resp
## CAT 1 ##
# the typical, classic post-hoc CAT:
catStart1 <- list(init.thet = 0, step.size = 3,
select = "FI", at = "theta",
n.select = 4, score = "step",
n.it = 5, leave.after.MLE = TRUE)
catMiddle1 <- list(select = "FI", at = "theta",
n.select = 1, score = "MLE",
int = c(-6, 6), expos = "none")
catTerm1 <- list(term = "fixed", n.min = 10, n.max = 50)
cat1 <- catIrt(params = b.params, mod = "brm",
resp = b.resp,
catStart = catStart1,
catMiddle = catMiddle1,
catTerm = catTerm1)
# we can print, summarize, and plot:
cat1 # prints theta because
# we have fewer than
# 200 simulees
summary(cat1, group = TRUE, ids = "none") # nice summary!
summary(cat1, group = FALSE, ids = 1:4) # summarizing people too! :)
par(mfrow = c(2, 2))
plot(cat1, ask = FALSE) # 2-parameter model, so expected FI
# and observed FI are the same
par(mfrow = c(1, 1))
# we can also plot particular simulees:
par(mfrow = c(2, 1))
plot(cat1, which = "none", ids = c(1, 30), ask = FALSE)
par(mfrow = c(1, 1))
## CAT 2 ##
# using KL rather than FI to select items:
catStart2 <- catStart1
catMiddle2 <- catMiddle1
catTerm2 <- catTerm1
catMiddle2$select <- "KL"
catMiddle2$at <- "bounds"
catTerm2$c.term <- list(bounds = 0, delta = .1)
cat2 <- catIrt(params = b.params, mod = "brm",
resp = b.resp,
catStart = catStart2,
catMiddle = catMiddle2,
catTerm = catTerm2)
cor(cat1$cat_theta, cat2$cat_theta) # very close!
## CAT 3/4 ##
# using "var" rather than "fixed" to terminate:
catTerm1$term <- catTerm2$term <- "var"
catTerm1$v.term <- catTerm2$v.term <- .3
cat3 <- catIrt(params = b.params, mod = "brm",
resp = b.resp,
catStart = catStart1,
catMiddle = catMiddle1,
catTerm = catTerm1)
cat4 <- catIrt(params = b.params, mod = "brm",
resp = b.resp,
catStart = catStart2,
catMiddle = catMiddle2,
catTerm = catTerm2)
mean(cat3$cat_length - cat4$cat_length) # KL info results in slightly more items
## CAT 5/6 ##
# classification CAT with a boundary of 0 (with default classification stuff):
catTerm5 <- list(term = "class", n.min = 10, n.max = 50,
c.term = list(method = "SPRT",
bounds = 0, delta = .2,
alpha = .10, beta = .10))
cat5 <- catIrt(params = b.params, mod = "brm",
resp = b.resp,
catStart = catStart1,
catMiddle = catMiddle1,
catTerm = catTerm5)
cat6 <- catIrt(params = b.params, mod = "brm",
resp = b.resp,
catStart = catStart1,
catMiddle = catMiddle2,
catTerm = catTerm5)
# how many were classified correctly?
mean(cat5$cat_categ == cat5$tot_categ)
# using a different selection mechanism, we get the similar results:
mean(cat6$cat_categ == cat6$tot_categ)
## CAT 7 ##
# we could change estimation to EAP with the default (normal) prior:
catMiddle7 <- catMiddle1
catMiddle7$score <- "EAP"
cat7 <- catIrt(params = b.params, mod = "brm", # much slower!
resp = b.resp,
catStart = catStart1,
catMiddle = catMiddle7,
catTerm = catTerm1)
cor(cat1$cat_theta, cat7$cat_theta) # pretty much the same
## CAT 8 ##
# let's specify the prior as something strange:
cat8 <- catIrt(params = b.params, mod = "brm",
resp = b.resp,
catStart = catStart1,
catMiddle = catMiddle7,
catTerm = catTerm1,
ddist = dchisq, df = 4)
cat8 # all positive values of "theta"
## CAT 9 ##
# finally, we can have:
# - more than one termination criteria,
# - individual bounds per person,
# - simulating based on theta without a response matrix.
catTerm9 <- list(term = c("fixed", "class"),
n.min = 10, n.max = 50,
c.term = list(method = "SPRT",
bounds = cbind(runif(length(thetas), -1, 0),
runif(length(thetas), 0, 1)),
delta = .2,
alpha = .1, beta = .1))
cat9 <- catIrt(params = b.params, mod = "brm",
resp = NULL, thetas = thetas,
catStart = catStart1,
catMiddle = catMiddle1,
catTerm = catTerm9)
summary(cat9) # see "... with Each Termination Criterion"
#########################
# Graded Response Model #
#########################
# generating random theta
thetas <- rnorm(201)
# generating an item bank under a graded response model:
g.params <- cbind(a = runif(100, .5, 1.5), b1 = rnorm(100), b2 = rnorm(100),
b3 = rnorm(100), b4 = rnorm(100))
# the graded response model is exactly the same, only slower!
cat10 <- catIrt(params = g.params, mod = "grm",
resp = NULL, thetas = thetas,
catStart = catStart1,
catMiddle = catMiddle1,
catTerm = catTerm1)
# if there is more than 200 simulees, it doesn't print individual thetas:
cat10
# play around with things - CATs are fun - a little frisky, but fun.Run the code above in your browser using DataLab