1 パッケージ.

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

1.1 データ.

item<-read.csv("data/item_vocab.csv",header=T)
x<-read.csv("data/data_vocab(sim).csv",na=9,header=FALSE)

2 語彙テストデータの項目分析.

2.1 トレースライン.

2.1.1 項目10.

j <- 10
tgf(choices=x,key=item$KEY,item=j,co=NA,label=T)#変更

2.1.2 項目16.

j <- 16
tgf(choices=x,key=item$KEY,item=j,co=NA,label=T)#変更

3 項目パラメータの推定

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

4 適合度のチェック.

4.1 個人適合度

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

4.2 項目適合度

  • 能力値に基づいて受験者をいくつかの群に分ける.
  • 各群の正答率と理論正答率のズレをカイ二乗値で評価する.
j <- 10
itf(u,ip$est,j)

##    Statistic           DF      P-value 
## 2.995493e+01 7.000000e+00 9.678448e-05

IRTでは、ある項目を除外すると他の項目パラメータの推定値や適合度も変化する。項目を除外するか保持するかは総合的な判断が必要。

5 項目/テスト特性の視覚化

5.1 推定値の要約.

par(family = "HiraKakuProN-W3")
plot(ip$est[,1:2],type="n",xlab="識別力",ylab="困難度")
text(ip$est[,1],ip$est[,2])

困難度の高い問題は識別力が低い傾向がある。

5.2 項目特性関数irf

values.irf <- irf(ip$est)
plot(values.irf,co=NA,label=T)

5.3 項目情報関数iif

values.iif <- iif(ip$est)
plot(values.iif,co=NA,label=T)

5.4 テスト特性曲線.

5.5 テスト情報関数.

5.6 シミュレーション

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

5.6.1 能力の推定

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