##############################################################################
#{3́`8͎͂̕t[\tgłRŎ{邽߂̃vO
#ẽf[^́ALvOɋLڂ̂t@CɊi[̂gp
#̃t@CCAEgAꂼꉺLɋL
##############################################################################

#######3-`Afɂsꔽ#######
#ǂݍ݃f[^sec3_reg.csṽt@CCAEg
#wt
#iA̓_PȊΐ
#iẢi|̑ΐ
#iB̉i|̑ΐ
#iA̎Rςݒ{̗Li1{0{j
#iB̎Rςݒ{̗Li1{0{j

Dataset <- read.table("sec3_reg.csv", header=TRUE,sep=",", na.strings="NA", dec=".", strip.white=TRUE)
RegModel.1 <- lm(LogPI_A~Display_A+Display_B+LogPriceIndex_A+LogPriceIndex_B, data=Dataset)
summary(RegModel.1)
#######3-|A\Afɂsꔽ#######
#ǂݍ݃f[^sec3_poisson_reg.csṽt@CCAEg
#wt
#iA̔̔
#iẢi|
#iB̉i|
#iA̎Rςݒ{̗Li1{0{j
#iB̎Rςݒ{̗Li1{0{j
#Xq
Dataset <- read.table("sec3_poisson_reg.csv",header=TRUE, sep=",", na.strings="NA", dec=".", strip.white=TRUE)
##ItZbgϐȂ
GLM.2 <- glm(Sale_Unit_A ~ PriceIndex_A + PriceIndex_B + Display_A + Display_B,family=poisson(log), data=Dataset)
summary(GLM.2)
##ItZbgϐ
GLM.3 <- glm(Sale_Unit_A ~ PriceIndex_A + PriceIndex_B + Display_A + Display_B,family=poisson(log), offset=log(Visitors),data=Dataset)
summary(GLM.3)

