library(psych)
library(MASS)
#3D表示
options(rgl.printRglwidget = TRUE) 
#WebGLに変換してRStudio, VSCode, ウェブブラウザなど出力
library(rgl)

1 因子分析の基礎用語

  • h2:共通性

  • u2:独自性

  • com 複雑性(item complexity)
    1つの因子からのみ影響を受けている単純構造であれば 1 に近く、
    「どっちつかず」だと値が大きくなる。(単純構造に近づけたい時に便利な指標)
    (Mean item complexity はその平均で、1に近いほどよい)

  • loadings(因子負荷量):元の変量とその因子との相関係数

  • SS loadings(因子寄与):固有値(Sum of Square loadings 因子負荷量の平方和)

  • 因子軸の回転
     因子を解釈するためには、因子が単純構造である方が便利。
     単純構造とは、各項目の因子負荷が1つの因子のみ大きな値を持ち、
     それ以外はゼロに近い構造。
     そのような状態にするために利用されるのが因子軸の回転です。

  • RMSR
     モデルによって説明できなかったデータの分散の大きさを指標化したもの
     データの分散共分散モデルと推定値の分散共分散モデルの差の二乗の平均の平方根。
     0に近いほど良い。

  • empirical chi square

因子分析が「うまくいった」と判断される因子負荷量は「1観測変数に対して,1共通因子だけ1もしくは-1に近く,他の共通因子では0に近い」である.逆に.1つの観測変数に対して因子負荷量の共通因子間の差が小さい場合は因子分析がうまくいかなかったことを示している. 大きいほどP値は小さく、モデルの当てはまりは良い

こーひーをぶんなぐれ

1.1 3次元データ 

mu <- c(0,0,0)
Sigma <- matrix(c(1, 0.7,0.6,0.7,1,0.5,0.6,0.5, 1), 3, 3)
data <- mvrnorm(100, mu, Sigma)
d <- data.frame(X=data[,1],Y=data[,2],Z=data[,3])
attach(d)

1.2 none回転

fit <- fa(r=d, nfactors=2 ,rotate="", fm="ml", scores=T)
## Specified rotation not found, rotate='none' used
print(fit, digits=5,sort=T)# 因子得点を出すためにはscores=T
## Factor Analysis using method =  ml
## Call: fa(r = d, nfactors = 2, rotate = "", scores = T, fm = "ml")
## Standardized loadings (pattern matrix) based upon correlation matrix
##   item     ML1      ML2      h2        u2    com
## Y    2 0.94920 -0.29958 0.99072 0.0092762 1.1973
## X    1 0.90967  0.40073 0.98808 0.0119205 1.3740
## Z    3 0.64062  0.06796 0.41502 0.5849842 1.0225
## 
##                           ML1     ML2
## SS loadings           2.13887 0.25495
## Proportion Var        0.71296 0.08498
## Cumulative Var        0.71296 0.79794
## Proportion Explained  0.89350 0.10650
## Cumulative Proportion 0.89350 1.00000
## 
## Mean item complexity =  1.2
## Test of the hypothesis that 2 factors are sufficient.
## 
## The degrees of freedom for the null model are  3  and the objective function was  1.33608 with Chi Square of  129.8224
## The degrees of freedom for the model are -2  and the objective function was  0 
## 
## The root mean square of the residuals (RMSR) is  0 
## The df corrected root mean square of the residuals is  NA 
## 
## The harmonic number of observations is  100 with the empirical chi square  0  with prob <  NA 
## The total number of observations was  100  with Likelihood Chi Square =  0  with prob <  NA 
## 
## Tucker Lewis Index of factoring reliability =  1.023992
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                       ML1     ML2
## Correlation of (regression) scores with factors   0.99702 0.97908
## Multiple R square of scores with factors          0.99406 0.95860
## Minimum correlation of possible factor scores     0.98811 0.91720
biplot(fit)

fa.diagram( fit )

plot3d(X, Y, Z, type = "s", col = "gray", size = 1)
v <- fit$ loadings
#v[1,1];v[2,1];v[3,1]
#v[1,2];v[2,2];v[3,2]
str(v)
##  'loadings' num [1:3, 1:2] 0.91 0.949 0.641 0.401 -0.3 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : chr [1:3] "X" "Y" "Z"
##   ..$ : chr [1:2] "ML1" "ML2"
arrow3d(p0 = c(0, 0, 0), p1 = c(v[1,1],v[2,1],v[3,1]), col = "red")
arrow3d(p0 = c(0, 0, 0), p1 = c(v[1,2],v[2,2],v[3,2]), col = "blue")

1.3 promax回転

