エコポイントチェックの web 調査結果に対して semと lavaan パッケージを用いた構造方程式モデル

中澤 港
神戸大学
<minato-nakazawa@umin.net>
詳しくは下記 URL を参照ください
http://minato.sip21c.org/advanced-statistics/

R研究集会2015＠統数研

1

質問紙調査で潜在因子を探る原則●

直接測定できない概念を知りたいとき–––●

複数の関連した質問項目を評定してもらう
評定はリッカート尺度（ 3 件法や 5 件法が普通）
合計得点を概念（潜在因子）の尺度とする

条件––

必要十分な質問項目バイアスを避けた質問文●–

適切な用語，威光暗示効果を避ける，ダブルバーレルを避ける，……

合計得点に用いる項目の一次元性（クロンバックのα が大きい―慣例的に >0.7 ）R研究集会2015＠統数研

2クロンバックの α 係数
●

●

●

●

n 個の質問それぞれの得点の分散を s1, s2,…, sn と書き，合計得点の分散を st と書けば，α 係数は (n/(n-1))*(1-Σsi / st) と定義される。
R の fmsb パッケージの定義は以下
CronbachAlpha <- function (X) {dim(X)[2]/(dim(X)[2] - 1) * (1 - sum(apply(X, 2,var))/var(rowSums(X))) }行列またはデータフレーム x にデータが入っていれば， CronbachAlpha(x) で計算できる
library(psych); alpha(x) の方が多機能R研究集会2015＠統数研

3エコポイントチェック質問票

http://minato.sip21c.org/humeco/ecopoint.html

R研究集会2015＠統数研

4質問項目リストAGE
SEX
FAMSIZE
Q01
Q02
Q03
Q04
Q05
Q06
Q07
Q08
Q09
Q10
Q11
Q12
Q13
Q14
Q15
Q16
Q17
Q18Q19Q20Q21Q22Q23Q24Q25

年齢（10歳階級）
0=10-19 1=20-29 2=30-39 3=40-49 4=50-59 5=60-69 6=70性別
0=M
1=F
自分を含む同居人数
新聞雑誌リサイクル
0=いつも 1=大体 2=時々 3=たまに 4=皆無
古紙100％トイレットペーパー使用
0=いつも 1=大体 2=時々 3=たまに 4=皆無
0=いつも 1=大体 2=時々 3=たまに 4=皆無
飲料容器トレーリサイクル
買い物袋持参0=いつも 1=大体 2=時々 3=たまに 4=皆無
0=いつも 1=大体 2=時々 3=たまに 4=皆無
冷暖房より着る服で調節
食材を期限切れで捨てない
0=いつも 1=大体 2=時々 3=たまに 4=皆無
0=いつも 1=大体 2=時々 3=たまに 4=皆無
風呂は家族で続けて入る（一人暮らしの場合はお湯を少なくする工
風呂水を洗濯等に利用
0=いつも 1=大体 2=時々 3=たまに 4=皆無車のアイドリングストップ（車を持っていない人は「いつも」になる） 0=いつも 1=大体 2=時々 3=たまに 4=皆無
マイカーを避けて公共交通を利用
0=いつも 1=大体 2=時々 3=たまに 4=皆無
0=いつも 1=大体 2=時々 3=たまに 4=皆無
太陽熱温水器を利用
0=いつも 1=大体 2=時々 3=たまに 4=皆無
家電製品は省エネ型以外は買わない
0=いつも 1=大体 2=時々 3=たまに 4=皆無
米のとぎ汁は流さず有効利用
0=いつも 1=大体 2=時々 3=たまに 4=皆無
油をふき取ってから皿洗い
0=いつも 1=大体 2=時々 3=たまに 4=皆無
塩ビ系プラ製品を買わない
0=いつも 1=大体 2=時々 3=たまに 4=皆無
洗剤は合成洗剤でなく石鹸利用
0=いつも 1=大体 2=時々 3=たまに 4=皆無
洗剤（石鹸を含む）をはかって適量使用
0=いつも 1=大体 2=時々 3=たまに 4=皆無
除草剤や殺虫剤を使わない
0=いつも 1=大体 2=時々 3=たまに 4=皆無
車のバッテリーや電池を適正処理
0=いつも 1=大体 2=時々 3=たまに 4=皆無
トイレや風呂場の強力洗浄剤を利用しない
0=いつも 1=大体 2=時々 3=たまに 4=皆無
有機溶剤を利用しない
0=いつも 1=大体 2=時々 3=たまに 4=皆無
有機農産物を選ぶ
0=いつも 1=大体 2=時々 3=たまに 4=皆無
地場の農産物を選ぶ
0=いつも 1=大体 2=時々 3=たまに 4=皆無
早寝早起き
0=いつも 1=大体 2=時々 3=たまに 4=皆無
煙草を吸わない

