|
|
|
章末クイズの答えの補足 |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
問1 |
#lavaanのプログラム文を載せる。 #因子の分散を1に固定した場合の非標準化解を求めるためのスクリプト library(lavaan) library(psych) #NAを含むデータを除外する bfi2<-na.omit(bfi) #モデル指定 model.q1.1 <- ' f =~ N1+N2+N3+N4+N5 N1 ~~ N1 N2 ~~ N2 N3 ~~ N3 N4 ~~ N4 N5 ~~ N5 f ~~ 1*f ' #lavaanを実行する fit.q1.1 <- lavaan(model.q1.1,
data=bfi2[,16:20]) #結果を出力する summary(fit.q1.1, standardized=T, rsquare=T, fit.measure=T) #因子負荷量 #1.295(N1),1.232(N2),1.147(N3),0.863(N4),0.815(N5) #誤差分散 #0.769(N1),0.836(N2),1.231(N3),1.689(N4),1.966(N5) #N1に対する因子負荷量を1に固定した場合の非標準化解を求めるためのスクリプト library(lavaan) library(psych) #NAを含むデータを除外する bfi2<-na.omit(bfi) #モデル指定 model.q1.1 <- ' f =~ 1*N1+N2+N3+N4+N5 N1 ~~ N1 N2 ~~ N2 N3 ~~ N3 N4 ~~ N4 N5 ~~ N5 f ~~ f ' #lavaanを実行する fit.q1.1 <- lavaan(model.q1.1,
data=bfi2[,16:20]) #結果を出力する summary(fit.q1.1, standardized=T, rsquare=T, fit.measure=T) #因子負荷量 #1.000(N1),0.951(N2),0.886(N3),0.667(N4),0.629(N5) #誤差分散 #0.769(N1),0.836(N2),1.231(N3),1.689(N4),1.966(N5) |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
問2 |
lavaanプログラムは問1を参照してください。結果は以下の通り。 カッコ内は，最初の項目の因子負荷量を1に固定したとき。 その際，誤差分散の結果は変わりません。
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
問2 |
ソフトウェアの中では以下のように計算されている。 共分散行列の重複のない要素の数は8×9/2=36。 因子の分散を固定した場合，母数は ・因子負荷量が8個 ・誤差分散が8個 ・因子間相関が1個 で合計8+8+1=17。したがって，自由度は36–17=19。 |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
問1 |
#lavaanのプログラム文を載せる。 library(lavaan) library(MBESS) data(HS.data) hsdata<-HS.data colnames(hsdata) <- c("x1",
"x2", "x3","x4", "x5",
"x6","x7", "x8",
"x9","x10", "x11",
"x12","x13", "x14", "x15","x16",
"x17", "x18","x19", "x20",
"x21","x22", "x23",
"x24","x25", "x26",
"x27","x28", "x29", "x30",
"x31", "x32")
#モデル指定 model.q3.1 <- ' f1 =~ 1*x11+x12+x13+x14+x15 f2 =~ 1*x16+x17+x18+x19 f3 =~ 1*x20+x21+x22+x23+x24+x25 f4 =~ f1+f2+f3 x11 ~~ x11 x12 ~~ x12 x13 ~~ x13 x14 ~~ x14 x15 ~~ x15 x16 ~~ x16 x17 ~~ x17 x18 ~~ x18 x19 ~~ x19 x20 ~~ x20 x21 ~~ x21 x22 ~~ x22 x23 ~~ x23 x24 ~~ x24 x25 ~~ x25 f4 ~~ 1*f4 ' #lavaanを実行する fit.q3.1 <- lavaan(model.q3.1,
data=hsdata[,11:25]) #結果を出力する summary(fit.q3.1, standardized=T, rsquare=T, fit.measure=T) |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
問1 |
#lavaanのプログラム文を載せる。 library(MBESS) library(psych) #psychパッケージに含まれる関数alphaを使うため data(HS.data) hsdata<-HS.data colnames(hsdata) <- c("x1",
"x2", "x3","x4", "x5",
"x6","x7", "x8",
"x9","x10", "x11",
"x12","x13", "x14",
"x15","x16", "x17",
"x18","x19", "x20",
"x21","x22", "x23",
"x24","x25", "x26",
"x27","x28", "x29", "x30",
"x31", "x32")
#共分散行列から計算する方法 (ncol(hsdata[,7:30])/(ncol(hsdata[,7:30])-1))*(sum(cov(hsdata[,7:30]))-sum(diag(cov(hsdata[,7:30]))))/sum(cov(hsdata[,7:30])) #α係数は0.82 #関数alphaを使う方法 alpha(hsdata[,7:30]) #α係数は0.82 |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
問1 |
#lavaanのプログラム文を載せる。 library(lavaan) #共分散行列の下三角要素の読み込み lower <- ' 4.137, 2.326, 5.569, 2.548, 3.180, 14.038' #共分散行列の作成 dep.cov <- getCov(lower, names=c("parent","study","dep")) #重回帰モデルの指定 model.q5.1 <- ' dep ~ parent+study dep ~~ dep ' fit.q5.1 <- lavaan(model.q5.1,
sample.cov=dep.cov, sample.nobs=518) summary(fit.q5.1, standardized=T, rsquare=T) |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
問2 |
#lavaanのプログラム文を載せる。 library(lavaan) #共分散行列の下三角要素の読み込み lower <- ' 10.693, 3.262,11.834, 0.775,-0.306,8.768, 0.118,-0.248,4.056,12.992, -0.731,-1.209,3.499,5.295,10.200' #共分散行列の作成 q6.1.2.cov <- getCov(lower,names=c("ses1","ses2","stress1","stress2","dep")) #モデルの指定（q6.1.2） model.q6.1.2 <- ' f1 =~ 1*ses1+ses2 f2 =~ 1*stress1+stress2 f2~f1 dep ~ f1+f2 ' #auto.var=TRUEで，観測変数の誤差分散と潜在変数の分散を推定する fit.q6.1.2 <- lavaan(model.q6.1.2,
auto.var=TRUE, sample.cov=q6.1.2.cov,
sample.nobs=983) summary(fit.q6.1.2, standardized=T, rsquare=T, fit.measures=TRUE) #推定値，カッコ内は標準化推定値 #SES1の因子負荷量:1(0.543) #SES2の因子負荷量:1.036(0.534) #ストレス1の因子負荷量:1(0.557) #ストレス2の因子負荷量:1.494(0.683) #SES→ストレス 0.019(0.021)有意ではない #SES→抑うつ -0.325(-0.181)1%水準で有意 #ストレス→抑うつ
1.307(0.674)0.1%水準で有意 #SES1の誤差分散:7.536(0.705) #SES2の誤差分散:8.447(0.715) #ストレス1の誤差分散:6.046(0.690) #ストレス2の誤差分散:6.927(0.534) #抑うつの誤差分散:5.275(0.518) #SES因子の分散:3.146(1.000) #ストレス因子の誤差分散:2.712(1.000) #抑うつの決定係数:0.482 |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
問1 |
#平均構造を含まないモデル library(lavaan) #変数名 varnames<-c("t1","t2") #1卵性の共分散行列の下三角要素の読み込み mz <- ' 0.641, 0.471,0.648' #1卵性の共分散行列の作成 mz.cov <- getCov(mz,names=varnames) #2卵性の共分散行列の下三角要素の読み込み dz <- ' 0.744, 0.403,0.657' #2卵性の共分散行列の作成 dz.cov <- getCov(dz,names=varnames) N<-list(mzG=107,
dzG=94) twin.cov<-list(mzG=mz.cov,
dzG=dz.cov) #フルモデル（ACEモデル）の指定 model.q7.1ace <- ' fA1 =~ c(a1,a1)*t1 fA2 =~ c(a1,a1)*t2 fC =~ c(c1,c1)*t1+c(c1,c1)*t2 fE1 =~ c(e1,e1)*t1 fE2 =~ c(e1,e1)*t2 fA1 ~~ 1*fA1 fA2 ~~ 1*fA2 fA1 ~~ c(1,0.5)*fA2 fC ~~ 1*fC fE1 ~~ 1*fE1 fE2 ~~ 1*fE2 t1 ~~ 0*t1 t2 ~~ 0*t2 ' fit.q7.1ace <- lavaan(model.q7.1ace,
sample.cov=twin.cov, sample.nobs=N) summary(fit.q7.1ace, standardized=T, rsquare=T, fit.measures=TRUE) #遺伝・非共有環境モデル（AEモデル）の指定 model.q7.1ae <- ' fA1 =~ c(a1,a1)*t1 fA2 =~ c(a1,a1)*t2 fE1 =~ c(e1,e1)*t1 fE2 =~ c(e1,e1)*t2 fA1 ~~ 1*fA1 fA2 ~~ 1*fA2 fA1 ~~ c(1,0.5)*fA2 fE1 ~~ 1*fE1 fE2 ~~ 1*fE2 t1 ~~ 0*t1 t2 ~~ 0*t2 ' fit.q7.1ae <- lavaan(model.q7.1ae,
sample.cov=twin.cov, sample.nobs=N) summary(fit.q7.1ae, standardized=T, rsquare=T, fit.measures=TRUE) #共有環境・非共有環境モデル（CEモデル）の指定 model.q7.1ce <- ' fC =~ c(c1,c1)*t1+c(c1,c1)*t2 fE1 =~ c(e1,e1)*t1 fE2 =~ c(e1,e1)*t2 fC ~~ 1*fC fE1 ~~ 1*fE1 fE2 ~~ 1*fE2 t1 ~~ 0*t1 t2 ~~ 0*t2 ' fit.q7.1ce <- lavaan(model.q7.1ce,
sample.cov=twin.cov, sample.nobs=N) summary(fit.q7.1ce, standardized=T, rsquare=T, fit.measures=TRUE) #フルモデルの適合度 #AIC=864.617,
RMSEA=0.000, SRMR=0.039, CFI=1.000 #AEモデルの適合度 #AIC=869.002,
RMSEA=0.016, SRMR=0.062, CFI=0.999 #CEモデルの適合度 #AIC=869.621,
RMSEA=0.034, SRMR=0.042, CFI=0.993 #最も適合の良いフルモデルの推定値 #α=0.594, γ=0.623,
ε=0.510 #α^2=0.352,
γ^2=0.388, ε^2=0.260 #表7-5のフルモデルと比較すると， #年齢が上昇すると，遺伝の影響が大きくなり， #共有環境の影響が小さくなることが分かる。 #なお，以下のように，4つの共分散行列を同時に分析して， #「8-11歳と，12-16歳ではEの影響は同じでAとCの影響は #異なる」モデルがベストフィットであることを示すこともできる。 #変数名 varnames<-c("t1","t2") #8-11歳の1卵性の共分散行列の下三角要素の読み込み mz8.11 <- ' 0.675, 0.513,0.714' #8-11歳の1卵性の共分散行列の作成 mz8.11.cov <- getCov(mz8.11,names=varnames) #2卵性の共分散行列の下三角要素の読み込み dz8.11 <- ' 0.621, 0.434,0.623' #2卵性の共分散行列の作成 dz8.11.cov <- getCov(dz8.11,names=varnames) #12-16歳の1卵性の共分散行列の下三角要素の読み込み mz12.16 <- ' 0.641, 0.471,0.648' #1卵性の共分散行列の作成 mz12.16.cov <- getCov(mz12.16,names=varnames) #12-16歳の2卵性の共分散行列の下三角要素の読み込み dz12.16 <- ' 0.744, 0.403,0.657' #2卵性の共分散行列の作成 dz12.16.cov <- getCov(dz12.16,names=varnames) N4G<-list(mzG8.11=102, dzG8.11=97,
mzG12.16=107, dzG12.16=94) twin4G.cov<-list(mzG8.11=mz8.11.cov,
dzG8.11=dz8.11.cov, mzG12.16=mz12.16.cov, dzG12.16=dz12.16.cov) #AとEが年代間で異なるモデルの指定 model.q7.1e4G <- ' fA1 =~ c(a1,a1,a2,a2)*t1 fA2 =~ c(a1,a1,a2,a2)*t2 fC =~ c(c1,c1,c2,c2)*t1+c(c1,c1,c2,c2)*t2 fE1 =~ c(e1,e1,e1,e1)*t1 fE2 =~ c(e1,e1,e1,e1)*t2 fA1 ~~ 1*fA1 fA2 ~~ 1*fA2 fA1 ~~ c(1,0.5,1,0.5)*fA2 fC ~~ 1*fC fE1 ~~ 1*fE1 fE2 ~~ 1*fE2 t1 ~~ 0*t1 t2 ~~ 0*t2 ' fit.q7.1e4G <- lavaan(model.q7.1e4G,
sample.cov=twin4G.cov, sample.nobs=N4G) summary(fit.q7.1e4G, standardized=T, rsquare=T, fit.measures=TRUE) #ACEのすべてが年代間で等しいモデルの指定 model.q7.1ace4G <- ' fA1 =~ c(a1,a1,a1,a1)*t1 fA2 =~ c(a1,a1,a1,a1)*t2 fC =~ c(c1,c1,c1,c1)*t1+c(c1,c1,c1,c1)*t2 fE1 =~ c(e1,e1,e1,e1)*t1 fE2 =~ c(e1,e1,e1,e1)*t2 fA1 ~~ 1*fA1 fA2 ~~ 1*fA2 fA1 ~~ c(1,0.5,1,0.5)*fA2 fC ~~ 1*fC fE1 ~~ 1*fE1 fE2 ~~ 1*fE2 t1 ~~ 0*t1 t2 ~~ 0*t2 ' fit.q7.1ace4G <- lavaan(model.q7.1ace4G,
sample.cov=twin4G.cov, sample.nobs=N4G) summary(fit.q7.1ace4G, standardized=T, rsquare=T, fit.measures=TRUE) #AとEが年代間で異なるモデルモデルの適合度 #AIC=1680.831,
BIC=1700.789, RMSEA=0.000, SRMR=0.053, CFI=1.000 #ACEのすべてが年代間で等しいモデルの適合度 #AICやBICは悪くなる #AIC=1681.434, BIC=1693.408, RMSEA=0.000, SRMR=0.049, CFI=1.000 |