1 data input - long form

dta <- read.table("starter.txt", h=T)
names(dta) <- c("ID","Item","Response")
str(dta)
## 'data.frame':    1350 obs. of  3 variables:
##  $ ID      : int  1 1 1 1 1 1 1 1 1 2 ...
##  $ Item    : int  1 2 3 4 5 6 7 8 9 1 ...
##  $ Response: int  1 1 1 1 1 1 1 1 0 1 ...
head(dta)
##   ID Item Response
## 1  1    1        1
## 2  1    2        1
## 3  1    3        1
## 4  1    4        1
## 5  1    5        1
## 6  1    6        1

2 trans long to wide form

#沒有這個函數 "%>%"
library(dplyr) 
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
#沒有這個函數 "pivot_wider"
library(tidyr)
dtaW <- dta %>%
        pivot_wider(names_from = Item, values_from = Response)
names(dtaW) <- c("ID","Item1","Item2","Item3","Item4","Item5","Item6","Item7","Item8","Item9")
dtaW <- dtaW[,-1]

3 Visulization

#沒有這個函數 "descript"
library(ltm) 
## Loading required package: MASS
## 
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
## 
##     select
## Loading required package: msm
## Loading required package: polycor
plot(descript(dtaW), 
     ylim=c(0,1), 
     type='b',
     main="Item response curves")
grid()

4 Item response probabilties

knitr::kable(descript(dtaW)$perc[c(1, 7, 2, 3, 4, 5, 6, 8, 9),])
0 1 logit
Item1 0.0800000 0.9200000 2.4423470
Item7 0.1800000 0.8200000 1.5163475
Item2 0.2000000 0.8000000 1.3862944
Item3 0.2533333 0.7466667 1.0809127
Item4 0.2666667 0.7333333 1.0116009
Item5 0.3066667 0.6933333 0.8157495
Item6 0.3200000 0.6800000 0.7537718
Item8 0.4600000 0.5400000 0.1603427
Item9 0.6666667 0.3333333 -0.6931472

5 Correlated binary responses

knitr::kable(cor(dtaW))
Item1 Item2 Item3 Item4 Item5 Item6 Item7 Item8 Item9
Item1 1.0000000 0.0982946 0.0542415 0.0444554 0.1769309 0.0611080 0.1176913 0.0236666 0.0521286
Item2 0.0982946 1.0000000 0.2069345 0.2261335 0.3180732 0.1572070 0.1561738 0.2742122 0.0353553
Item3 0.0542415 0.2069345 1.0000000 0.2380182 0.2442222 0.2247635 0.1659775 0.1390151 0.0541944
Item4 0.0444554 0.2261335 0.2380182 1.0000000 0.1874462 0.1357355 0.1883526 0.2601335 0.2025407
Item5 0.1769309 0.3180732 0.2442222 0.1874462 1.0000000 0.1326535 0.1399923 0.3144546 0.0715628
Item6 0.0611080 0.1572070 0.2247635 0.1357355 0.1326535 1.0000000 0.1993889 0.0550560 0.1515848
Item7 0.1176913 0.1561738 0.1659775 0.1883526 0.1399923 0.1993889 1.0000000 0.0898275 0.1840525
Item8 0.0236666 0.2742122 0.1390151 0.2601335 0.3144546 0.0550560 0.0898275 1.0000000 0.1702513
Item9 0.0521286 0.0353553 0.0541944 0.2025407 0.0715628 0.1515848 0.1840525 0.1702513 1.0000000

6 model

#沒有這個函數 "glmer"
library(lme4)
## Loading required package: Matrix
## 
## Attaching package: 'Matrix'
## The following objects are masked from 'package:tidyr':
## 
##     expand, pack, unpack
#
dta$Item <- factor(dta$Item)
sjPlot::tab_model(m0 <- glmer(Response ~ -1 + Item + (1 | ID), data=dta, family=binomial), show.obs=F, show.ngroups=F, transform=NULL, show.se=T, show.r2=F,show.icc=F)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.28301 (tol = 0.002, component 1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, : Model is nearly unidentifiable: very large eigenvalue
##  - Rescale variables?
  Response
Predictors Log-Odds std. Error CI p
Item [1] 2.90 0.00 2.90 – 2.91 <0.001
Item [2] 1.70 0.00 1.70 – 1.71 <0.001
Item [3] 1.34 0.00 1.34 – 1.34 <0.001
Item [4] 1.21 0.21 0.79 – 1.63 <0.001
Item [5] 1.00 0.21 0.60 – 1.41 <0.001
Item [6] 0.92 0.20 0.52 – 1.33 <0.001
Item [7] 1.86 0.00 1.86 – 1.87 <0.001
Item [8] 0.20 0.00 0.20 – 0.21 <0.001
Item [9] -0.88 0.21 -1.28 – -0.48 <0.001
Random Effects
σ2 3.29
Ï„00 ID 1.16 
#
unlist(summary(m0)$varcor)/(unlist(summary(m0)$varcor)+pi^2/3)
##        ID 
## 0.2614461

7 Item Characteristic Curves

library(ltm)
coef(rm0 <- ltm::rasch(dtaW, constraint=cbind(ncol(dtaW)+1, 1)))[,1]
##      Item1      Item2      Item3      Item4      Item5      Item6      Item7 
## -2.8480443 -1.6661044 -1.3091179 -1.2271704 -0.9939141 -0.9196116 -1.8160398 
##      Item8      Item9 
## -0.1993647  0.8417333
plot(rm0)

8 ICC plot

library(eRm)
rm0 <- RM(dtaW)
eRm::plotICC(rm0, item.subset=1:5, ask=F, empICC=list("raw"), empCI=list(lty="solid"))

9 Person-Item Map

plotPImap(rm0)