R研究集会2015＠統数研

5エコポイントチェックの元データ（抜粋）0707120000,2,0,4,0,2,0,2,1,0,0,0,0,0,3,2,2,1,1,2,0,0,0,1,0,2,1,0,0
0707140924,1,0,3,0,0,0,0,0,0,0,0,0,1,4,2,0,1,3,3,0,0,0,2,0,4,2,1,00707142251,2,0,0,0,0,0,1,1,1,0,1,0,0,4,1,4,0,0,1,0,0,0,0,0,1,1,3,00707143341,2,1,2,0,1,0,2,2,1,2,0,3,2,4,3,1,1,1,0,1,0,0,0,0,1,2,2,00707144650,2,0,0,4,2,0,3,0,1,1,4,0,0,4,4,4,4,0,0,2,0,2,0,0,4,4,1,00707145443,2,0,3,0,0,4,4,2,0,3,4,0,0,4,4,4,4,0,4,4,0,1,1,0,4,4,4,40707151954,1,0,1,3,3,1,4,3,4,1,4,1,2,4,2,3,1,4,4,1,0,1,3,1,3,3,3,00707155254,1,1,1,0,0,0,2,1,0,0,0,0,0,4,1,1,0,1,0,0,1,1,1,1,1,0,1,00707155551,1,1,1,0,0,0,2,1,0,0,0,0,0,4,0,3,0,0,0,0,1,1,0,0,1,0,0,00707161041,1,1,0,2,0,3,1,2,1,1,4,4,3,4,4,4,2,0,0,0,1,0,2,0,3,1,2,00707173238,2,1,5,0,2,0,2,1,1,0,0,2,2,4,1,2,0,1,3,0,1,0,1,0,3,1,2,00707193558,0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,20707193630,2,1,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,20707193849,0,0,8,4,4,4,4,4,4,3,4,0,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,40707202934,2,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,20707203250,2,0,0,0,3,0,4,3,3,0,4,4,2,4,4,3,4,3,4,2,4,2,2,4,2,2,2,40707220218,2,0,5,2,2,2,4,4,1,4,0,0,4,4,2,4,4,4,4,1,2,0,2,2,4,4,1,00708132947,1,0,0,4,2,2,0,0,1,0,1,0,0,4,4,0,2,2,0,0,0,0,0,0,1,1,4,40708173429,1,1,1,0,2,1,2,2,2,2,1,2,0,4,3,3,1,2,1,1,2,2,2,1,3,3,3,40710093711,1,1,3,0,4,0,1,0,1,0,0,4,3,4,1,1,0,3,3,0,1,0,1,1,4,3,3,00711123248,2,0,1,3,2,2,4,4,0,4,4,0,0,4,4,4,4,4,4,0,0,0,4,4,4,4,4,00713171046,3,0,2,0,0,0,4,0,0,1,0,0,0,4,4,4,0,0,1,0,0,0,0,0,0,0,4,4
R研究集会2015＠統数研

