#コレスポンデンス分析
　dat<-matrix(c(123,86,96,53,62,123,104,
89,62,28,51,17,36,7,
15,45,70,68,51,46,8,
26,14,12,14,11,23,3,
58,13,7,8,8,23,17,
6,29,45,33,33,40,20,
4,26,15,26,27,25,7,
1,19,32,45,70,24,52),ncol=8,nrow=7,byrow=T, dimnames=list(c("UNIQLO","GAP","H&M","ZARA","forever21","GU","しまむら"),c("値ごろ感がある","品質が良い","トレンド感がある","リピート買いしたくなる","下着やインナーなどのアウター以外のものを買いたい","品揃えが豊富である","かわいい","知らない")))

(library(MASS))

(dat.ca<-corresp(dat,nf=3))

biplot(dat.ca)

#探索的因子分析
x <- read.delim("clipboard")

install.packages(c("lavaan","semTools","semPlot")) 

library(lavaan)
library(semTools)
library(semPlot)

factanal(x,factors=10,rotation="promax") 

#確認的因子分析
HS.model.cfa <- '
riyou=~ riyouito1 + riyouito2 + riyouito3
osyare=~ osyare1 + osyare2 + osyare3
zikohyougen=~ zikohyougen1 + zikohyougen2 + zikohyougen3
setuyaku=~setuyaku1+setuyaku2+setuyaku3
brand=~brand1+brand2+brand3
outer=~outer1+outer2+outer3
sinraisitu=~sinrai1+sinrai2+sinrai3+situ1+situ2+situ3
taninisiki=~taninisiki1+taninisiki2
doutyou=~doutyou1+doutyou2+doutyou3
sabetuka=~sabetuka1+sabetuka2+sabetuka3'

fit <- lavaan(HS.model.cfa, data=x,　 auto.var=TRUE, auto.fix.first=TRUE,auto.cov.lv.x=TRUE)
summary(fit, fit.measures=TRUE,standardized=T,rsquare=T)	
modindices(fit,sort=T)


#SEM
#測定方程式　　因子名は適当につけてok｡それと観測される変数を関連づける
HS.model.sem <- '
riyou=~ riyouito1 + riyouito2 + riyouito3
osyare=~ osyare1 + osyare2 + osyare3
zikohyougen=~ zikohyougen1 + zikohyougen2 + zikohyougen3
setuyaku=~setuyaku1+setuyaku2+setuyaku3
brand=~brand1+brand2+brand3
outer=~outer1+outer2+outer3
sinraisitu=~sinrai1+sinrai2+sinrai3+situ1+situ2+situ3
taninisiki=~taninisiki1+taninisiki2
doutyou=~doutyou1+doutyou2+doutyou3
sabetuka=~sabetuka1+sabetuka2+sabetuka3

#構造方程式　　因子間の関係は下記のように指定
riyou~osyare+setuyaku+brand+outer+sinraisitu+doutyou+sabetuka
osyare~zikohyougen+taninisiki+sex'


fit.sem <- lavaan(HS.model.sem, data=x,　 auto.var=TRUE, auto.fix.first=TRUE,auto.cov.lv.x=TRUE)
summary(fit.sem, fit.measures=TRUE,standardized=T,rsquare=T)	#結果出力

#コンジョイント分析(店舗要因)
x <- read.delim("clipboard")
install.packages("conjoint")
library(conjoint)
experiment<-expand.grid(
催事セール=c("多い","少ない"),
面積=c("広い","狭い"),
新製品入れ替えスパン=c("早い","遅い"))
design.ort<-caFactorialDesign(data=experiment,type="orthogonal")
design.ort

tprefm<-x
tprof<-caEncodedDesign(design.ort)
tlevn<-
as.matrix(c("多い","少ない","広い","狭い","早い","遅い"))
Conjoint(tprefm,tprof,tlevn)

#コンジョイント分析(製品要因)
x <- read.delim("clipboard")
experiment<-expand.grid(
機能性=c("あり","なし"),
ハイブランドとのコラボ=c("あり","なし"),
ディズニーやアニメとのコラボ=c("あり","なし"))

design.ort<-caFactorialDesign(data=experiment,type="orthogonal")
design.ort


tprefm<-x
tprof<-caEncodedDesign(design.ort)
tlevn<-
as.matrix(c("あり","なし","あり","なし","あり","なし"))
Conjoint(tprefm,tprof,tlevn)