#######4-WvWbgfɂuhIf#######
#ǂݍ݃f[^sec4_choice.csṽt@CCAEg
#plԍ
#wt
#i1̑I̗Li1I0Ij
#i2̑I̗Li1I0Ij
#i3̑I̗Li1I0Ij
#i1̉i|
#i2̉i|
#i3̉i|
#i1̎Rςݒ{̗Li1{0{j
#i2̎Rςݒ{̗Li1{0{j
#i3̎Rςݒ{̗Li1{0{j
#i1̃`Vfڂ̗Li1f0fځj
#i1̃`Vfڂ̗Li1f0fځj
#i1̃`Vfڂ̗Li1f0fځj
#
Y<-read.table("sec4_choice.csv", header=FALSE, sep=",")
#### Logit model estimation for full-model
b0<-c( 0, 0, 0, 0, 0)
fr <- function(x)
{   ## Logit model Likelihood
     b1 <- x[1]
     b2 <- x[2]
     b3<- x[3]
     b4<- x[4]
     b5<- x[5]
     LL=0
     for(i in 1:3739){
#p̌vZ
U1<-b1*log(Y[i,6]) + b2*Y[i,9]  + b3*Y[i,12] +b4
U2<-b1*log(Y[i,7]) + b2*Y[i,10]  + b3*Y[i,13] +b5
U3<-b1*log(Y[i,8]) + b2*Y[i,11] 
#Im̌vZ
PP1<-exp(U1)/(exp(U1)+exp(U2)+exp(U3))
PP2<-exp(U2)/(exp(U1)+exp(U2)+exp(U3))
PP3<-exp(U3)/(exp(U1)+exp(U2)+exp(U3))
#ΐޓx̌vZ
LLL<- Y[i,3]*log(PP1)+ Y[i,4]*log(PP2)+ Y[i,5]*log(PP3)
LL<- LL+LLL
}
return(LL)
}
#ΐޓx֐̍ő剻
res<-optim(b0,fr, method = "BFGS", hessian = TRUE, control=list(fnscale=-1))
#肳ꂽp[^
bp1<-res$par
tval1<-bp1/sqrt(-diag(solve(res$hessian)))
AIC1<- -2*res$value+2*length(res$par)
bp1
tval1
res$value
AIC1
#### Logit model estimation except flier model
b0<-c( 0, 0, 0, 0)
fr <- function(x)
{   ## Logit model Likelihood
     b1 <- x[1]
     b2 <- x[2]
     b4<- x[3]
     b5<- x[4]
     LL=0
     for(i in 1:3739){
#p̌vZ
U1<-b1*log(Y[i,6]) + b2*Y[i,9]  +b4
U2<-b1*log(Y[i,7]) + b2*Y[i,10] +b5
U3<-b1*log(Y[i,8]) + b2*Y[i,11] 
#Im̌vZ
PP1<-exp(U1)/(exp(U1)+exp(U2)+exp(U3))
PP2<-exp(U2)/(exp(U1)+exp(U2)+exp(U3))
PP3<-exp(U3)/(exp(U1)+exp(U2)+exp(U3))
#ΐޓx̌vZ
LLL<- Y[i,3]*log(PP1)+ Y[i,4]*log(PP2)+ Y[i,5]*log(PP3)
LL<- LL+LLL
}
return(LL)
}
#ΐޓx֐̍ő剻
res<-optim(b0,fr, method = "BFGS", hessian = TRUE, control=list(fnscale=-1))
#肳ꂽp[^
bp2<-res$par
tval2<-bp2/sqrt(-diag(solve(res$hessian)))
AIC2<- -2*res$value+2*length(res$par)
bp2
tval2
res$value
AIC2
#### Logit model estimation except display model
b0<-c( 0, 0, 0, 0)
fr <- function(x)
{   ## Logit model Likelihood
     b1 <- x[1]
     b3<- x[2]
     b4<- x[3]
     b5<- x[4]
     LL=0
     for(i in 1:3739){
#p̌vZ
U1<-b1*log(Y[i,6]) + b3*Y[i,12] +b4
U2<-b1*log(Y[i,7]) + b3*Y[i,13] +b5
U3<-b1*log(Y[i,8]) 
#Im̌vZ
PP1<-exp(U1)/(exp(U1)+exp(U2)+exp(U3))
PP2<-exp(U2)/(exp(U1)+exp(U2)+exp(U3))
PP3<-exp(U3)/(exp(U1)+exp(U2)+exp(U3))
#ΐޓx̌vZ
LLL<- Y[i,3]*log(PP1)+ Y[i,4]*log(PP2)+ Y[i,5]*log(PP3)
LL<- LL+LLL
}
return(LL)
}
#ΐޓx֐̍ő剻
res<-optim(b0,fr, method = "BFGS", hessian = TRUE, control=list(fnscale=-1))
#肳ꂽp[^
bp3<-res$par
tval3<-bp3/sqrt(-diag(solve(res$hessian)))
AIC3<- -2*res$value+2*length(res$par)
bp3
tval3
res$value
AIC3
#### Logit model estimation except price model
b0<-c( 0, 0, 0, 0)
fr <- function(x)
{   ## Logit model Likelihood
     b2 <- x[1]
     b3<- x[2]
     b4<- x[3]
     b5<- x[4]
     LL=0
     for(i in 1:3739){
#p̌vZ
U1<- b2*Y[i,9]  + b3*Y[i,12] +b4
U2<- b2*Y[i,10]  + b3*Y[i,13] +b5
U3<- b2*Y[i,11] 
#Im̌vZ
PP1<-exp(U1)/(exp(U1)+exp(U2)+exp(U3))
PP2<-exp(U2)/(exp(U1)+exp(U2)+exp(U3))
PP3<-exp(U3)/(exp(U1)+exp(U2)+exp(U3))
#ΐޓx̌vZ
LLL<- Y[i,3]*log(PP1)+ Y[i,4]*log(PP2)+ Y[i,5]*log(PP3)
LL<- LL+LLL
}
return(LL)
}
#ΐޓx֐̍ő剻
res<-optim(b0,fr, method = "BFGS", hessian = TRUE, control=list(fnscale=-1))
#肳ꂽp[^
bp4<-res$par
tval4<-bp4/sqrt(-diag(solve(res$hessian)))
AIC4<- -2*res$value+2*length(res$par)
bp4
tval4
res$value
AIC4
#### Logit model estimation except display and flier model
b0<-c( 0, 0, 0)
fr <- function(x)
{   ## Logit model Likelihood
     b1 <- x[1]
     b4<- x[2]
     b5<- x[3]
     LL=0
     for(i in 1:3739){
#p̌vZ
U1<-b1*log(Y[i,6]) +b4
U2<-b1*log(Y[i,7]) +b5
U3<-b1*log(Y[i,8]) 
#Im̌vZ
PP1<-exp(U1)/(exp(U1)+exp(U2)+exp(U3))
PP2<-exp(U2)/(exp(U1)+exp(U2)+exp(U3))
PP3<-exp(U3)/(exp(U1)+exp(U2)+exp(U3))
#ΐޓx̌vZ
LLL<- Y[i,3]*log(PP1)+ Y[i,4]*log(PP2)+ Y[i,5]*log(PP3)
LL<- LL+LLL
}
return(LL)
}
#ΐޓx֐̍ő剻
res<-optim(b0,fr, method = "BFGS", hessian = TRUE, control=list(fnscale=-1))
#肳ꂽp[^
bp5<-res$par
tval5<-bp5/sqrt(-diag(solve(res$hessian)))
AIC5<- -2*res$value+2*length(res$par)
bp5
tval5
res$value
AIC5
#### Logit model estimation except price and display model
b0<-c( 0, 0, 0)
fr <- function(x)
{   ## Logit model Likelihood
     b3<- x[1]
     b4<- x[2]
     b5<- x[3]
     LL=0
     for(i in 1:3739){
#p̌vZ
U1<- b3*Y[i,12] +b4
U2<- b3*Y[i,13] +b5
U3<- 0 
#Im̌vZ
PP1<-exp(U1)/(exp(U1)+exp(U2)+exp(U3))
PP2<-exp(U2)/(exp(U1)+exp(U2)+exp(U3))
PP3<-exp(U3)/(exp(U1)+exp(U2)+exp(U3))
#ΐޓx̌vZ
LLL<- Y[i,3]*log(PP1)+ Y[i,4]*log(PP2)+ Y[i,5]*log(PP3)
LL<- LL+LLL
}
return(LL)
}
#ΐޓx֐̍ő剻
res<-optim(b0,fr, method = "BFGS", hessian = TRUE, control=list(fnscale=-1))
#肳ꂽp[^
bp6<-res$par
tval6<-bp6/sqrt(-diag(solve(res$hessian)))
AIC6<- -2*res$value+2*length(res$par)
bp6
tval6
res$value
AIC6
#### Logit model estimation except price and flier model
b0<-c( 0, 0, 0)
fr <- function(x)
{   ## Logit model Likelihood
     b2 <- x[1]
     b4<- x[2]
     b5<- x[3]
     LL=0
     for(i in 1:3739){
#p̌vZ
U1<- b2*Y[i,9] + b4
U2<- b2*Y[i,10] +b5
U3<- 0 
#Im̌vZ
PP1<-exp(U1)/(exp(U1)+exp(U2)+exp(U3))
PP2<-exp(U2)/(exp(U1)+exp(U2)+exp(U3))
PP3<-exp(U3)/(exp(U1)+exp(U2)+exp(U3))
#ΐޓx̌vZ
LLL<- Y[i,3]*log(PP1)+ Y[i,4]*log(PP2)+ Y[i,5]*log(PP3)
LL<- LL+LLL
}
return(LL)
}
#ΐޓx֐̍ő剻
res<-optim(b0,fr, method = "BFGS", hessian = TRUE, control=list(fnscale=-1))
#肳ꂽp[^
bp7<-res$par
tval7<-bp7/sqrt(-diag(solve(res$hessian)))
AIC7<- -2*res$value+2*length(res$par)
bp7
tval7
res$value
AIC7
#### Logit model estimation only constant model
b0<-c( 0, 0)
fr <- function(x)
{   ## Logit model Likelihood
     b4<- x[1]
     b5<- x[2]
     LL=0
     for(i in 1:3739){
#p̌vZ
U1<-  b4
U2<-  b5
U3<-  0 
#Im̌vZ
PP1<-exp(U1)/(exp(U1)+exp(U2)+exp(U3))
PP2<-exp(U2)/(exp(U1)+exp(U2)+exp(U3))
PP3<-exp(U3)/(exp(U1)+exp(U2)+exp(U3))
#ΐޓx̌vZ
LLL<- Y[i,3]*log(PP1)+ Y[i,4]*log(PP2)+ Y[i,5]*log(PP3)
LL<- LL+LLL
}
return(LL)
}
#ΐޓx֐̍ő剻
res<-optim(b0,fr, method = "BFGS", hessian = TRUE, control=list(fnscale=-1))
#肳ꂽp[^
bp8<-res$par
tval8<-bp8/sqrt(-diag(solve(res$hessian)))
AIC8<- -2*res$value+2*length(res$par)
bp8
tval8
res$value
AIC8

