library(irtoys)
## Loading required package: sm
## Package 'sm', version 2.2-5.7: type help(sm) for summary information
## Loading required package: ltm
## Loading required package: MASS
##
## Attaching package: 'MASS'
## The following object is masked from 'package:sm':
##
## muscle
## Loading required package: msm
## Loading required package: polycor
item<-read.csv("data/item_vocab.csv",header=T)
x<-read.csv("data/data_vocab(sim).csv",na=9,header=FALSE)
j <- 10
tgf(choices=x,key=item$KEY,item=j,co=NA,label=T)#変更
j <- 16
tgf(choices=x,key=item$KEY,item=j,co=NA,label=T)#変更
u <- sco(choices=x,key=item$KEY,na.false=FALSE)
head(u)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
## [1,] 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2,] 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3,] 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [4,] 1 1 1 1 1 1 1 1 1 NA 1 1 1 1
## [5,] 1 1 1 1 1 1 1 1 0 0 1 1 1 1
## [6,] 1 1 1 1 1 1 1 1 1 0 1 0 1 0
## [,15] [,16] [,17] [,18] [,19] [,20]
## [1,] 1 1 1 0 0 0
## [2,] 1 1 1 1 1 0
## [3,] 1 1 1 1 0 0
## [4,] 1 1 1 1 NA NA
## [5,] 0 1 0 1 0 0
## [6,] 1 1 1 1 1 0
u <- as.matrix(u)
ip <-est(resp=u,model="2PL",engine="ltm",a.prior=FALSE,b.prior=FALSE,c.prior=FALSE,run.name="vocab_2PL")
ip$est
## [,1] [,2] [,3]
## Item 1 1.5452318 -1.9063028 0
## Item 2 3.3920539 -2.0412269 0
## Item 3 3.5576286 -1.8233063 0
## Item 4 3.4602794 -1.9258748 0
## Item 5 1.1927140 -1.7079383 0
## Item 6 1.7697910 -1.3088324 0
## Item 7 2.9942194 -1.9321756 0
## Item 8 1.9035798 -1.4244796 0
## Item 9 1.6359897 -1.2539017 0
## Item 10 1.0071115 -0.5094322 0
## Item 11 2.7814593 -1.2752752 0
## Item 12 0.6627609 -1.2920488 0
## Item 13 2.2250437 -1.7917125 0
## Item 14 1.5689208 -1.1384418 0
## Item 15 1.7078640 -1.1138679 0
## Item 16 0.7997789 -0.4487996 0
## Item 17 2.2422009 -1.0952683 0
## Item 18 1.9465138 -1.6597761 0
## Item 19 0.7002251 0.9736538 0
## Item 20 1.0139158 1.1448633 0
pfit <- api(u,ip$est)
summary(pfit)
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## -3.3672 -0.0423 0.5186 0.3314 0.7539 2.1073 6
j <- 10
itf(u,ip$est,j)
## Statistic DF P-value
## 2.995493e+01 7.000000e+00 9.678448e-05
IRTでは、ある項目を除外すると他の項目パラメータの推定値や適合度も変化する。項目を除外するか保持するかは総合的な判断が必要。
par(family = "HiraKakuProN-W3")
plot(ip$est[,1:2],type="n",xlab="識別力",ylab="困難度")
text(ip$est[,1],ip$est[,2])
困難度の高い問題は識別力が低い傾向がある。
values.irf <- irf(ip$est)
plot(values.irf,co=NA,label=T)
values.iif <- iif(ip$est)
plot(values.iif,co=NA,label=T)
set.seed(1620)
t0 <- rnorm(100,0,1)#能力パラメータ
head(ip$est)
## [,1] [,2] [,3]
## Item 1 1.545232 -1.906303 0
## Item 2 3.392054 -2.041227 0
## Item 3 3.557629 -1.823306 0
## Item 4 3.460279 -1.925875 0
## Item 5 1.192714 -1.707938 0
## Item 6 1.769791 -1.308832 0
u.sim <- sim(ip$est,t0)
head(u.sim)
## Item 1 Item 2 Item 3 Item 4 Item 5 Item 6 Item 7 Item 8 Item 9 Item 10
## [1,] 1 1 1 1 1 1 1 1 0 0
## [2,] 1 1 1 1 1 1 1 1 1 1
## [3,] 1 1 1 1 0 1 1 1 1 1
## [4,] 1 1 1 1 1 1 1 1 1 1
## [5,] 1 1 1 1 1 1 1 1 1 1
## [6,] 1 1 1 1 1 1 1 1 1 0
## Item 11 Item 12 Item 13 Item 14 Item 15 Item 16 Item 17 Item 18 Item 19
## [1,] 0 0 1 0 1 1 1 1 0
## [2,] 1 0 1 1 1 1 1 1 0
## [3,] 1 1 1 1 1 0 1 1 0
## [4,] 1 1 1 1 1 1 1 1 1
## [5,] 1 1 1 1 1 0 1 1 0
## [6,] 1 1 1 1 1 1 1 1 1
## Item 20
## [1,] 1
## [2,] 0
## [3,] 0
## [4,] 1
## [5,] 0
## [6,] 0
dim(u.sim)
## [1] 100 20
t.mle <- mlebme(resp=u.sim,ip=ip$est,method="ML")
head(t.mle)
## est sem n
## [1,] -0.82206957 0.3334525 20
## [2,] 0.52018780 0.7397520 20
## [3,] -0.01460434 0.5467758 20
## [4,] 3.99992410 2.6507990 20
## [5,] 0.44795547 0.7127015 20
## [6,] 0.73630467 0.8208850 20