#load LSAT section 7 data and compute 1 and 2 factor models
data <- expand.table(LSAT7)
(mod1 <- mirt(data, 1))
coef(mod1)
coef(mod2 <- mirt(data, 1, SE = TRUE)) #standard errors with SEM method
coef(mod3 <- mirt(data, 1, SE = TRUE, SE.type = 'BL')) #standard errors with BL method
residuals(mod1)
plot(mod1) #test information function
plot(mod1, type = 'trace') #trace lines
#estimated 3PL model for item 5 only
(mod1.3PL <- mirt(data, 1, itemtype = c('2PL', '2PL', '2PL', '2PL', '3PL')))
coef(mod1.3PL)
#two factors (exploratory)
mod2 <- mirt(data, 2)
#too few iterations, try running more using current model as new starting
# values (could also increase NCYCLES and rerun)
mod2 <- mirt(data, 2, pars = mod2values(mod2))
coef(mod2)
summary(mod2, rotate = 'oblimin') #oblimin rotation
residuals(mod2)
plot(mod2)
anova(mod1, mod2) #compare the two models
scores <- fscores(mod2) #save factor score table
scoresfull <- fscores(mod2, full.scores = TRUE, scores.only = TRUE) #factor scores for original data
#confirmatory
cmodel <- confmirt.model()
F1 = 1,4,5
F2 = 2,3
cmod <- mirt(data, cmodel)
coef(cmod)
anova(cmod, mod2)
###########
#data from the 'ltm' package in numeric format
pmod1 <- mirt(Science, 1)
plot(pmod1)
summary(pmod1)
fitIndices(pmod1) #M2 limited information statistic
#Constrain all slopes to be equal with the constrain = list() input
#first obtain parameter index
values <- mirt(Science,1, pars = 'values')
values #note that slopes are numbered 1,5,9,13, or index with values$parnum[values$name == 'a1']
(pmod1_equalslopes <- mirt(Science, 1, constrain = list(c(1,5,9,13))))
coef(pmod1_equalslopes)
anova(pmod1_equalslopes, pmod1) #significantly worse fit with almost all criteria
pmod2 <- mirt(Science, 2, technical = list(NCYCLES = 1000))
summary(pmod2)
plot(pmod2)
itemplot(pmod2, 1)
anova(pmod1, pmod2)
#unidimensional fit with a generalized partial credit and nominal model
(gpcmod <- mirt(Science, 1, 'gpcm'))
coef(gpcmod)
#for the nominal model the lowest and highest categories are assumed to be the
# theoretically lowest and highest categories that related to the latetent trait(s), however
# a custom nominal.highlow matrix can be passed to declare which item category should be
# treated as the 'highest' and 'lowest' instead
(nomod <- mirt(Science, 1, 'nominal'))
coef(nomod) #ordering of ak values suggest that the items are indeed ordinal
anova(gpcmod, nomod)
itemplot(nomod, 3)
###########
#empirical dimensionality testing that includes 'guessing'
data(SAT12)
data <- key2binary(SAT12,
key = c(1,4,5,2,3,1,2,1,3,1,2,4,2,1,5,3,4,4,1,4,3,3,4,1,3,5,1,3,1,5,4,5))
mod1 <- mirt(data, 1)
mod2 <- mirt(data, 2)
mod3 <- mirt(data, 3) #difficulty converging with reduced quadpts
anova(mod1,mod2)
anova(mod2, mod3) #negative AIC, 2 factors probably best
#with fixed guessing parameters
mod1g <- mirt(data, 1, guess = .1)
coef(mod1g)
###########
#graded rating scale example
#make some data
set.seed(1234)
a <- matrix(rep(1, 10))
d <- matrix(c(1,0.5,-.5,-1), 10, 4, byrow = TRUE)
c <- seq(-1, 1, length.out=10)
data <- simdata(a, d + c, 2000, itemtype = rep('graded',10))
#use much better start values to save iterations
sv <- mirt(data, 1, itemtype = 'grsm', pars = 'values')
sv[,'value'] <- c(as.vector(t(cbind(a,d,c))),0,1)
#also possible to edit start values with a GUI approach with
# sv <- edit(sv)
mod1 <- mirt(data, 1)
mod2 <- mirt(data, 1, itemtype = 'grsm', pars = sv)
coef(mod2)
anova(mod2, mod1) #not sig, mod2 should be preferred
###########
# 2PL nominal response model example (Suh and Bolt, 2010)
data(SAT12)
SAT12[SAT12 == 8] <- NA
head(SAT12)
#correct answer key
key <- c(1,4,5,2,3,1,2,1,3,1,2,4,2,1,5,3,4,4,1,4,3,3,4,1,3,5,1,3,1,5,4,5)
scoredSAT12 <- key2binary(SAT12, key)
mod0 <- mirt(scoredSAT12, 1)
#for first 5 items use 2PLNRM and nominal
scoredSAT12[,1:5] <- as.matrix(SAT12[,1:5])
mod1 <- mirt(scoredSAT12, 1, c(rep('nominal',5),rep('2PL', 27)))
mod2 <- mirt(scoredSAT12, 1, c(rep('2PLNRM',5),rep('2PL', 27)), key=key)
coef(mod0)$Item.1
coef(mod1)$Item.1
coef(mod2)$Item.1
itemplot(mod0, 1)
itemplot(mod1, 1)
itemplot(mod2, 1)
#compare added information from distractors
Theta <- matrix(seq(-4,4,.01))
par(mfrow = c(2,3))
for(i in 1:5){
info <- iteminfo(extract.item(mod0,i), Theta)
info2 <- iteminfo(extract.item(mod2,i), Theta)
plot(Theta, info2, type = 'l', main = paste('Information for item', i), ylab = 'Information')
lines(Theta, info, col = 'red')
}
#test information
par(mfrow = c(1,1))
plot(Theta, testinfo(mod2, Theta), type = 'l', main = 'Test information', ylab = 'Information')
lines(Theta, testinfo(mod0, Theta), col = 'red')Run the code above in your browser using DataLab