#######5-ԕ̓f#######
#ǂݍ݃f[^sec5_survival.csṽt@CCAEg
#plԍ
#iID
#
#Ő؂̗Li1Ő؂Ȃ0Ő؂j
#CgtOi1Cg0ȊOj
#}`uhi1}`uh0ȊOj
#uhgi1uhg0ȊOj
#4TԎRςݒ{
#4Tԃ`Vfړ
#4Tԕϓ_PI
#ő唄
#4Tԕϒl
library(survival)
library(rms)
Dataset <- read.table("sec5_survival.csv", header=TRUE, sep=",", na.strings="NA",dec=".", strip.white=TRUE)
## Surv object쐬
s <- with(Dataset, Surv(time, status))
## Kaplan-Meier estimator
km.null <- survfit(data = Dataset, s ~ 1)
survplot(km.null,conf ="none")
## model1-wz
model1<-survreg(Surv(time, status) ~ line_ex+multi_br+br_ex+ave_disc+sum_disp+sum_flier+ave_PI+max_price, data=Dataset,dist="exponential")
summary(model1)
lines(x = predict(model1, type = "quantile", p = seq(0.01, 0.99, by=.01))[1,],
      y = rev(seq(0.01, 0.99, by = 0.01)),
      col = "red",lty=2,lwd=2)
## model2-Cuz
model2<-survreg(Surv(time, status) ~ line_ex+multi_br+br_ex+ave_disc+sum_disp+sum_flier+ave_PI+max_price, data=Dataset,dist="weibull")
summary(model2)
lines(x = predict(model2, type = "quantile", p = seq(0.01, 0.99, by=.01))[1,],
      y = rev(seq(0.01, 0.99, by = 0.01)),
      col = "blue",lty=3,,lwd=3)
## model3-ΐKz
model3<-survreg(Surv(time, status) ~ line_ex+multi_br+br_ex+ave_disc+sum_disp+sum_flier+ave_PI+max_price, data=Dataset,dist="lognormal")
summary(model3)
lines(x = predict(model3, type = "quantile", p = seq(0.01, 0.99, by=.01))[1,],
      y = rev(seq(0.01, 0.99, by = 0.01)),
      col = "green",lty=4,lwd=4)
