if (FALSE) {
# test defined in mirtCAT help file, first example
# equivalent to criteria = 'MI'
customNextItem <- function(design, person, test){
item <- findNextItem(person=person, design=design, test=test,
criteria = 'MI')
item
}
set.seed(1)
nitems <- 100
itemnames <- paste0('Item.', 1:nitems)
a <- matrix(rlnorm(nitems, .2, .3))
d <- matrix(rnorm(nitems))
dat <- simdata(a, d, 500, itemtype = 'dich')
colnames(dat) <- itemnames
mod <- mirt(dat, 1, verbose = FALSE)
# simple math items
questions <- answers <- character(nitems)
choices <- matrix(NA, nitems, 5)
spacing <- floor(d - min(d)) + 1 #easier items have more variation in the options
for(i in 1:nitems){
n1 <- sample(1:50, 1)
n2 <- sample(51:100, 1)
ans <- n1 + n2
questions[i] <- paste0(n1, ' + ', n2, ' = ?')
answers[i] <- as.character(ans)
ch <- ans + sample(c(-5:-1, 1:5) * spacing[i,], 5)
ch[sample(1:5, 1)] <- ans
choices[i, ] <- as.character(ch)
}
df <- data.frame(Question=questions, Option=choices,
Type = 'radio', stringsAsFactors = FALSE)
response <- generate_pattern(mod, 1)
result <- mirtCAT(mo=mod, local_pattern = response,
design = list(customNextItem=customNextItem))
-----------------------------------------------------------
# direct manipulation of internal objects
CATdesign <- mirtCAT(df=df, mo=mod, criteria = 'MI', design_elements = TRUE)
# returns number 1 in this case, since that's the starting item
findNextItem(CATdesign)
# determine next item if item 1 and item 10 were answered correctly
CATdesign <- updateDesign(CATdesign, new_item = 1, new_response = 1)
extract.mirtCAT(CATdesign$person, 'thetas') # updated thetas
CATdesign <- updateDesign(CATdesign, new_item = 10, new_response = 1)
extract.mirtCAT(CATdesign$person, 'thetas') # updated thetas again
findNextItem(CATdesign)
findNextItem(CATdesign, all_index = TRUE) # all items rank in terms of most optimal
#-------------------------------------------------------------
## Integer programming example (e.g., shadow testing)
# find maximum information subject to constraints
# sum(xi) <= 5 ### 5 or fewer items
# x1 + x2 <= 1 ### items 1 and 2 can't be together
# x4 == 0 ### item 4 not included
# x5 + x6 == 1 ### item 5 or 6 must be included, but not both
# constraint function
constr_fun <- function(design, person, test){
# left hand side constrains
# - 1 row per constraint, and ncol must equal number of items
mo <- extract.mirtCAT(test, 'mo')
nitems <- extract.mirt(mo, 'nitems')
lhs <- matrix(0, 4, nitems)
lhs[1,] <- 1
lhs[2,c(1,2)] <- 1
lhs[3, 4] <- 1
lhs[4, c(5,6)] <- 1
# relationship direction
dirs <- c("<=", "<=", '==', '==')
#right hand side
rhs <- c(5, 1, 0, 1)
#all together
constraints <- data.frame(lhs, dirs, rhs)
constraints
}
CATdesign <- mirtCAT(df=df, mo=mod, design_elements = TRUE,
design = list(constr_fun=constr_fun))
# MI criteria value associated with each respective item
objective <- computeCriteria(CATdesign, criteria = 'MI')
# most optimal item, given constraints
findNextItem(CATdesign, objective=objective)
# all the items which solve the problem
findNextItem(CATdesign, objective=objective, all_index = TRUE)
## within a customNextItem() definition the above code would look like
# customNextItem <- function(design, person, test){
# objective <- computeCriteria(person=person, design=design, test=test,
# criteria = 'MI')
# item <- findNextItem(person=person, design=design, test=test,
# objective=objective)
# item
# }
}
Run the code above in your browser using DataLab