共分散構造分析を試す
はじめに
今回は共分散構造分析を試してみたいと思います。共分散構造分析は手法としては因子分析と回帰分析を組み合わせたようなもので、観測変数から因子分析で潜在変数の導出を、複数の潜在変数同士の関係を回帰分析で行うようなイメージです。例えば国語、数学、理科、社会、英語の点数という観測変数があった場合に、数学、理科には理系能力、国語、社会、英語には文系能力という潜在変数が、さらに理系能力と文系能力に基礎能力という潜在変数があるとした場合にこの構造が数値的に正しいのか、またそれぞれの項目はどのように関連しているかを明らかにするような方法です。
潜在変数間の関係性を示すことができるので、用途としてはマーケティングや心理学など、目的に対して直接的なログデータが取得できず、 何らかの仮定を元に意思決定を行う必要があるケースに使われる場合が多いようです。
参考文献
共分散構造分析を理解するのに役立つ動画
lavaan公式
lavaan日本語チュートリアル
実験
データはkaggleのbig-five-personality-testを使用します。
このデータには心理学でビッグファイブと呼ばれる開放性、誠実性、外向性、協調性、神経症傾向について、各特性10問づつ5段階評価のアンケート結果が含まれます。 アンケート結果が観測変数で、開放性などの各特性が潜在変数と考えられます。同じデータセットに質問にどれくらい時間をかけたかという項目も存在していたので、今回は仮説としてこれらの５つの特性が回答にかける時間に影響を与えていると考え、それぞれの特性がどれくらい時間の項目に影響するかを明らかとします。
データセットの変数は以下になります。
| 変数名 | 説明 |
|---|---|
| EXT(1-10) | 外向性に関する質問項目 |
| EST(1-10) | 誠実性に関する質問項目 |
| AGR(1-10) | 協調性に関する質問項目 |
| CSN(1-10) | 神経症傾向に関する質問項目 |
| OPN(1-10) | 開放性に関する質問項目 |
| introelapse | イントロページでの所要時間 |
| testelapse | 質問回答での所要時間 |
| endelapse | 最終(確認)ページでの所要時間 |
Rのlavaanで実装を行います。
library(lavaan)
library(psych)
library(semTools)
library(semPlot)
library(gplots)
df=read.csv("data-final.csv",sep='\t',na.strings="NULL")
#使用変数
col=c("EXT1","EXT2","EXT3","EXT4","EXT5","EXT6","EXT7","EXT8","EXT9","EXT10",
"EST1","EST2","EST3","EST4","EST5","EST6","EST7","EST8","EST9","EST10",
"AGR1","AGR2","AGR3","AGR4","AGR5","AGR6","AGR7","AGR8","AGR9","AGR10",
"CSN1","CSN2","CSN3","CSN4","CSN5","CSN6","CSN7","CSN8","CSN9","CSN10",
"OPN1","OPN2","OPN3","OPN4","OPN5","OPN6","OPN7","OPN8","OPN9","OPN10",
"testelapse","introelapse","endelapse"
)
xs<-df[,col]
#0,欠損処理
xs[xs == 0] <- NA
xs <- na.omit(xs)
#外れ値処理
xs=xs[xs$testelapse < 1000, ]
xs=xs[xs$introelapse < 1000, ]
xs=xs[xs$endelapse < 1000, ]
#log化
xs[,"testelapse"] <- log(xs$testelapse+1)
xs[,"introelapse"] <- log(xs$introelapse+1)
xs[,"endelapse"] <- log(xs$endelapse+1)
#変更前
model <- '
# measurement model
EXT =~ EXT1+EXT2+EXT3+EXT4+EXT5+EXT6+EXT7+EXT8+EXT9+EXT10
EST =~ EST1+EST2+EST3+EST4+EST5+EST6+EST7+EST8+EST9+EST10
AGR =~ AGR1+AGR2+AGR3+AGR4+AGR5+AGR6+AGR7+AGR8+AGR9+AGR10
CSN =~ CSN1+CSN2+CSN3+CSN4+CSN5+CSN6+CSN7+CSN8+CSN9+CSN10
OPN =~ OPN1+OPN2+OPN3+OPN4+OPN5+OPN6+OPN7+OPN8+OPN9+OPN10
ELP =~ testelapse+introelapse+endelapse
# regressions
ELP ~ EXT+EST+AGR+CSN+OPN
'
fit <- sem(model, data=xs)
summary(fit, fit.measures=TRUE, standardized=TRUE)
前処理について、データセットのサンプルサイズが十分大きいので、欠損を含んだ行は削除しています。 時間を示す変数には異常に大きい値が含まれるのでそのサンプルを削除しています。 またロングテールな変数なので、正規分布に近づけるためにlog化しています。
共分散構造分析では確認すべき指標は結構多いのですが、このモデルでは適合度を示すCFIが0.748と低めでした。 CFIは0.95以上が良適合といわれており、モデルの信頼性を考えるなら0.9以上は欲しいです。
信頼性のないモデルを用いて結果の議論はできないので、CFIの向上を検討します。 使用したモデルだと使用する質問項目が多すぎるかなと思ったので、潜在変数に対してパス値が小さかった項目をカットして各特性に対して使用する質問を2~5問に限定して再度計算を回します。
変更後のモデル
model <- '
# measurement model
EXT =~ EXT2+EXT4+EXT5+EXT7+EXT10
EST =~ EST6+EST7+EST8
AGR =~ AGR4+AGR5+AGR7+AGR9
CSN =~ CSN1+CSN5
OPN =~ OPN5+OPN10
ELP =~ testelapse+introelapse+endelapse
# regressions
ELP ~ EXT+EST+AGR+CSN+OPN
'
この結果、CFIは0.930と良適合まではいきませんが、許容できる数値に収まりました。他の数値についても問題ないレベルでした。 このモデルによるパス図は以下のようになりました。
結果として、各特性(EXT,EST,AGR,CSN,OPN)から時間特性(ELP)へのパス係数はどれも0.1以下と小さい値となり、それほど影響はしていないという結果になりました。 (データセットの制約の問題であまり面白い仮定を置けなかったので仕方ない…。)
まとめ
共分散構造分析はA→B、B→CだからA→Cみたいな論理展開に対して、A→Bは0.6、B→Cは0.7のように数値的に仮説検証ができる部分は面白いと思いました。また結果のわかりやすさに反して信頼性のあるパス図を作るには適切な仮説検証とモデルの試行錯誤が必要であり、実行時に必要な知識や労力は結構かかる方法だと感じました。
使用したコードはこちら