## model4-ΐWXeBbNz
model4<-survreg(Surv(time, status) ~ line_ex+multi_br+br_ex+ave_disc+sum_disp+sum_flier+ave_PI+max_price, data=Dataset,dist="loglogistic")
summary(model4)
lines(x = predict(model4, type = "quantile", p = seq(0.01, 0.99, by=.01))[1,],
      y = rev(seq(0.01, 0.99, by = 0.01)),
      col = "pink",lty=5,,lwd=2)
legend(x = "topright",legend = c("Kaplan-Meier", "exponential", "Weibull", "Log-normal", "Log-logistic"),lty=c(2,2,3,4,5),lwd = 2, bty = "n", col = c("black", "red", "blue","green", "pink"))

#######6-݃NXf#######
#ǂݍ݃f[^sec6_mixture.csṽt@CCAEg
#plԍ
#iAw񐔁iPBAgpj
#iBw񐔁igpj
#iCw񐔁igpj
#iDw񐔁igpj
#iEw񐔁igpj
#iFw񐔁igpj
#iGw񐔁igpj
#iHw񐔁igpj
#iIw񐔁igpj
#Siw񐔁iړIϐj
#iAݖwωi|iPBAgpj
#iBݖwωi|
#iCݖwωi|
#iDݖwωi|
#iEݖwωi|
#iFݖwωi|
#iGݖwωi|
#iHݖwωi|
#iIݖwωi|
#iAݖwRςݒ{
#iBݖwRςݒ{
#iCݖwRςݒ{
#iDݖwRςݒ{
#iEݖwRςݒ{
#iFݖwRςݒ{
#iGݖwRςݒ{
#iHݖwRςݒ{
#iIݖwRςݒ{
#iAݖw`Vfړigpj
#iBݖw`Vfړigpj
#iCݖw`Vfړigpj
#iDݖw`Vfړigpj
#iEݖw`Vfړigpj
#iFݖw`Vfړigpj
#iGݖw`Vfړigpj
#iHݖw`Vfړigpj
#iIݖw`Vfړigpj
#
library(flexmix)
Dataset <- read.table("sec6_mixture.csv", header=TRUE, sep=",", na.strings="NA",dec=".", strip.white=TRUE)
##L|A\fiNX2j
out0_0_s<-stepFlexmix(Dataset$ALL~1,data=Dataset,k=2, model=FLXMRglm(family="poisson"),control=list(verb=0,iter=5000,classify="auto",minprior=0,tolerance=1e-6),nrep=50)
summary(out0_0_s)
summary(refit(out0_0_s))
##L|A\fiNX3j
out0_1_s<-stepFlexmix(Dataset$ALL~1,data=Dataset,k=3, model=FLXMRglm(family="poisson"),control=list(verb=0,iter=5000,classify="auto",minprior=0,tolerance=1e-6),nrep=50)
summary(out0_1_s)
summary(refit(out0_1_s))
##L|A\fiNX4j
out0_2_s<-stepFlexmix(Dataset$ALL~1,data=Dataset,k=4, model=FLXMRglm(family="poisson"),control=list(verb=0,iter=5000,classify="auto",minprior=0,tolerance=1e-6),nrep=50)
summary(out0_2_s)
summary(refit(out0_2_s))
##L|A\AfiNX2j
out1_0_s<-stepFlexmix(Dataset$ALL~log(Dataset$Bp)+log(Dataset$Cp)+log(Dataset$Dp)+log(Dataset$Ep)+log(Dataset$Fp)+log(Dataset$Gp)+log(Dataset$Hp)+log(Dataset$Ip),data=Dataset,k=2, model=FLXMRglm(family="poisson"),control=list(verb=0,iter=5000,classify="auto",minprior=0,tolerance=1e-6),nrep=50)
summary(out1_0_s)
summary(refit(out1_0_s))
##L|A\AfiNX3j
out1_1_s<-stepFlexmix(Dataset$ALL~log(Dataset$Bp)+log(Dataset$Cp)+log(Dataset$Dp)+log(Dataset$Ep)+log(Dataset$Fp)+log(Dataset$Gp)+log(Dataset$Hp)+log(Dataset$Ip),data=Dataset,k=3, model=FLXMRglm(family="poisson"),control=list(verb=0,iter=5000,classify="auto",minprior=0,tolerance=1e-6),nrep=50)
summary(out1_1_s)
summary(refit(out1_1_s))
##L|A\AfiNX4j
out1_2_s<-stepFlexmix(Dataset$ALL~log(Dataset$Bp)+log(Dataset$Cp)+log(Dataset$Dp)+log(Dataset$Ep)+log(Dataset$Fp)+log(Dataset$Gp)+log(Dataset$Hp)+log(Dataset$Ip),data=Dataset,k=4, model=FLXMRglm(family="poisson"),control=list(verb=0,iter=5000,classify="auto",minprior=0,tolerance=1e-6),nrep=50)
##vbg
summary(out1_2_s)
summary(refit(out1_2_s))
clusters(out1_2_s)

