Hi,
Thank you very much for the reply. Please see my code below:
### Description of variables
#Choice variable: binary: Status quo (SQ or S), Alternatives (Alt or A)
#Attributes: WeaAbsLin SpeAbsLin NatAbsLin Levy
#Explanatory variables: HHsize, IncCat_Mid, IncCat_High
#Indicator variable: attitude_Epl (rank 1 to 7)
### Clear memory
rm(list = ls())
#### LOAD DATA AND APPLY ANY TRANSFORMATIONS ####
# ################################################################# #
### Load Apollo library
#install.packages("apollo", repos = "
http://cran.us.r-project.org")
library(apollo)
### Initialise code
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "hybrid_model_WTP",
modelDescr = "Hybrid choice model on LCF_WTP",
indivID = "id",
mixing = TRUE,
nCores = 25
)
load("database.RData")
# ################################################################# #
# ################################################################# #
#### ANALYSIS OF CHOICES ####
# ################################################################# #
choiceAnalysis_settings <- list(
alternatives = c(SQ="S",Alt="A"),
avail = list(SQ=1, Alt=1),
choiceVar = database$Choice,
explanators = database[,c("HHsize", "IncCat_Mid", "IncCat_High" )]
)
apollo_choiceAnalysis(choiceAnalysis_settings, apollo_control, database)
# ################################################################# #
#### DEFINE MODEL PARAMETERS ####
# ################################################################# #
### Vector of parameters, including any that are kept fixed in estimation
### Vector of parameters, including any that are kept fixed in estimation
apollo_beta <- c(b_Wea = 0,
b_Spe = 0,
b_Nat = 0,
b_Levy = 0,
b_IncMid = 0,
b_IncHigh = 0,
gamma_Wea_HHsize = 0,gamma_Spe_HHsize = 0,
gamma_Nat_HHsize = 0,
gamma_Wea_MidI = 0,gamma_Spe_MidI = 0,
gamma_Nat_MidI = 0,
gamma_Wea_HighI = 0,gamma_Spe_HighI = 0,
gamma_Nat_HighI = 0,
gamma_LV_HHsize = 0, gamma_LV_MidI = 0,
gamma_LV_HighI = 0,
mu_log_asc = 0,
sigma_log_asc = 1,lambda= 1,
zeta_Epl=1,
tau_Epl_1 =-3, tau_Epl_2 =-3,
tau_Epl_3 = -1, tau_Epl_4 = 1,tau_Epl_5 = 2,
tau_Epl_6 = 3
)
apollo_fixed <- c("mu_log_asc", "sigma_log_asc")
# ################################################################# #
#### DEFINE RANDOM COMPONENTS ####
# ################################################################# #
### Set parameters for generating draws
apollo_draws = list(
interDrawsType="halton",
interNDraws=500,
interNormDraws=c("draws_asc_inter","eta")
)
### Create random parameters
apollo_randCoeff <- function(apollo_beta, apollo_inputs) {
randcoef <- list()
randcoef[['asc']] <- mu_log_asc + b_IncMid * (IncCat=='Mid') + b_IncHigh * (IncCat=='High')-sigma_log_asc*draws_asc_inter
randcoef[["LV"]] = gamma_LV_HHsize*HHsize + gamma_LV_MidI*IncCat_Mid+ gamma_LV_HighI*IncCat_High + eta
return(randcoef)
}
# ################################################################# #
#### GROUP AND VALIDATE INPUTS ####
# ################################################################# #
apollo_inputs = apollo_validateInputs()
# ################################################################# #
#### DEFINE MODEL AND LIKELIHOOD FUNCTION ####
# ################################################################# #
#options(expressions=500000) ## avoid "node stack overflow" error
apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){
### Attach inputs and detach after function exit
apollo_attach(apollo_beta, apollo_inputs)
on.exit(apollo_detach(apollo_beta, apollo_inputs))
### Create list of probabilities P
P = list()
### Create alternative specific constants
asc_SQ_value = 0
asc_Alt_value = asc
### Likelihood of choices
### List of utilities: these must use the same names as in mnl_settings, order is irrelevant
V <- list()
V[['SQ']] <- asc_SQ_value +
b_Wea * WeaAbsLin_S + b_Spe * SpeAbsLin_S + b_Nat * NatAbsLin_S+ lambda*LV
V[['Alt']] <- asc_Alt_value +
b_Wea * WeaAbsLin_A + b_Spe * SpeAbsLin_A + b_Nat* NatAbsLin_A + b_Levy * Lev_A + lambda*LV
### Define settings for MNL model component
mnl_settings = list(
alternatives = c(SQ="S",Alt="A"),
avail = list(SQ=1, Alt=1),
choiceVar = Choice,
V = V
)
### initial values of beta: when I use this I find error message "node stack overflow"
#apollo_beta=apollo_searchStart(apollo_beta, apollo_fixed,apollo_probabilities, apollo_inputs)
#apollo_beta=apollo_bootstrap(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
### Compute probabilities for MNL model component
P[["Choice"]] = apollo_mnl(mnl_settings, functionality)
### Likelihood of indicators
ol_settings1 = list(outcomeOrdered=attitude_Epl,
V=zeta_Epl*LV,
tau=c(tau_Epl_1, tau_Epl_2, tau_Epl_3, tau_Epl_4,tau_Epl_5,tau_Epl_6),
rows=(task==1))
P[["indic_Epl"]] = apollo_ol(ol_settings1, functionality)
### Likelihood of the whole model
P = apollo_combineModels(P, apollo_inputs, functionality)
### Take product across observation for same individual
P = apollo_panelProd(P, apollo_inputs, functionality)
### Average across inter-individual draws
P = apollo_avgInterDraws(P, apollo_inputs, functionality)
### Prepare and return outputs of function
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
# ################################################################# #
#### CHECK FOR COMPUTATIONAL REQUIREMENTS ####
# ################################################################# #
speedTest_settings=list(
nDrawsTry = c(250, 500, 1000),
nCoresTry = 1:3,
nRep = 10
)
apollo_speedTest(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs, speedTest_settings)
# ################################################################# #
#### MODEL ESTIMATION ####
# ################################################################# #
### Estimate model
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
# ################################################################# #
#### MODEL OUTPUTS ####
# ################################################################# #
# ----------------------------------------------------------------- #
#---- FORMATTED OUTPUT (TO SCREEN) ----
# ----------------------------------------------------------------- #
apollo_modelOutput(model)
# ----------------------------------------------------------------- #
#---- FORMATTED OUTPUT (TO FILE, using model name) ----
# ----------------------------------------------------------------- #
apollo_saveOutput(model)