fit.ml.promax <- fa(r=d, nfactors=2 ,rotate="promax", fm="ml", scores=T)# 因子得点を出すためにはscores=T
## Loading required namespace: GPArotation
print(fit.ml.promax, digits=3)
## Factor Analysis using method =  ml
## Call: fa(r = d, nfactors = 2, rotate = "promax", scores = T, fm = "ml")
## Standardized loadings (pattern matrix) based upon correlation matrix
##      ML2    ML1    h2      u2  com
## X  1.026 -0.042 0.988 0.01192 1.00
## Y -0.005  0.999 0.991 0.00928 1.00
## Z  0.401  0.282 0.415 0.58498 1.79
## 
##                         ML2   ML1
## SS loadings           1.264 1.130
## Proportion Var        0.421 0.377
## Cumulative Var        0.421 0.798
## Proportion Explained  0.528 0.472
## Cumulative Proportion 0.528 1.000
## 
##  With factor correlations of 
##       ML2   ML1
## ML2 1.000 0.771
## ML1 0.771 1.000
## 
## Mean item complexity =  1.3
## Test of the hypothesis that 2 factors are sufficient.
## 
## The degrees of freedom for the null model are  3  and the objective function was  1.336 with Chi Square of  129.822
## The degrees of freedom for the model are -2  and the objective function was  0 
## 
## The root mean square of the residuals (RMSR) is  0 
## The df corrected root mean square of the residuals is  NA 
## 
## The harmonic number of observations is  100 with the empirical chi square  0  with prob <  NA 
## The total number of observations was  100  with Likelihood Chi Square =  0  with prob <  NA 
## 
## Tucker Lewis Index of factoring reliability =  1.024
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                     ML2   ML1
## Correlation of (regression) scores with factors   0.994 0.995
## Multiple R square of scores with factors          0.989 0.991
## Minimum correlation of possible factor scores     0.978 0.982
biplot(fit.ml.promax)

fa.diagram( fit.ml.promax)

plot3d(X, Y, Z, type = "s", col = "gray", size = 1)
v <- fit.ml.promax$ loadings
arrow3d(p0 = c(0, 0, 0), p1 = c(v[1,1],v[2,1],v[3,1]), col = "red")
arrow3d(p0 = c(0, 0, 0), p1 = c(v[1,2],v[2,2],v[3,2]), col = "blue")

1.4 varimax回転

fit.ml.varimax <- fa(r=d, nfactors=2 ,rotate="varimax", fm="ml", scores=T)
print(fit.ml.varimax, digits=3)
## Factor Analysis using method =  ml
## Call: fa(r = d, nfactors = 2, rotate = "varimax", scores = T, fm = "ml")
## Standardized loadings (pattern matrix) based upon correlation matrix
##     ML2   ML1    h2      u2  com
## X 0.911 0.397 0.988 0.01192 1.37
## Y 0.423 0.901 0.991 0.00928 1.42
## Z 0.484 0.425 0.415 0.58498 1.97
## 
##                         ML2   ML1
## SS loadings           1.244 1.150
## Proportion Var        0.415 0.383
## Cumulative Var        0.415 0.798
## Proportion Explained  0.520 0.480
## Cumulative Proportion 0.520 1.000
## 
## Mean item complexity =  1.6
## Test of the hypothesis that 2 factors are sufficient.
## 
## The degrees of freedom for the null model are  3  and the objective function was  1.336 with Chi Square of  129.822
## The degrees of freedom for the model are -2  and the objective function was  0 
## 
## The root mean square of the residuals (RMSR) is  0 
## The df corrected root mean square of the residuals is  NA 
## 
## The harmonic number of observations is  100 with the empirical chi square  0  with prob <  NA 
## The total number of observations was  100  with Likelihood Chi Square =  0  with prob <  NA 
## 
## Tucker Lewis Index of factoring reliability =  1.024
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy             
##                                                     ML2   ML1
## Correlation of (regression) scores with factors   0.987 0.989
## Multiple R square of scores with factors          0.975 0.978
## Minimum correlation of possible factor scores     0.950 0.956
biplot(fit.ml.varimax)

fa.diagram( fit.ml.varimax)

plot3d(X, Y, Z, type = "s", col = "gray", size = 1)
v <- fit.ml.varimax$ loadings
arrow3d(p0 = c(0, 0, 0), p1 = c(v[1,1],v[2,1],v[3,1]), col = "red")
arrow3d(p0 = c(0, 0, 0), p1 = c(v[1,2],v[2,2],v[3,2]), col = "blue")
c(v[1,1],v[2,1],v[3,1])
## [1] 0.9112822 0.4232714 0.4842621

1.5 最小残差法minres

rotate = “oblimin”

result = fa( d, nfactors = 2, fm = "minres", rotate = "oblimin", use = "complete.obs" )
print( result$loadings, digits = 2, cutoff = 0.3 )
## 
## Loadings:
##   MR1   MR2  
## X  0.87      
## Y  0.85      
## Z  0.69      
## 
##                 MR1  MR2
## SS loadings    1.97 0.01
## Proportion Var 0.66 0.00
## Cumulative Var 0.66 0.66
biplot(result)

fa.diagram( result)

plot3d(X, Y, Z, type = "s", col = "gray", size = 1)
v <- result$ loadings
arrow3d(p0 = c(0, 0, 0), p1 = c(v[1,1],v[2,1],v[3,1]), col = "red")
arrow3d(p0 = c(0, 0, 0), p1 = c(v[1,2],v[2,2],v[3,2]), col = "blue")