#######7-U\f#######
Dataset <- read.table("sec7_data.csv", header=TRUE, sep=",",na.strings="NA", dec=".", strip.white=TRUE)
library(sem)
#֍s̎Z
co_mat <- cor(Dataset[,2:26])
co_mat[upper.tri(co_mat)]<-0
#2qf
model1 <- specifyModel()
  q1  <- V, NA,  1
  q2  <- V, b12, NA
  q3  <- V, b13, NA
  q4  <- G, NA,  1
  q5  <- G, b22, NA
  q6  <- G, b23, NA
  q7  <- Ə, NA,  1
  q8  <- Ə, b32, NA
  q9  <- Ə, b33, NA
  q10 <- Ə, b34, NA
  q11 <- I, NA,  1
  q12 <- I, b42, NA
  q13 <- I, b43, NA
  q14 <- I, b44, NA
  q15 <- I, b45, NA
  q23 <- I, b46, NA
  q25 <- I, b47, NA
  q16 <- WebiIj, NA,  1
  q17 <- WebiIj, b52, NA
  q18 <- WebiIj, b53, NA
  q19 <- WebiIj, b54, NA
  q20 <- WebiIj, NA,  1
  q21 <- WebiIj, b62, NA
  q22 <- WebiIj, b63, NA
  q24 <- WebiIj, b64, NA
  q1 <-> q1, e1, NA
  q2 <-> q2, e2, NA
  q3 <-> q3, e3, NA
  q4 <-> q4, e4, NA
  q5 <-> q5, e5, NA
  q6 <-> q6, e6, NA
  q7  <-> q7, e7, NA
  q8  <-> q8, e8, NA
  q9  <-> q9, e9, NA
  q10 <-> q10, e10, NA
  q11  <-> q11, e11, NA
  q12  <-> q12, e12, NA
  q13  <-> q13, e13, NA
  q14  <-> q14, e14, NA
  q15  <-> q15, e15, NA
  q23  <-> q23, e23, NA
  q25  <-> q25, e25, NA
  q16  <-> q16, e16, NA
  q17  <-> q17, e17, NA
  q18  <-> q18, e18, NA
  q19  <-> q19, e19, NA
  q20  <-> q20, e20, NA
  q21  <-> q21, e21, NA
  q22  <-> q22, e22, NA
  q24  <-> q24, e24, NA
  V <-> V, d1,NA
  G <-> G, d2,NA
  Ə <-> Ə, d3,NA
  I <-> I, d4,NA
  WebiIj <-> WebiIj, d5,NA
  WebiIj <-> WebiIj, d6,NA
  V   <- moi, b71, NA
  G   <- moi, b72, NA
  Ə <- moi, b73, NA
  I   <- moi, b74, NA
  WebiIj<- moi, b75, NA
  WebiIj<- moi, b76, NA
  moi <-> moi, NA,1

result<-sem(model1,co_mat,N=1235)
summary(result,fit.indices=c("GFI","AGFI","RMSEA","NFI","NNFI","CFI","RFI","IFI","SRMR","AIC","AICc","BIC","CAIC"))
stdCoef(result)

#http://www.graphviz.org/Home.php@Graphviz_E[hCXg[CLłreliable2.dotǂݍ߂΁CpX}`

pathDiagram(result,file="reliable2",output.type="dot", encoding="UTF-8",ignore.double=FALSE,edge.labels="values",standardize=TRUE,digits=3,node.font=c("C:/WINDOWS/Fonts/msgothic.ttc",30))

Dataset <- read.table("sec7_data.csv", header=TRUE, sep=",",na.strings="NA", dec=".", strip.white=TRUE)
library(sem)
#֍s̎Z
co_mat <- cor(Dataset[,2:26])
co_mat[upper.tri(co_mat)]<-0
#qfiւj
model1 <- specifyModel()
  q1  <- V, NA,  1
  q2  <- V, b12, NA
  q3  <- V, b13, NA
  q4  <- G, NA,  1
  q5  <- G, b22, NA
  q6  <- G, b23, NA
  q7  <- Ə, NA,  1
  q8  <- Ə, b32, NA
  q9  <- Ə, b33, NA
  q10 <- Ə, b34, NA
  q11 <- I, NA,  1
  q12 <- I, b42, NA
  q13 <- I, b43, NA
  q14 <- I, b44, NA
  q15 <- I, b45, NA
  q23 <- I, b46, NA
  q25 <- I, b47, NA
  q16 <- WebiIj, NA,  1
  q17 <- WebiIj, b52, NA
  q18 <- WebiIj, b53, NA
  q19 <- WebiIj, b54, NA
  q20 <- WebiIj, NA,  1
  q21 <- WebiIj, b62, NA
  q22 <- WebiIj, b63, NA
  q24 <- WebiIj, b64, NA
  q1 <-> q1, e1, NA
  q2 <-> q2, e2, NA
  q3 <-> q3, e3, NA
  q4 <-> q4, e4, NA
  q5 <-> q5, e5, NA
  q6 <-> q6, e6, NA
  q7  <-> q7, e7, NA
  q8  <-> q8, e8, NA
  q9  <-> q9, e9, NA
  q10 <-> q10, e10, NA
  q11  <-> q11, e11, NA
  q12  <-> q12, e12, NA
  q13  <-> q13, e13, NA
  q14  <-> q14, e14, NA
  q15  <-> q15, e15, NA
  q23  <-> q23, e23, NA
  q25  <-> q25, e25, NA
  q16  <-> q16, e16, NA
  q17  <-> q17, e17, NA
  q18  <-> q18, e18, NA
  q19  <-> q19, e19, NA
  q20  <-> q20, e20, NA
  q21  <-> q21, e21, NA
  q22  <-> q22, e22, NA
  q24  <-> q24, e24, NA
  V <-> V, NA,1
  G <-> G, NA,1
  Ə <-> Ə, NA,1
  I <-> I, NA,1
  WebiIj <-> WebiIj, NA,1
  WebiIj <-> WebiIj, NA,1
  V <-> G,  c1, NA
  V <-> Ə,c2, NA
  V <-> I,    c3, NA
  V <-> WebiIj, c4, NA
  V <-> WebiIj, c5, NA
  G  <-> Ə,c6, NA
  G  <-> I,    c7, NA
  G  <-> WebiIj, c8, NA
  G  <-> WebiIj, c9, NA
  Ə<-> I,    c10,NA
  Ə<-> WebiIj, c11,NA  
  Ə<-> WebiIj, c12,NA 
  WebiIj <-> WebiIj, c13,NA 

