item<-read.csv("data/item_vocab.csv",header=T)
head(item)
ITEMID | KEY | STEM |
---|---|---|
1 | 2 | 「ひときわ」めだつ |
2 | 3 | 「架空の話」 |
3 | 4 | 「発端」 |
4 | 3 | 「服用」 |
5 | 5 | 本を「発行する」 |
6 | 4 | 「巻頭」 |
str(item)
## 'data.frame': 20 obs. of 3 variables:
## $ ITEMID: int 1 2 3 4 5 6 7 8 9 10 ...
## $ KEY : int 2 3 4 3 5 4 2 3 5 4 ...
## $ STEM : chr "「ひときわ」めだつ" "「架空の話」" "「発端」" "「服用」" ...
x<-read.csv("data/data_vocab(sim).csv",na=9,header=FALSE)
head(x)
V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 | V9 | V10 | V11 | V12 | V13 | V14 | V15 | V16 | V17 | V18 | V19 | V20 |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
2 | 3 | 4 | 3 | 5 | 4 | 2 | 3 | 5 | 4 | 5 | 5 | 4 | 4 | 1 | 4 | 4 | 3 | 1 | 2 |
2 | 3 | 4 | 3 | 5 | 4 | 2 | 3 | 5 | 4 | 5 | 5 | 4 | 4 | 1 | 4 | 4 | 2 | 3 | 4 |
2 | 3 | 4 | 3 | 5 | 4 | 2 | 3 | 5 | 4 | 5 | 5 | 4 | 4 | 1 | 4 | 4 | 2 | 2 | 4 |
2 | 3 | 4 | 3 | 5 | 4 | 2 | 3 | 5 | NA | 5 | 5 | 4 | 4 | 1 | 4 | 4 | 2 | NA | NA |
2 | 3 | 4 | 3 | 5 | 4 | 2 | 3 | 3 | 3 | 5 | 5 | 4 | 4 | 3 | 4 | 5 | 2 | 1 | 2 |
2 | 3 | 4 | 3 | 5 | 4 | 2 | 3 | 5 | 2 | 5 | 1 | 4 | 5 | 1 | 4 | 4 | 2 | 3 | 2 |
dim(x)
## [1] 1262 20
受験者は1262人、問題数は20 である。
u <- x
for (j in 1:20)
u[,j] <- (x[,j]==item$KEY[j])*1#上書き
head(u)
V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 | V9 | V10 | V11 | V12 | V13 | V14 | V15 | V16 | V17 | V18 | V19 | V20 |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 0 | 0 | 0 |
1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 0 |
1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 0 | 0 |
1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | NA | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | NA | NA |
1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 0 | 0 | 1 | 1 | 1 | 1 | 0 | 1 | 0 | 1 | 0 | 0 |
1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 1 | 1 | 1 | 1 | 0 |
CTTでは、項目ごとの正答率が困難度を表す。
colMeans(u,na.rm=T)
## V1 V2 V3 V4 V5 V6 V7 V8
## 0.8954041 0.9611727 0.9453249 0.9532488 0.8351823 0.8248811 0.9484945 0.8526149
## V9 V10 V11 V12 V13 V14 V15 V16
## 0.8058637 0.6039683 0.8589540 0.6854200 0.9175911 0.7789223 0.7836767 0.5776545
## V17 V18 V19 V20
## 0.8065028 0.8898574 0.3502780 0.2752586
CTTでは、テスト得点と項目得点の相関係数(I-T相関)が識別力を表す。
y <- rowSums(u,na.rm=T)
str(y)
## num [1:1262] 17 19 18 17 14 16 16 15 19 16 ...
summary(y)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 14.00 17.00 15.55 18.00 20.00
cor(u,y,use="pairwise.complete.obs")
## [,1]
## V1 0.4825636
## V2 0.5531612
## V3 0.6131364
## V4 0.5761039
## V5 0.4692376
## V6 0.5726764
## V7 0.5641705
## V8 0.5670992
## V9 0.5705133
## V10 0.4576156
## V11 0.6596868
## V12 0.3820410
## V13 0.5571807
## V14 0.5550026
## V15 0.5796328
## V16 0.4204063
## V17 0.6360654
## V18 0.5590357
## V19 0.3477672
## V20 0.3727212
クロンバック
\(\alpha = \dfrac{m}{m-1} \left(1 -
\frac{\sum_{i = 1}^m{{\sigma_i}^2}}{{\sigma_x}^2} \right)\)
\(\begin{split} \alpha'&=\dfrac{m}{m-1}\left(1-\dfrac{m}{m+{m(m-1)}\overline{R}}\right) =\dfrac{m}{m-1}\left(1-\dfrac{1}{1+{(m-1)}\overline{R}}\right)\\ &=\dfrac{m}{m-1}\left(\dfrac{(m-1)\overline{R}}{1+{(m-1)}\overline{R}}\right)=\dfrac{m\overline{R}}{1+{(m-1)}\overline{R}} \end{split}\).
ノンパラメトリックIRTモデル.
#head(x)
item
ITEMID | KEY | STEM |
---|---|---|
1 | 2 | 「ひときわ」めだつ |
2 | 3 | 「架空の話」 |
3 | 4 | 「発端」 |
4 | 3 | 「服用」 |
5 | 5 | 本を「発行する」 |
6 | 4 | 「巻頭」 |
7 | 2 | 「近ごろのようす」 |
8 | 3 | 「終日」 |
9 | 5 | 「至難」 |
10 | 4 | 「割愛」 |
11 | 5 | 「晩夏」 |
12 | 5 | 「口実」 |
13 | 4 | 返事を「うながす」 |
14 | 4 | 「火急」 |
15 | 1 | 「いさめる」 |
16 | 4 | 「自分の意見などをあくまでも曲げない」 |
17 | 4 | 仕事を「課する」 |
18 | 2 | 「いてつく」 |
19 | 3 | 「捲土重来(けんどちょうらい)」 |
20 | 1 | 「ひさぐ」 |
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
library(irtoys)
library(plink)
## Loading required package: lattice
##
## Attaching package: 'plink'
## The following objects are masked from 'package:ltm':
##
## gpcm, grm
library(lattice)
library(sm)
#フォームTの項目パラメタの読み込み
paramT <- read.csv("data/paramT.csv")
head(paramT,5)
a | b | c |
---|---|---|
0.8235682 | -0.7774502 | 0 |
1.4799587 | 0.1996423 | 0 |
0.9487968 | 0.4171269 | 0 |
1.1796335 | -1.0853898 | 0 |
0.5040311 | -0.0541100 | 0 |
str(paramT)
## 'data.frame': 20 obs. of 3 variables:
## $ a: num 0.824 1.48 0.949 1.18 0.504 ...
## $ b: num -0.7775 0.1996 0.4171 -1.0854 -0.0541 ...
## $ c: int 0 0 0 0 0 0 0 0 0 0 ...
#フォームFの項目パラメタの読み込み
paramF <- read.csv("data/paramF.csv")
head(paramF,5)
a | b | c |
---|---|---|
0.6936499 | -2.7364145 | 0 |
0.8282025 | -0.2048634 | 0 |
0.7362474 | -0.9427309 | 0 |
1.1313340 | -0.4131648 | 0 |
0.8762318 | -0.9030303 | 0 |
#項目パラメタ行列を要素としてもつリストの作成
pm <- list(paramT,paramF)
pm
## [[1]]
## a b c
## 1 0.8235682 -0.77745018 0
## 2 1.4799587 0.19964226 0
## 3 0.9487968 0.41712686 0
## 4 1.1796335 -1.08538984 0
## 5 0.5040311 -0.05410996 0
## 6 0.9490341 -2.13148039 0
## 7 0.6907286 0.07438215 0
## 8 0.6572211 -0.79298132 0
## 9 1.1863945 -0.02735968 0
## 10 1.2571493 -0.53645166 0
## 11 0.5816125 1.86097028 0
## 12 1.3900551 -0.68467007 0
## 13 0.6074409 -2.47362082 0
## 14 1.1359687 -1.40995586 0
## 15 0.6955948 0.68738854 0
## 16 0.6181592 0.07021495 0
## 17 0.8582456 0.97570347 0
## 18 1.0994677 -1.80039250 0
## 19 1.0843885 -0.56542585 0
## 20 1.3439980 0.74135662 0
##
## [[2]]
## a b c
## 1 0.6936499 -2.7364145 0
## 2 0.8282025 -0.2048634 0
## 3 0.7362474 -0.9427309 0
## 4 1.1313340 -0.4131648 0
## 5 0.8762318 -0.9030303 0
## 6 0.5135628 1.5300670 0
## 7 1.4398635 -0.9700504 0
## 8 0.7083542 -2.5547472 0
## 9 1.1950008 -1.6250154 0
## 10 0.7490940 0.4084395 0
## 11 0.5377512 -0.2109810 0
## 12 0.8982261 0.6895927 0
## 13 1.5789366 -1.8544480 0
## 14 1.6052604 -0.6923736 0
## 15 1.6280084 0.5071047 0
## 16 0.9557028 1.9167882 0
## 17 1.3299653 -0.9114109 0
## 18 0.6898675 -0.6361406 0
## 19 0.8855576 0.5023008 0
## 20 1.8478393 0.5502800 0
#両フォームの能力パラメタの読み込み
pretheta <- read.csv("data/paramtheta.csv")
thetaT <- pretheta[,1]
thetaF <- pretheta[,2]
par(mfrow=c(1,2))
hist(thetaT,prob=T)
hist(thetaF,prob=T)
#能力パラメタのリスト化(能力パラメタの等化が必要な場合)
theta <- list(thetaT,thetaF)
head(theta[[1]])
## [1] 2.3005819 0.3514705 -0.9083449 1.3164516 -0.4426814 -0.6703530
head(theta[[2]])
## [1] 2.5421997 0.4405686 -1.3060420 1.6947901 -0.4900907 -0.6711037
横軸の能力パラメータは標準化された能力因子であるので、どちらも(-3,3)の範囲になっている。
JT <- 20 # フォームTの項目数
JF <- 20 # フォームFの項目数
comx<- data.frame("T"=6:20,"F"=1:15)
comx
T | F |
---|---|
6 | 1 |
7 | 2 |
8 | 3 |
9 | 4 |
10 | 5 |
11 | 6 |
12 | 7 |
13 | 8 |
14 | 9 |
15 | 10 |
16 | 11 |
17 | 12 |
18 | 13 |
19 | 14 |
20 | 15 |
rescat <- list(rep(2,JT),rep(2,JF))
rescat
## [[1]]
## [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##
## [[2]]
## [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
pmT <- as.poly.mod(n=JT,model="drm",items=1:JT)
pmT
## An object of class "poly.mod"
## Slot "model":
## [1] "drm"
##
## Slot "items":
## $drm
## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
pmF <- as.poly.mod(n=JF,model="drm",items=1:JF)
pmF
## An object of class "poly.mod"
## Slot "model":
## [1] "drm"
##
## Slot "items":
## $drm
## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
p.mod <- list(pmT,pmF)
p.mod
## [[1]]
## An object of class "poly.mod"
## Slot "model":
## [1] "drm"
##
## Slot "items":
## $drm
## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
##
##
##
## [[2]]
## An object of class "poly.mod"
## Slot "model":
## [1] "drm"
##
## Slot "items":
## $drm
## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
res <- as.irt.pars(x=pm,common=comx,cat=rescat,
poly.mod=p.mod)
out <- plink(x=res,rescale="MS",ability=theta,
base.grp=1)
summary(out)
## ------- group2/group1* -------
## Linking Constants
##
## A B
## Mean/Mean 1.068120 0.309309
## Mean/Sigma 1.013564 0.273038
## Haebara 1.027976 0.273266
## Stocking-Lord 1.031035 0.285172
##
## Ability Descriptive Statistics
##
## group1 group2
## Mean 0.0504 0.2923
## SD 1.1313 1.1597
## Min -2.5125 -2.4236
## Max 2.3006 2.8497
link.pars(out)
## $group1
## [,1] [,2] [,3]
## [1,] 0.8235682 -0.77745018 0
## [2,] 1.4799587 0.19964226 0
## [3,] 0.9487968 0.41712686 0
## [4,] 1.1796335 -1.08538984 0
## [5,] 0.5040311 -0.05410996 0
## [6,] 0.9490341 -2.13148039 0
## [7,] 0.6907286 0.07438215 0
## [8,] 0.6572211 -0.79298132 0
## [9,] 1.1863945 -0.02735968 0
## [10,] 1.2571493 -0.53645166 0
## [11,] 0.5816125 1.86097028 0
## [12,] 1.3900551 -0.68467007 0
## [13,] 0.6074409 -2.47362082 0
## [14,] 1.1359687 -1.40995586 0
## [15,] 0.6955948 0.68738854 0
## [16,] 0.6181592 0.07021495 0
## [17,] 0.8582456 0.97570347 0
## [18,] 1.0994677 -1.80039250 0
## [19,] 1.0843885 -0.56542585 0
## [20,] 1.3439980 0.74135662 0
##
## $group2
## [,1] [,2] [,3]
## [1,] 0.6843671 -2.50049327 0
## [2,] 0.8171191 0.06539582 0
## [3,] 0.7263946 -0.68248014 0
## [4,] 1.1161940 -0.14573097 0
## [5,] 0.8645056 -0.64224098 0
## [6,] 0.5066901 1.82385878 0
## [7,] 1.4205946 -0.71017019 0
## [8,] 0.6988747 -2.31636182 0
## [9,] 1.1790087 -1.37401911 0
## [10,] 0.7390692 0.68701757 0
## [11,] 0.5305547 0.05919524 0
## [12,] 0.8862056 0.97198435 0
## [13,] 1.5578066 -1.60656375 0
## [14,] 1.5837780 -0.42872692 0
## [15,] 1.6062216 0.78702105 0
## [16,] 0.9429131 2.21582553 0
## [17,] 1.3121671 -0.65073523 0
## [18,] 0.6806354 -0.37173119 0
## [19,] 0.8737066 0.78215204 0
## [20,] 1.8231106 0.83078201 0
#フォームFの等化前項目パラメタと等化後項目パラメタの比較
equateparam <- cbind(link.pars(out)[[2]],paramF)
colnames(equateparam) <- c(paste0("等化後",c("a","b","c")),
paste0("等化前",c("a","b","c")))
head(equateparam)
等化後a | 等化後b | 等化後c | 等化前a | 等化前b | 等化前c |
---|---|---|---|---|---|
0.6843671 | -2.5004933 | 0 | 0.6936499 | -2.7364145 | 0 |
0.8171191 | 0.0653958 | 0 | 0.8282025 | -0.2048634 | 0 |
0.7263946 | -0.6824801 | 0 | 0.7362474 | -0.9427309 | 0 |
1.1161940 | -0.1457310 | 0 | 1.1313340 | -0.4131648 | 0 |
0.8645056 | -0.6422410 | 0 | 0.8762318 | -0.9030303 | 0 |
0.5066901 | 1.8238588 | 0 | 0.5135628 | 1.5300670 | 0 |
link.ability(out) #能力パラメタ
## $group1
## [1] 2.300581855 0.351470489 -0.908344926 1.316451557 -0.442681422
## [6] -0.670353040 0.173006072 0.475440458 2.296876237 -0.863990424
## [11] 0.452188816 -1.536988031 -0.434656795 0.006139786 0.477823516
## [16] 0.646069873 -1.229310168 1.488837511 0.671549757 0.998304430
## [21] -1.282438326 1.336051534 0.692976884 -2.512515824 0.645898498
## [26] 0.559568706 2.027548371 1.340145992 1.286602838 -1.057109358
## [31] -0.172594134 -0.290922555 -0.913281614 0.664547880 0.969736098
## [36] -0.179154827 -0.692934199 0.490560243 -0.370426214 0.712006618
## [41] -0.564688804 -0.384532764 1.111401239 -0.250923448 -1.131197730
## [46] -1.446580461 1.589429640 0.978381743 -2.320455080 -0.534119038
## [51] 0.093715863 0.849666051 0.652537065 0.090070769 1.088445261
## [56] 0.642246082 0.981971641 0.344282008 1.320813580 -2.448326030
## [61] -0.507813807 0.033640523 2.120044662 1.430538482 -2.426986879
## [66] 1.131930495 -0.209885086 1.230970968 0.809685607 -0.814427905
## [71] -0.524818283 0.609579653 -0.926794239 0.626950948 0.329053549
## [76] 0.867391764 0.552755333 -1.677640439 -1.033272438 -1.461700215
## [81] -0.480708353 0.882404018 -1.269185348 -1.996944032 2.282984519
## [86] -0.376894827 -1.629116927 1.706774755 0.565526268 1.476068256
## [91] -0.527736874 -0.583519488 -1.429734141 0.822872367 -1.041281595
## [96] -0.942136179 0.516953605 -1.396086381 -0.746583520 -0.439422990
##
## $group2
## [1] 2.84972006 0.71958243 -1.05071919 1.99081619 -0.22370024 -0.40716859
## [7] -0.17167033 1.22796262 2.63382974 -0.42506138 0.73573264 -1.23760648
## [13] -0.02956701 0.55049625 1.05715461 0.85323106 -1.05817476 1.21893335
## [19] 0.37586055 1.63974016 -1.00934114 1.47359099 1.05553187 -1.90263867
## [25] 0.55310921 0.49327197 2.34369012 1.38920976 1.38728960 -0.83657243
## [31] 0.43956110 0.10417957 -1.32083048 0.92980799 1.43146661 -0.04899259
## [37] -0.53829139 0.91659804 0.32408504 1.01405783 0.04679022 0.24155201
## [43] 1.51441351 0.26054072 -0.94330551 -0.91058807 1.90921735 1.13680219
## [49] -2.08804515 -0.82139903 0.15773357 1.08792563 0.69742024 0.26121735
## [55] 1.45959631 0.41585248 0.69917338 0.57126408 2.10775854 -1.84270612
## [61] -0.12397921 0.43566216 2.24203705 1.84805309 -1.75435973 1.27304572
## [67] -0.39665505 1.26133321 0.98213635 -0.58616291 -0.33881111 0.74011837
## [73] -0.82760957 0.96778546 0.95261622 1.13601517 0.98766136 -1.49590485
## [79] -0.14362406 -1.62726854 -0.37423960 1.33233530 -1.43304237 -2.42358767
## [85] 2.31492648 -0.36144135 -1.66058919 1.49507520 0.88498842 1.34004486
## [91] -0.23004026 -0.52123006 -0.87744284 1.18890562 -0.89434286 -1.03067350
## [97] 1.21005797 -1.00636923 -0.67415775 0.01046413
#フォームFの等化前能力パラメタと等化後能力パラメタの比較
eqtheta <- cbind(link.ability(out)[[2]],thetaF)
colnames(eqtheta) <- c("等化後theta","等化前theta")
head(eqtheta)
## 等化後theta 等化前theta
## [1,] 2.8497201 2.5421997
## [2,] 0.7195824 0.4405686
## [3,] -1.0507192 -1.3060420
## [4,] 1.9908162 1.6947901
## [5,] -0.2237002 -0.4900907
## [6,] -0.4071686 -0.6711037
par(mfrow=c(1,2))
hist(eqtheta[,2],prob=T,xlim=c(-3,3))
hist(eqtheta[,1],prob=T,xlim=c(-3,3))
plot(eqtheta)
# フォームTの項目パラメタの読み込み
paramT <- read.csv("data/pgrmT.csv")
paramT2 <- read.csv("data/pgrmT2.csv")
# フォームFの項目パラメタの読み込み
paramF <- read.csv("data/pgrmF.csv")
paramF2 <- read.csv("data/pgrmF2.csv")
# 項目パラメタのリスト化
pm <- list(paramT,paramF)
pm2 <- list(paramT2,paramF2)
#共通項目の指定
comx <- data.frame("T"=6:20,"F"=1:15)
#項目数の指定
JT <- 20
JF <- 20
#各項目のカテゴリ数の指定
rescat <- list(rep(4,JT),rep(4,JF))
#項目反応モデルの指定
pmT <- as.poly.mod(n=JT,model="grm",items=1:JT)
pmF <- as.poly.mod(n=JF,model="grm",items=1:JF)
#irt.parsオブジェクトの作成
res <- as.irt.pars(x=pm,common=comx,cat=rescat,
poly.mod=list(pmT,pmF),location=FALSE)
out <- plink(res,rescale="MS",base.grp=1)
summary(out)
## ------- group2/group1* -------
## Linking Constants
##
## A B
## Mean/Mean 0.999203 0.483078
## Mean/Sigma 1.000900 0.484094
## Haebara 0.998447 0.482014
## Stocking-Lord 1.000406 0.483557
link.pars(out)
## $group1
## b1 b2 b3
## [1,] 1.1873582 -2.495332 0.59924015 2.356994
## [2,] 0.7664458 -1.906957 -0.54211197 1.863036
## [3,] 1.3390791 -1.533934 0.12388197 1.218443
## [4,] 1.0394187 -1.077727 0.10785853 1.802290
## [5,] 0.9806650 -1.970519 -0.27742341 2.771048
## [6,] 1.3311846 -2.390960 -0.51818141 2.187834
## [7,] 0.8947741 -2.504355 1.14339000 1.591959
## [8,] 0.9069090 -1.947751 1.18527240 2.309181
## [9,] 1.1764619 -2.142846 0.01122222 1.478733
## [10,] 0.9194169 -2.055250 -1.01594680 2.502540
## [11,] 0.6264719 -2.369268 -0.81232591 1.944044
## [12,] 0.8368884 -2.093057 0.28629346 2.037840
## [13,] 0.8115216 -3.416342 0.26796251 2.041544
## [14,] 1.1008019 -2.051720 0.07205164 0.966141
## [15,] 1.1209480 -1.441426 -0.46015352 2.612207
## [16,] 0.9915649 -2.155555 -0.12739010 2.779434
## [17,] 1.1664833 -2.752221 -0.33086454 1.760433
## [18,] 0.8872730 -3.062815 -0.27524680 1.740629
## [19,] 0.7122494 -2.982257 -0.05811460 2.810124
## [20,] 1.2714353 -2.690109 0.06326856 2.666690
##
## $group2
## b1 b2 b3
## [1,] 1.2680879 -2.3875149 -0.46972645 2.1319689
## [2,] 0.8616094 -2.5672297 1.15049198 1.5471137
## [3,] 0.8219173 -2.0204187 1.21455494 2.2993512
## [4,] 1.1898218 -2.1720377 0.02307474 1.4464065
## [5,] 0.9037854 -2.0021411 -1.02459438 2.4790931
## [6,] 0.6343291 -2.3040428 -0.86230841 1.8807042
## [7,] 0.8607964 -2.0908819 0.32865582 2.0698986
## [8,] 0.7622907 -3.4796129 0.20169171 2.0787362
## [9,] 1.0910909 -2.0317450 0.02427113 0.9574358
## [10,] 1.1133905 -1.3111032 -0.41435228 2.6929688
## [11,] 1.0477009 -2.2390460 -0.04392256 2.6943811
## [12,] 1.0982732 -2.6906397 -0.33764168 1.7284376
## [13,] 0.9546348 -3.0264528 -0.30976993 1.8051420
## [14,] 0.7954141 -2.9808572 -0.01542877 2.7603745
## [15,] 1.3262338 -2.7479965 0.07685362 2.7424996
## [16,] 1.3796237 -1.5176059 0.42474507 2.6189078
## [17,] 0.7957041 -2.3716011 0.32292716 1.7418252
## [18,] 1.3325309 -1.9936431 1.26071159 2.9049788
## [19,] 1.3127814 -1.6488565 0.26076194 1.8537470
## [20,] 0.5953500 -0.9832675 -0.17441459 2.8890304