6LibreOffice 上で得点に変換
Score Q01 Q02 Q03 Q04 Q05 Q06 Q07 Q08 Q09 Q10 Q11 Q12 Q13 Q14 Q15 Q16 Q17 Q18 Q19 Q20 Q21 Q22 Q23 Q24 Q25
0 7.4 4.1 4.45 3.6 3.7 1.4 2.5 2.9 9.6 4.9 5.2 1.9 3.7 7.1 3.7 2.1 4.5 5.7 4.2 3.4 3.5 2.2 1.9 1.21 5.6 3.1 3.3 3.7 2.7 2.8 1.1 1.9 2.2 7.2 3.7 3.9 1.5 2.8 5.3 2.8 1.5 3.3 4.2 3.2 2.6 2.7 1.7 1.4 0.9
2 3.7 2.1 2.2 2.5 1.8 1.9 0.7 1.3 1.4 4.8 2.5 2.6
1 1.9 3.5 1.9
1 2.2 2.8 2.1 1.7 1.8 1.1
1 0.6
3 1.9
1 1.1 1.2 0.9 0.9 0.4 0.6 0.7 2.4 1.2 1.3 0.5 0.9 1.8 0.9 0.5 1.1 1.4 1.1 0.9 0.9 0.6 0.5 0.3
40000000000000000000000000Max
14.3
温暖化=Q05+Q07+Q08+Q11+Q24
廃棄物=Q01+Q02+Q03+Q04+Q06
24.6
水=Q13+Q14+Q16+Q17+Q20
15.6
大気=Q09+Q10+Q12+Q23+Q25
21.1
有害化学物質=Q15+Q18+Q19+Q21+Q22
24.2
エコポイント=全部●●●

エコポイントは CRA (Comparative Risk Assessment) の応用なので，各項目の相対的重要性に応じた得点がある
これを score というシートに入れておき，元データのシートをecopoint として，各回答者の 0 ～ 4 の回答をこのシートの得点に変換したシート ecopx を得るには，例えば ecopx の D2 に以下を入力し全回答に対応する範囲にコピー＆ペーストする=VLOOKUP(ecopoint.D2, scores.$A$2:$Z$6, COLUMN(B2))
Excel でも同様。 R でも難しくはない。
R研究集会2015＠統数研

7エコポイントチェックのデータ（得点）●シート ecopx をタブ区切りテキスト形式
ecopx.txt として保存

R研究集会2015＠統数研

8総得点と領域別にクロンバックの α を計算
●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

●

# http://minato.sip21c.org/advanced-statistics/ecopxc.R
eco <- read.delim("ecopx.txt")
eco$NAGE <- factor(eco$AGE+1,labels=c("10-19","20-29","30-39","40-49","50-59","60-69","70-"))
eco$NSEX <- factor(eco$SEX+1, labels=c("M","F"))warming <- eco[, c("FAMSIZE","Q05","Q07","Q08","Q11","Q24")]
waste <- eco[, c("FAMSIZE","Q01","Q02","Q03","Q04","Q06")]
water <- eco[, c("FAMSIZE","Q13","Q14","Q16","Q17","Q20")]
air <- eco[, c("FAMSIZE","Q09","Q10","Q12","Q23","Q25")]
chem <- eco[, c("FAMSIZE","Q15","Q18","Q19","Q21","Q22")]
ecopoint <- eco[, c("FAMSIZE","Q05","Q07","Q08","Q11","Q24","Q01","Q02","Q03","Q04","Q06","Q13","Q14","Q16","Q17","Q20","Q09","Q10","Q12","Q23","Q25","Q15","Q18","Q19","Q21","Q22")]
library(psych)
GAC <- function(Z) { # Get alpha with 95%CIs
ZA <- alpha(Z)Raw <- ZA$total$raw_alphaAse <- ZA$total$ase
return(c(Raw-1.96*Ase, Raw, Raw+1.96*Ase))}all <- cbind(GAC(warming[,-1]), GAC(waste[,-1]), GAC(water[,-1]),
GAC(air[,-1]), GAC(chem[,-1]), GAC(ecopoint[,-1]))

psych パッケージの alpha() は 95%CI 表示。 str(alpha(...)) には含まれず
alpha と打つと，結果オブジェクトに c("psych","alpha") クラスあり
print.psych と打つと， switch(value, ...) の中の alpha={ } 内に式がある
cat(round(c(x$total$raw_alpha-1.96*x$total$ase,x$total$raw_alpha, x$total$raw_alpha +1.96 * x$total$ase), digits = digits), "\n")R研究集会2015＠統数研