result<-sem(model1,co_mat,N=1235)
summary(result,fit.indices=c("GFI","AGFI","RMSEA","NFI","NNFI","CFI","RFI","IFI","SRMR","AIC","AICc","BIC","CAIC"))
stdCoef(result)

#http://www.graphviz.org/Home.php@Graphviz_E[hCXg[CLłreliable1.dotǂݍ߂΁CpX}`

pathDiagram(result,file="reliable1",output.type="dot",encoding="UTF-8",ignore.double=FALSE,edge.labels="values",same.rank=c("V,G,Ə,I,WebiIj,WebiIj"),standardize=TRUE,digits=3,node.font=c("C:/WINDOWS/Fonts/msgothic.ttc",30))

#######8-KwxCYf#######
#ǂݍ݃f[^sec8_data1.csṽt@CCAEg
#plԍ
#wt
#i1I̗Li1I0Ij
#i2I̗Li1I0Ij
#i3I̗Li1I0Ij
#Iiԍi1or2or3j
#i1i|
#i2i|
#i3i|
#i1Rςݒ{̗L(1{0{j
#i2Rςݒ{̗L(1{0{j
#i3Rςݒ{̗L(1{0{j
#i1`Vfڂ̗L(1f0fځj
#i2`Vfڂ̗L(1f0fځj
#i3`Vfڂ̗L(fڎтȂDׂ0j
#
#ǂݍ݃f[^sec8_data2.csṽt@CCAEg
#plԍ
#N
#Ƒl
#
Dat1 <- read.table("sec8_data1.csv", header=TRUE, sep=",", na.strings="NA",dec=".",strip.white=TRUE)
IndAttr <- read.table("sec8_data2.csv", header=TRUE, sep=",", na.strings="NA",dec=".",strip.white=TRUE)
IndAttr[,1]=IndAttr$age
IndAttr[,2]=IndAttr$family
#MCMC̐ݒ
library(bayesm)
#fPtf
R=50000
keep=1
#l
reg=levels(factor(Dat1$PNL))
nreg=length(reg)
#I
p=3
#Iʕϐ
na=3
#l
nz=2
#lƃf[^̍쐬
lgtdata=NULL
for (j in 1:nreg){
y=Dat1$Choice[Dat1$PNL==reg[j]]
Xa<-cbind(Dat1$Price1[Dat1$PNL==reg[j]],Dat1$Price2[Dat1$PNL==reg[j]],Dat1$Price3[Dat1$PNL==reg[j]],Dat1$Disp1[Dat1$PNL==reg[j]],Dat1$Disp2[Dat1$PNL==reg[j]],Dat1$Disp3[Dat1$PNL==reg[j]],Dat1$Ad1[Dat1$PNL==reg[j]],Dat1$Ad2[Dat1$PNL==reg[j]],Dat1$Ad3[Dat1$PNL==reg[j]])
X=createX(p,na=na,nd=NULL,Xa=Xa,Xd=NULL,DIFF=FALSE,base=3)
lgtdata[[j]]=list(y=y,X=X)
}
Z=NULL
Z=as.matrix(IndAttr)
Z=t(t(Z)-apply(Z,2,mean))
Data3=list(p=p,lgtdata=lgtdata,Z=Z)
Prior3=list(ncomp=1)

Mcmc3=list(R=R,keep=1)
#
set.seed(66)
out3=rhierMnlRwMixture(Data=Data3,Mcmc=Mcmc3,Prior=Prior3)
#DIC̎Z
PD <- max((out3$loglike)[-(1:45000)])-mean((out3$loglike)[-(1:45000)])
DIC <- -2*mean(out3$loglike)+2*PD
print(DIC)

