#-- 11章 因子分析 --#

#-- 例題
library(psych)

# 相関係数
round(cor(data),digits=3)

# 因子数
print(KMO(data),digits=3)

eigen(cor(data))

cor<- cor(data, use="complete.obs")
fa.parallel(cor, n.obs=15, fa="fa")

# 因子分析
res1<- fa(data, nfactors=2, fm="ml", rotate="none")
print(res1, digits=3)

res2<- fa(data, nfactors=2, fm="ml", rotate="varimax")
print(res2, digits=3)

res3<- fa(data, nfactors=2, fm="ml", rotate="Promax")
print(res3, digits=3)

# 因子負荷量
par(mfrow=c(1,3))
FL1<-res1$loadings[,1]
FL2<-res1$loadings[,2]
plot(FL1,FL2,type="n",xlab="因子1: 品質重視",ylab="因子2: 価格重視",main="回転なし",xlim=c(-1,1), ylim=c(-1,1), xaxp=c(-1,1,4), yaxp=c(-1,1,4))
arrows(0,0,FL1,FL2,length=0.08)
text(FL1,FL2,colnames(data))
abline(0,0,0,0)

FL1<-res2$loadings[,2]
FL2<-res2$loadings[,1]
plot(FL1,FL2,type="n",xlab="因子1: 品質重視",ylab="因子2: 価格重視",main="バリマックス回転")
arrows(0,0,FL1,FL2,length=0.08)
text(FL1,FL2,colnames(data))
abline(0,0,0,0)

FL1<-res3$loadings[,1]
FL2<-res3$loadings[,2]
plot(FL1,FL2,type="n",xlab="因子1: 品質重視",ylab="因子2: 価格重視",main="プロマックス回転")
arrows(0,0,FL1,FL2,length=0.08)
text(FL1,FL2,colnames(data))
abline(0,0,0,0)

# ポジショニングマップ
FS<- res3$scores
k<- floor(max(abs(FS)))+0.2
par(pty ="s")
plot(FS[,1],FS[,2],pch=20,xlab="品質重視",ylab="価格重視",xlim=c(-k,k), ylim=c(-k,k))
abline(0,0,0,0)


#-- 実践例
library(car)
library(psych)
library(texreg)

# 相関係数
round(cor(data[2:10]),digits=3)

# 因子数
cor<- cor(data[2:10], use="complete.obs")
fa.parallel(cor, n.obs=336, fa="fa")
eigen(cor(data[2:10]))$values

# 因子分析
res<- fa(data[2:10], nfactors=3, fm="ml", rotate="Promax")
print(res, digits=3)

# 回帰分析
ndat<- cbind(data,res$scores)

res1<- lm(q3_1_2~age+gender+money+ML1+ML3+ML2,data=ndat)
summary(res1)
AIC(res1)
vif(res1)

res2<- lm(q3_1_5~age+gender+money+ML1+ML3+ML2,data=ndat)
summary(res2)
AIC(res2)
vif(res2)

screenreg(list(res1,res2),digits=3)



-----

meanFS<-aggregate(x=FS,by=list(Brand),FUN=mean)
meanFS

k<-round(max(abs(meanFS[,2:3])),digit=1)+0.2
par(pty="s")
plot(meanFS$ML1,meanFS$ML2,pch=20,col="red",xlab="Factor1",ylab="Factor2",xlim=c(-k,k), ylim=c(-k,k))
abline(0,0,0,0)
pointLabel(x=meanFS$ML1,y=meanFS$ML2,labels=Bname)