91.0

クロンバックの α 係数計算結果の図示●

全体他 の世 帯

0.60.8

単独世帯0.20.4

●

0.0

●

温暖化廃棄物

水大気

化学物質

総合

全項目を使ったエコポイント
は α>0.8
廃棄物，水，化学物質はま
あまあ
温暖化と大気は係数が低すぎる

MX <- rbind(all[2,], single[2,], others[2,])colnames(MX) <- c(" 温暖化 "," 廃棄物 "," 水 "," 大気 "," 化学物質 "," 総合 ")rownames(MX) <- c(" 全体 "," 単独世帯 "," 他の世帯 ")UX <- rbind(all[3,], single[3,], others[3,])ii <- barplot(MX, beside=TRUE, ylim=c(0,1), col=1:3)
arrows(ii, as.vector(MX), ii, as.vector(UX), angle=90, length=0.1)
R研究集会2015＠統数研

10探索的因子分析をしてみる●

サンプルサイズ >300 ，元々は５つの潜在因子が仮定されているが，因子数から検討してみる

R研究集会2015＠統数研

11エコポイントデータの探索的因子分析# http://minato.sip21c.org/advancedstatistics/ecofactor.R➢ eco.raw <- eco[,4:28]➢ source("http://aoki2.si.gunmau.ac.jp/R/src/kmo.R", encoding="eucjp")➢ kmo(eco.raw)➢ library(psych)➢ cortest.bartlett(eco.raw)➢ print(res1 <- fa.parallel(eco.raw))➢ print(res2 <- fa(eco.raw, fm="minres",nfactors=res1$nfact,rotate="quartimax"))➢ res2$loadings➢

R研究集会2015＠統数研

12KMO と MSA は青木先生の関数で計算→サンプリング適切性は OK●●●> kmo(eco.raw)$KMO[1] 0.8546175

●

●

●

●

●

●

●

●

●

●

●

●

$MSA
Q01
Q02
Q03
Q04
Q05
0.8021870 0.9175220 0.8402529 0.8735483 0.8969617
Q06
Q07
Q08
Q09
Q10
0.8257504 0.8637544 0.7923859 0.7968222 0.7459193
Q11
Q12
Q13
Q14
Q150.7190354 0.8863339 0.8566691 0.9184074 0.9264639
Q16Q17Q18
Q19Q200.8803217 0.8880636 0.8796506 0.8689558 0.9038889
Q21Q22Q23Q24Q250.8354561 0.8032507 0.7739853 0.8209391 0.8613021

R研究集会2015＠統数研

13psych パッケージの cortest.bartlett()
でバートレットの球面性検定
●

●

●

●

> cortest.bartlett(eco.raw)
R was not square, finding R from data$chisq[1] 2652.951

●

●

●

$p.value[1] 0●●●$df[1] 300
R研究集会2015＠統数研

14fa.parallel() の結果→因子数は 5 個
●

●

●

●

> print(res1 <- fa.parallel(eco.raw))
Parallel analysis suggests that the number of factors =number of components = 4
Call: fa.parallel(x = eco.raw)
Parallel analysis suggests that the number of factors =number of components = 45

and the5

and the

●

●

●

●

●

●

●

●

●

●

●

●

●

●

Eigen Values ofOriginal factors Simulated data Original components
1
6.07
0.68
6.78
2
1.53
0.49
2.32
3
0.84
0.43
1.65
4
0.70
0.36
1.45
50.56
0.32
1.29
simulated data
11.56
2
1.47
3
1.41
4
1.34
51.30

●R研究集会2015＠統数研

15

探索的因子分析の結果

R研究集会2015＠統数研

16sem を使った確証的因子分析 (CFA)

R研究集会2015＠統数研

17semPlot パッケージ semPaths で作図R研究集会2015＠統数研

18

semPaths のオプション

R研究集会2015＠統数研

19

lavaan の場合

R研究集会2015＠統数研

20

出力

R研究集会2015＠統数研

21