s=45001
t=50000
beta.mean<-matrix(0,nrow=nreg,ncol=5)
for(i in 1:nreg){beta.mean[i,1]<-mean(out3$betadraw[i,1,s:t])}
for(i in 1:nreg){beta.mean[i,2]<-mean(out3$betadraw[i,2,s:t])}
for(i in 1:nreg){beta.mean[i,3]<-mean(out3$betadraw[i,3,s:t])}
for(i in 1:nreg){beta.mean[i,4]<-mean(out3$betadraw[i,4,s:t])}
for(i in 1:nreg){beta.mean[i,5]<-mean(out3$betadraw[i,5,s:t])}
beta.sd<-matrix(0,nrow=nreg,ncol=5)
for(i in 1:j){beta.sd[i,1]<-sd(out3$betadraw[i,1,s:t])}
for(i in 1:j){beta.sd[i,2]<-sd(out3$betadraw[i,2,s:t])}
for(i in 1:j){beta.sd[i,3]<-sd(out3$betadraw[i,3,s:t])}
for(i in 1:j){beta.sd[i,4]<-sd(out3$betadraw[i,4,s:t])}
for(i in 1:j){beta.sd[i,5]<-sd(out3$betadraw[i,5,s:t])}
beta.t<-matrix(0,nrow=nreg,ncol=5)
for(i in 1:nreg){beta.t[i,1]<-beta.mean[i,1]/beta.sd[i,1]}
for(i in 1:nreg){beta.t[i,2]<-beta.mean[i,2]/beta.sd[i,2]}
for(i in 1:nreg){beta.t[i,3]<-beta.mean[i,3]/beta.sd[i,3]}
for(i in 1:nreg){beta.t[i,4]<-beta.mean[i,4]/beta.sd[i,4]}
for(i in 1:nreg){beta.t[i,5]<-beta.mean[i,5]/beta.sd[i,5]}
beta.mean
beta.sd
beta.t
Delta.mean<-matrix(0,nrow=1,ncol=10)
for(i in 1:10){Delta.mean[1,i]<-mean(out3$Deltadraw[s:t,i])}
Delta.SD<-matrix(0,nrow=1,ncol=10)
for(i in 1:10){Delta.SD[1,i]<-sd(out3$Deltadraw[s:t,i])}
Delta.t<-matrix(0,nrow=1,ncol=10)
for(i in 1:10){Delta.t[1,i]<-Delta.mean[1,i]/Delta.SD[1,i]}
Delta.mean
Delta.SD
Delta.t

#fQ`Vf
R=50000
keep=1
#l
reg=levels(factor(Dat1$PNL))
nreg=length(reg)
#I
p=3
#Iʕϐ
na=2
#l
nz=2
#lƃf[^̍쐬
lgtdata=NULL
for (j in 1:nreg){
y=Dat1$Choice[Dat1$PNL==reg[j]]
Xa<-cbind(Dat1$Price1[Dat1$PNL==reg[j]],Dat1$Price2[Dat1$PNL==reg[j]],Dat1$Price3[Dat1$PNL==reg[j]],Dat1$Disp1[Dat1$PNL==reg[j]],Dat1$Disp2[Dat1$PNL==reg[j]],Dat1$Disp3[Dat1$PNL==reg[j]])
X=createX(p,na=na,nd=NULL,Xa=Xa,Xd=NULL,DIFF=FALSE,base=3)
lgtdata[[j]]=list(y=y,X=X)
}
Z=NULL
Z=as.matrix(IndAttr)
Z=t(t(Z)-apply(Z,2,mean))
Data3=list(p=p,lgtdata=lgtdata,Z=Z)
Prior3=list(ncomp=3)

Mcmc3=list(R=R,keep=1)
#
set.seed(66)
out3=rhierMnlRwMixture(Data=Data3,Mcmc=Mcmc3,Prior=Prior3)
#DIC̎Z
PD <- max((out3$loglike)[-(1:45000)])-mean((out3$loglike)[-(1:45000)])
DIC <- -2*mean(out3$loglike)+2*PD
print(DIC)

#f3Ghf
R=50000
keep=1
#l
reg=levels(factor(Dat1$PNL))
nreg=length(reg)
#I
p=3
#Iʕϐ
na=2
#l
nz=2
#lƃf[^̍쐬
lgtdata=NULL
for (j in 1:nreg){
y=Dat1$Choice[Dat1$PNL==reg[j]]
Xa<-cbind(Dat1$Price1[Dat1$PNL==reg[j]],Dat1$Price2[Dat1$PNL==reg[j]],Dat1$Price3[Dat1$PNL==reg[j]],Dat1$Ad1[Dat1$PNL==reg[j]],Dat1$Ad2[Dat1$PNL==reg[j]],Dat1$Ad3[Dat1$PNL==reg[j]])
X=createX(p,na=na,nd=NULL,Xa=Xa,Xd=NULL,DIFF=FALSE,base=3)
lgtdata[[j]]=list(y=y,X=X)
}
Z=NULL
Z=as.matrix(IndAttr)
Z=t(t(Z)-apply(Z,2,mean))
Data3=list(p=p,lgtdata=lgtdata,Z=Z)
Prior3=list(ncomp=1)

Mcmc3=list(R=R,keep=1)
#
set.seed(66)
out3=rhierMnlRwMixture(Data=Data3,Mcmc=Mcmc3,Prior=Prior3)
#DIC̎Z
PD <- max((out3$loglike)[-(1:45000)])-mean((out3$loglike)[-(1:45000)])
DIC <- -2*mean(out3$loglike)+2*PD
print(DIC)

