#コレスポンデンス分析
x <- read.table("clipboard", header=TRUE, row.names=1) 
library(MASS)
x.co <- corresp(x, nf=2)
x.co
par(family="Osaka", ps=15)
biplot(x.co)

#探索的因子分析
X <- read.delim("clipboard")
factanal(X,factors=10,rotation="promax")

#確認的因子分析
KK.model.cfa <- ' 
f1 =~ etsuran
f2 =~ micetsuito + mickyoumi
f3 =~ micmane
f4 =~ micshare
f5 =~ hikaku1 +hikaku2 + hikaku3
f6 =~ akoga1 + akoga2 + akoga3
f7 =~ kyotsu2 + kyotsu3
f8 =~ kanren1 + kanren2 + kanren3
f9 =~ comu2 + comu3 + comu4
f10 =~ jt1 + jt2 + jt3 
f11 =~ shinrai1 + shinrai2 
f12 =~ sex'
library(lavaan) 
fit0 <-cfa(model=KK.model.cfa,data=X,estimator="ML")
summary(fit0, fit.measures=TRUE,standardized=T,rsquare=T)


#共分散構造分析
KK.model.sem <- '
f1 =~ etsuran
f2 =~ micetsuito + mickyoumi
f3 =~ micmane
f4 =~ micshare
f5 =~ hikaku1 +hikaku2 + hikaku3
f6 =~ akoga1 + akoga 2 + akoga 3
f7 =~ kyotsu2 + kyotsu3
f8 =~ kanren1 + kanren2 + kanren3
f9 =~ comu2 + comu3 + comu4
f10 =~ jt1 + jt2 + jt3 
f11 =~ shinrai1 + shinrai2
f12 =~ sex
f2 ~ f1
f2 ~ f5
f2 ~ f6
f2 ~ f7
f2 ~ f8
f2 ~ f9
f2 ~ f10
f2 ~ f11
f2 ~ f12
f3 ~ f8
f3 ~ f10
f4 ~ f8
f4 ~ f11
f4 ~ f12
f3 ~ f2
f4 ~ f2'
library(lavaan)
fit  <-sem(model=KK.model.sem, data=X, estimator="ML") 
summary(object=fit)
summary(fit, fit.measures=TRUE,standardized=T,rsquare=T)


#コンジョイント分析
library(conjoint)
experiment<-expand.grid(
pr =c("あり","なし"), 
keiken =c("あり","なし"), 
tag =c("あり","なし"), 
kouzu=c("スナップ","全身","商品のみ","商品とアイテム"),
effect=c("あり","なし"))
design <- caFactorialDesign(data=experiment,type="orthogonal")
design
caEncodedDesign(design)
cor(caEncodedDesign(design))
x <- read.table("clipboard", header=TRUE, row.names=1)
tprefm<- x
tprof<-caEncodedDesign(design)
tlevn<-as.matrix(c(" prあり"," prなし"," 購入経験あり"," 購入経験なし","#あり","#なし","スナップ","全身","商品のみ","商品とアイテム", "エフェクトあり","エフェクトなし"))
Conjoint(tprefm,tprof,tlevn)