This example demonstrates how a multi-unidimensional IRT test can be presented in blocks of items at a time. This generally makes presentation more smooth, however you still will get the general benefits of using a MIRT model as opposed to separate unidimensional models (especially after one block has been completed).
The following code-block defines 100 items for a two factor math test measuring addition and multiplication.
library('mirtCAT')
## Loading required package: mirt
## Loading required package: stats4
## Loading required package: lattice
## Loading required package: methods
## Loading required package: shiny
options(stringsAsFactors = FALSE)
# define population IRT parameters
set.seed(1234)
nitems <- 100
itemnames <- paste0("Item.", 1:nitems)
a <- matrix(c(rlnorm(nitems/2, 0.2, 0.3), numeric(nitems), rlnorm(nitems/2, 0.2, 0.3)), nitems)
head(a) #first 6
## [,1] [,2]
## [1,] 0.8503394 0
## [2,] 1.3274088 0
## [3,] 1.6910208 0
## [4,] 0.6042850 0
## [5,] 1.3892130 0
## [6,] 1.4216480 0
tail(a) #last 6
## [,1] [,2]
## [95,] 0 1.0526649
## [96,] 0 1.3588858
## [97,] 0 0.8690258
## [98,] 0 1.5895661
## [99,] 0 1.6353797
## [100,] 0 2.3078933
a[48:53, ] #middle
## [,1] [,2]
## [1,] 0.8389571 0.0000000
## [2,] 1.0437829 0.0000000
## [3,] 1.0522650 0.0000000
## [4,] 0.0000000 0.7104836
## [5,] 0.0000000 1.0257020
## [6,] 0.0000000 0.8757568
d <- matrix(rnorm(nitems))
pars <- data.frame(a, d)
colnames(pars) <- c("a1", "a2", "d")
trait_cov <- matrix(c(1, 0.5, 0.5, 1), 2, 2)
# create mirt_object
mod <- generate.mirt_object(pars, itemtype = "2PL", latent_covariance = trait_cov)
# math items definitions addition for one factor and multiplication for the other
questions <- answers <- character(nitems)
options <- matrix("", nitems, 5)
spacing <- floor(d - min(d)) + 1 #easier items have more variation
for (i in 1:nitems) {
if (i < 50) {
# addition
n1 <- sample(1:100, 1)
n2 <- sample(101:200, 1)
ans <- n1 + n2
questions[i] <- paste0(n1, " + ", n2, " = ?")
} else {
# multiplication
m1 <- sample(1:50, 1)
m2 <- sample(1:50, 1)
ans <- n1 + n2 + m1 * m2
questions[i] <- paste0(m1, " * ", m2, " = ?")
}
answers[i] <- as.character(ans)
ch <- ans + sample(c(-5:-1, 1:5) * spacing[i, ], 5)
ch[sample(1:5, 1)] <- ans
options[i, ] <- as.character(ch)
}
# load list of items and their answers
df <- data.frame(Question = questions, Option = options, Answer = answers, Type = "radio")
set.seed(1)
pat <- generate_pattern(mo = mod, Theta = c(-1, 1), df = df)
head(pat)
## [1] "207" "208" "221" "214" "244" "283"
The idea for setting up a multi-unidimensional item selection mechanism is to use the customNextItem()
input so that the subset argument to findNextItem() can be manipulated. Here we define two blocks to select
from: a block from items 1:50, and 51:100. This means that when the first block is used only items 1:50 can
be selected as the next item. Furthermore, we can do some manual checks to decide when the second block
should begin. Here items will be selected until 20 items appear in each block.
# standard MCAT
# res <- mirtCAT(df = df, mo = mod, criteria = "Drule", local_pattern = pat)
# custom. Often useful to set up a browser first for easier editing
customNextItem <- function(design, person, test){
browser()
}
#res <- mirtCAT(df = df, mo = mod, local_pattern = pat,
# design = list(customNextItem=customNextItem))
customNextItem <- function(design, person, test){
block1 <- 1:50
block2 <- 51:100
total_answered <- sum(!is.na(extract.mirtCAT(person, 'items_answered')))
if(total_answered < 20){ #first 20 items block1
block <- block1
} else if(total_answered < 40){ #next 20 block2
block <- block2
} else return(NA) # terminate when both item blocks have 20 items answered
ret <- findNextItem(person=person, design=design, test=test,
subset=block, criteria = 'Arule')
ret
}
res <- mirtCAT(df = df, mo = mod, local_pattern = pat,
design = list(customNextItem=customNextItem,
min_SEM = 0)) #disable other termination criteria
Notice that the order of the results is correct, and that measurement of the second latent trait really only begins after the 20th item has been administered.
print(res$items_answered[1:20])
## [1] 1 20 31 24 3 15 14 16 39 6 41 34 49 50 21 32 9 23 19 25
print(res$items_answered[21:40])
## [1] 75 62 93 100 59 57 69 98 68 61 74 99 66 91 76 63 88
## [18] 73 94 79
plot(res)
To run the actual GUI, simply remove the local_pattern argument to let mirtCAT() know that the responses
must be collected in real-time.
res <- mirtCAT(df = df, mo = mod,
design = list(customNextItem=customNextItem,
min_SEM = 0)) #disable other termination criteria