library(lattice)
library(sm)
## Package 'sm', version 2.2-5.7: type help(sm) for summary information
library(msm)
library(MASS)
##
## Attaching package: 'MASS'
## The following object is masked from 'package:sm':
##
## muscle
library(polycor)
library(ltm)
library(irtoys)
library(plink)
##
## Attaching package: 'plink'
## The following objects are masked from 'package:ltm':
##
## gpcm, grm
パッケージの関数とその働き.
共通項目15個、独自項目5個の2種類の試験フォームTとFを考える.
Tを基準としてFを等化する。
#フォーム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 |
#フォーム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)
str(pm)
## List of 2
## $ :'data.frame': 20 obs. of 3 variables:
## ..$ a: num [1:20] 0.824 1.48 0.949 1.18 0.504 ...
## ..$ b: num [1:20] -0.7775 0.1996 0.4171 -1.0854 -0.0541 ...
## ..$ c: int [1:20] 0 0 0 0 0 0 0 0 0 0 ...
## $ :'data.frame': 20 obs. of 3 variables:
## ..$ a: num [1:20] 0.694 0.828 0.736 1.131 0.876 ...
## ..$ b: num [1:20] -2.736 -0.205 -0.943 -0.413 -0.903 ...
## ..$ c: int [1:20] 0 0 0 0 0 0 0 0 0 0 ...
この pmを x=pm として as.irt.pars で使用します。
第11章「等化」では、共通項目を利用した等化の理論が説明されている。 要点は次のとおり。
<基本>(p251参照).
F社の作成したテスト、T社の作成したテストがある。
集団Aが2つのテストを受けたとき、それぞれのテストでの集団Aの能力パラメータを
母平均: \(\mu_{\theta F},~\mu_{\theta T}\) 母標準偏差:\(\sigma_{\theta F},~\sigma_{\theta T}\) とするとき
\(\dfrac{\theta_{iF}-\mu_{\theta F}}{\sigma_{\theta F}}=\dfrac{\theta_{iT}-\mu_{\theta T}}{\sigma_{\theta T}}\).
\(A=\dfrac{\sigma_{\theta
T}}{\sigma_{\theta F}}~,~~K=\mu_{\theta T}-A\mu_{\theta F}\)
とおくと、 \(\theta_{iT}=A
\theta_{iF}+K\).
(A,Kを等化係数という).
この式により、Fでの能力得点が試験Tでの得点に換算される。つまり、Tを基準とした変換である。
実際の場面では、等化係数Aを求めるのに.
などが用いられる。
この方法を用いて、等化係数を手計算してみよう。
共通項目は、Tの6〜20番、Fの1〜15番である。
Mean-Sigma法.
\(A=\dfrac{\sigma_{b T}}{\sigma_{b F}}~,~~K=\mu_{\theta T}-A\mu_{\theta F}\) \(\theta_{iT}=A \theta_{iF}+K\).
これらを利用する。
A <- sd(paramT$b[6:20])/sd(paramF$b[1:15])
A
## [1] 1.013564
K <- mean(paramT$b[6:20])-A*mean(paramF$b[1:15])
K
## [1] 0.2730375
Mean-Mean法.
\(A=\dfrac{\mu_{aF}}{\mu_{aT}}~,~~K=\mu_{\theta T}-A\mu_{\theta F}\) \(\theta_{iT}=A \theta_{iF}+K\).
これらを利用する。
A <- mean(paramF$a[1:15])/mean(paramT$a[6:20])
A
## [1] 1.06812
K <- mean(paramT$b[6:20])-A*mean(paramF$b[1:15])
K
## [1] 0.3093083
これは、plinkによる計算(後出)に一致している。
推定される能力パラメータはTとFで、似てはいるが異なった値を取っている。
#両フォームの能力パラメタの読み込み
pretheta <- read.csv("data/paramtheta.csv")
str(pretheta)
## 'data.frame': 100 obs. of 2 variables:
## $ thetaT: num 2.301 0.351 -0.908 1.316 -0.443 ...
## $ thetaF: num 2.542 0.441 -1.306 1.695 -0.49 ...
thetaT <- pretheta[,1]
thetaF <- pretheta[,2]
round(apply(pretheta,2,mean),2)
## thetaT thetaF
## 0.05 0.02
plot(pretheta[,c(2,1)])
abline(v=0)
abline(h=0)
abline(a = 0, b = 1, col = 2)
両フォームの能力パラメタは、ほぼ近い値を取っていることがわかる。
ヒストグラムで比べてみる。
par(mfrow=c(1,2))
hist(thetaT,prob=T)
hist(thetaF,prob=T)
#能力パラメタのリスト化(能力パラメタの等化が必要な場合)
theta <- list(thetaT,thetaF)
str(theta)
## List of 2
## $ : num [1:100] 2.301 0.351 -0.908 1.316 -0.443 ...
## $ : num [1:100] 2.542 0.441 -1.306 1.695 -0.49 ...
横軸の能力パラメータは標準化された能力因子であるので、どちらも(-3,3)の範囲になっている。
JT <- 20 # フォームTの項目数
JF <- 20 # フォームFの項目数
comx<- data.frame("T"=6:20,"F"=1:15)
str(comx)
## 'data.frame': 15 obs. of 2 variables:
## $ T: int 6 7 8 9 10 11 12 13 14 15 ...
## $ F: int 1 2 3 4 5 6 7 8 9 10 ...
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)
str(p.mod)
## List of 2
## $ :Formal class 'poly.mod' [package "plink"] with 2 slots
## .. ..@ model: chr "drm"
## .. ..@ items:List of 1
## .. .. ..$ drm: int [1:20] 1 2 3 4 5 6 7 8 9 10 ...
## $ :Formal class 'poly.mod' [package "plink"] with 2 slots
## .. ..@ model: chr "drm"
## .. ..@ items:List of 1
## .. .. ..$ drm: int [1:20] 1 2 3 4 5 6 7 8 9 10 ...
<基本>(p251参照).
F社の作成したテスト、T社の作成したテストがある。
集団Aが2つのテストを受けたとき、それぞれのテストでの集団Aの能力パラメータを
母平均: \(\mu_{\theta F},~\mu_{\theta T}\) 母標準偏差:\(\sigma_{\theta F},~\sigma_{\theta T}\) とするとき
\(\dfrac{\theta_{iF}-\mu_{\theta F}}{\sigma_{\theta F}}=\dfrac{\theta_{iT}-\mu_{\theta T}}{\sigma_{\theta T}}\).
\(A=\dfrac{\sigma_{\theta
T}}{\sigma_{\theta F}}~,~~K=\mu_{\theta T}-A\mu_{\theta F}\)
とおくと、 \(\theta_{iT}=A
\theta_{iF}+K\).
(A,Kを等化係数という).
p138の3行目によれば、表14.2のデータは.
\(\mu_{\theta F}=0,~\mu_{\theta T}=0.3\) 、 \(\sigma_{\theta F}=1,~\sigma_{\theta T}=1\) であるので.
\(A=\dfrac{\sigma_{\theta T}}{\sigma_{\theta F}}~=1,~~~~~K=\mu_{\theta T}-A\mu_{\theta F}=0.3\).
これは次にplinkにより出力される等化係数とほぼ一致している。
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
Fによる能力パラメータは、等化により 0.3 近くになっている。
能力パラメータは等化
\(\theta_{iT}=1\cdot\theta_{iF}+0.3\)
により、
Fでの能力得点が試験Tでの得点に換算されていることがわかる。
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 |
plot(paramF[,2],link.pars(out)[[2]][,2])
abline(v=0)
abline(h=0)
abline(h=0.3,col="lightblue")
困難度パラメータは等化
\(\mu_{b T}=1\cdot\mu_{b F}+0.3\) により変換されていることがわかる。
group1:試験Tの能力 group2:試験Fの能力.
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
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))
par(family = "HiraKakuProN-W3") #日本語フォントの指定
plot(eqtheta[,c(2,1)])
abline(v=0)
abline(h=0)
abline(h=0.3,col="lightblue")
ここでも \(\theta_{iT}=1\cdot\theta_{iF}+0.3\) であり、
等化係数は能力パラメータにおいても共通であることがわかる。
以下、参考までに段階反応モデルのコードを出力する。
詳細はテキスト p339 を参照のこと。
# フォーム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