Module 1: Item Response Theory w. Notes

library(ltm)
library(mirt)

data("LSAT")
head(LSAT)

LSAT.model<-ltm(LSAT~z1, IRT.param=TRUE)

coef(LSAT.model)

           Dffclt    Dscrmn
Item 1 -3.3597341 0.8253715
Item 2 -1.3696497 0.7229499
Item 3 -0.2798983 0.8904748
Item 4 -1.8659189 0.6885502
Item 5 -3.1235725 0.6574516

#Items 1 and 5 are easy. Most people are getting them right. Item 3 is close to the mean. There are no items so far, that are difficult. Discrimination tells us how often they are getting them correct. Disrimination closer to 1 is better. These five items are easy.

plot(LSAT.model, type = "ICC")

#Very far away from what should be measured for traits. Item 3 is the best. We want items to be more logit curved.

plot(LSAT.model, type = "ICC", items = 3)

factor.scores(LSAT.model)

Call:
ltm(formula = LSAT ~ z1, IRT.param = TRUE)

Scoring Method: Empirical Bayes

Factor-Scores for observed response patterns:

NA

#Here it shows patterns. The number of observations for each pattern. Here it shows where the participants responded, and determine an individuals latent trait scores Score

LSAT.model2 <- tpm(LSAT, type="latent.trait", IRT.param=TRUE)

#Does adding the guessing parameter help?

coef(LSAT.model2)

           Gussng     Dffclt    Dscrmn
Item 1 0.03738668 -3.2964761 0.8286287
Item 2 0.07770994 -1.1451487 0.7603748
Item 3 0.01178206 -0.2490144 0.9015777
Item 4 0.03529306 -1.7657862 0.7006545
Item 5 0.05315665 -2.9902046 0.6657969

#These items are low, pretty close to 0. Not very hard, but not very easy to guess.

factor.scores(LSAT.model2)

Call:
tpm(data = LSAT, type = "latent.trait", IRT.param = TRUE)

Scoring Method: Empirical Bayes

Factor-Scores for observed response patterns:

NA

anova(LSAT.model, LSAT.model2)

either the two models are not nested or the model represented by 'object2' fell on a local maxima.

 Likelihood Ratio Table

NA

#Go with the lower AIC. Adding the guess parameter does not help.

#Below is the example from the text.

library("MPsychoR")
library("mirt")
data("zareki")
zarsub <- zareki[, grep("subtr", colnames(zareki))]

library("Gifi")

package 㤼㸱Gifi㤼㸲 was built under R version 4.0.5

prinzar <- princals(zarsub)
plot(prinzar, main = "Zareki Loadings")

#If the arrows were pointing in the same direction, then they would be be considered unidimension. In the figure, subtr5 would be a concern, as it separtes itself from the rest.

fitifa1 <- mirt(zarsub, 1, verbose = FALSE)
fitifa2 <- mirt(zarsub, 2, verbose = FALSE, TOL = 0.001)
anova(fitifa1, fitifa2, verbose = FALSE)

## AIC AICc SABIC BIC logLik X2 df
## 1 2558.405 2560.084 2568.959 2619.715 -1263.202 NaN NaN
## 2 2561.249 2564.732 2576.422 2649.383 -1257.625 11.155 7
## p
## 1 NaN
## 2 0.132

library("eRm")

package 㤼㸱eRm㤼㸲 was built under R version 4.0.5
Attaching package: 㤼㸱eRm㤼㸲

The following objects are masked from 㤼㸱package:mirt㤼㸲:

    itemfit, personfit

fitrasch1 <- RM(zarsub)
fitrasch1

Results of RM estimation: 

Call:  RM(X = zarsub) 

Conditional log-likelihood: -646.9202 
Number of iterations: 12 
Number of parameters: 7 

Item (Category) Difficulty Parameters (eta):
             subtr2    subtr3     subtr4
Estimate -0.7552998 1.6808330 -0.4774069
Std.Err   0.1619353 0.1310474  0.1515977
            subtr5    subtr6    subtr7
Estimate -0.280543 0.4163264 1.5508677
Std.Err   0.145557 0.1316531 0.1296646
             subtr8
Estimate -0.1884142
Std.Err   0.1430740

round(fitrasch1$betapar, 3)

beta subtr1 beta subtr2 beta subtr3 beta subtr4 
      1.946       0.755      -1.681       0.477 
beta subtr5 beta subtr6 beta subtr7 beta subtr8 
      0.281      -0.416      -1.551       0.188 

round(sort(-fitrasch1$betapar), 3)

beta subtr1 beta subtr2 beta subtr4 beta subtr5 
     -1.946      -0.755      -0.477      -0.281 
beta subtr8 beta subtr6 beta subtr7 beta subtr3 
     -0.188       0.416       1.551       1.681 

timecat <- factor(zareki$time <= median(zareki$time),
labels = c("fast", "slow"))
fitLR <- LRtest(fitrasch1, timecat)
fitLR

Andersen LR-test: 
LR-value: 24.097 
Chi-square df: 7 
p-value:  0.001 

Waldtest(fitrasch1, timecat)

Wald test on item level (z-values):

            z-statistic p-value
beta subtr1      -0.360   0.719
beta subtr2       0.237   0.813
beta subtr3      -2.342   0.019
beta subtr4       0.730   0.465
beta subtr5       4.199   0.000
beta subtr6      -0.548   0.584
beta subtr7      -1.529   0.126
beta subtr8      -0.469   0.639

plotGOF(fitLR, ctrline = list(col = "gray"), conf = list())

fitrasch2 <- RM(zarsub[, -5])
LRtest(fitrasch2, timecat)

Andersen LR-test: 
LR-value: 5.715 
Chi-square df: 6 
p-value:  0.456 

set.seed(123)
T1 <- NPtest(as.matrix(zarsub[, -5]), n = 1000, method = "T1")
T1

Nonparametric RM model test: T1 (local
    dependence - increased inter-item
    correlations)
    (counting cases with equal responses on both items)
Number of sampled matrices: 1000 
Number of Item-Pairs tested: 21 
Item-Pairs with one-sided p < 0.05 
none

round(sort(-fitrasch2$betapar), 2)

beta subtr1 beta subtr2 beta subtr4 beta subtr8 
      -2.08       -0.83       -0.54       -0.24 
beta subtr6 beta subtr7 beta subtr3 
       0.39        1.58        1.72 

plotjointICC(fitrasch2, xlab = "Subtraction Trait",
main = "ICCs Subtraction Items")

zarppar <- person.parameter(fitrasch2)
zareki$theta <- zarppar$theta.table[,1]
summary(aov(theta ~ class, data = zareki))

             Df Sum Sq Mean Sq F value   Pr(>F)
class         2  129.1   64.55    31.8 2.23e-13
Residuals   338  686.2    2.03                 
               
class       ***
Residuals      
---
Signif. codes:  
0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1