summary(out3$Deltadraw)
summary(t(out3$betadraw[1,,]),burnin=45000)
plot(out3$Deltadraw)
plot(out3$betadraw)
#######8-ԋԃf#######
#ǂݍ݃f[^sec8_DLM.csṽt@CCAEg
#wt
#iA̓_PȊΐ
#iẢi|̑ΐ
#iB̉i|̑ΐ
#iA̎Rςݒ{̗Li1{0{j
#iB̎Rςݒ{̗Li1{0{j
#
Dataset <- read.table("sec8_DLM.csv", header=TRUE,sep=",", na.strings="NA", dec=".", strip.white=TRUE)
library(dlm)
#tfif1j
y<-Dataset$LogPI_A
x<-cbind(Dataset$LogPriceIndex_A,Dataset$LogPriceIndex_B,Dataset$Display_A,Dataset$Display_B)
buildModel <- function(params){
  #dlmModRegɂ͐ϐ
  mod1 <- dlmModReg(x, dV = exp(params[1]), dW = exp(params[2:6]))
  return(mod1)
}
outMLE1 <- dlmMLE(y,rep(0, 6),buildModel,method = "L-BFGS-B",hessian=T,control = list(maxit = 1000,trace=1))
outMLE1$convergence
avar<-solve(outMLE1$hessian)
outMLE1$par
outMLE1$value
exp(outMLE1$par)
sqrt(diag(avar))
mod1 <- buildModel(outMLE1$par)
mod.filt1<-dlmFilter(y,mod1)
#Œԕ
mod.smooth1 <- dlmSmooth(mod.filt1)
a1<-dropFirst(mod.smooth1$s[,1])
a2<-dropFirst(mod.smooth1$s[,2])
a3<-dropFirst(mod.smooth1$s[,3])
a4<-dropFirst(mod.smooth1$s[,4])
a5<-dropFirst(mod.smooth1$s[,5])
#̃Ot
par(mfrow=c(3,2)) 
plot(a1,type="l",xlab="days",ylab="beta_0" ,ylim=c(-0.5,0.3))
plot(a2,type="l",xlab="days",ylab="beta_1",ylim=c(-12,-3))
plot(a3,type="l",xlab="days",ylab="beta_2",ylim=c(0.8,2))
plot(a4,type="l",xlab="days",ylab="beta_3",ylim=c(0.3,1.2))
plot(a5,type="l",xlab="days",ylab="beta_4",ylim=c(-0.11,0))
#g̐ϐif2j
y<-Dataset$LogPI_A
x<-cbind(Dataset$LogPriceIndex_A,Dataset$Display_A)
buildModel <- function(params){
  #dlmModRegɂ͐ϐ
  mod2 <- dlmModReg(x, dV = exp(params[1]), dW = exp(params[2:4]))
  return(mod2)
}
outMLE2 <- dlmMLE(y,rep(0, 4),buildModel,method = "L-BFGS-B",hessian=T,control = list(maxit = 1000,trace=1))
outMLE2$convergence
avar<-solve(outMLE2$hessian)
outMLE2$par
outMLE2$value
exp(outMLE2$par)
sqrt(diag(avar))
#tf|̃Ghif3j
y<-Dataset$LogPI_A
x<-cbind(Dataset$LogPriceIndex_A,Dataset$LogPriceIndex_B,Dataset$Display_A)
buildModel <- function(params){
  #dlmModRegɂ͐ϐ
  mod3 <- dlmModReg(x, dV = exp(params[1]), dW = exp(params[2:5]))
  return(mod3)
}
outMLE3 <- dlmMLE(y,rep(0, 5),buildModel,method = "L-BFGS-B",hessian=T,control = list(maxit = 1000,trace=1))
outMLE3$convergence
avar<-solve(outMLE3$hessian)
outMLE3$par
outMLE3$value
exp(outMLE3$par)
sqrt(diag(avar))
mod3 <- buildModel(outMLE3$par)
mod.filt3<-dlmFilter(y,mod3)
#Œԕ
mod.smooth3 <- dlmSmooth(mod.filt3)
a1<-dropFirst(mod.smooth3$s[,1])
a2<-dropFirst(mod.smooth3$s[,2])
a3<-dropFirst(mod.smooth3$s[,3])
a4<-dropFirst(mod.smooth3$s[,4])
#̃Ot
par(mfrow=c(2,2)) 
plot(a1,type="l",xlab="days",ylab="beta_0" ,ylim=c(-0.5,0.3))
plot(a2,type="l",xlab="days",ylab="beta_1",ylim=c(-12,-3))
plot(a3,type="l",xlab="days",ylab="beta_2",ylim=c(0.8,2))
plot(a4,type="l",xlab="days",ylab="beta_3",ylim=c(0.3,1.2))
#tf|iif4j
y<-Dataset$LogPI_A
x<-cbind(Dataset$LogPriceIndex_A,Dataset$Display_A,Dataset$Display_B)
buildModel <- function(params){
  #dlmModRegɂ͐ϐ
  mod4 <- dlmModReg(x, dV = exp(params[1]), dW = exp(params[2:5]))
  return(mod4)
}
outMLE4 <- dlmMLE(y,rep(0, 5),buildModel,method = "L-BFGS-B",hessian=T,control = list(maxit = 1000,trace=1))
outMLE4$convergence
avar<-solve(outMLE4$hessian)
outMLE4$par
outMLE4$value
exp(outMLE4$par)
sqrt(diag(avar))

