ApolloChoiceModelling forum

### Clear memory
rm(list = ls())

### Load Apollo library
library(apollo)

### Initialise code
apollo_initialise()

### Set core controls
apollo_control = list(
modelName = "Ordered HCM 4(3)",
modelDescr = "Hybrid choice model on drug choice data, using ordered measurement model for indicators",
indivID = "Person_ID",
mixing = TRUE,
nCores = 24,
outputDirectory = "New"
)
setwd("")

getwd()

database = read.csv("",header=TRUE)


apollo_beta = c(# alternate specific attributes
asc_CV = 0,
asc_EV = 0,
b_pp = 0,
b_oc = 0,
b_ct = 0,

# socio-demographic characteristic
gamma_Male_socIma = 0,
gamma_female_socIma = 0,
gamma_dailyDistanceAvg_socIma = 0,
gamma_Male_envEnth = 0,
gamma_female_envEnth = 0,
gamma_dailyDistanceAvg_envEnth = 0,

# Latent variable_1 (it has 4 indicatos)
lambda_socIma = 1,
sigma_eta_socIma =-3,
zeta_socIma_1 = 1,
zeta_socIma_2 = 1,
zeta_socIma_3 = 1,
zeta_socIma_4 = 1,
constant_socIma_1 = 0,
constant_socIma_2 = 0,
constant_socIma_3 = 0,
constant_socIma_4 = 0,
tau_socIma_1_1 = 0,
tau_socIma_1_2 = 5,
tau_socIma_1_3 = 7,
tau_socIma_1_4 = 9,
tau_socIma_2_1 = 0,
tau_socIma_2_2 = 5,
tau_socIma_2_3 = 7,
tau_socIma_2_4 = 9,
tau_socIma_3_1 = 0,
tau_socIma_3_2 = 5,
tau_socIma_3_3 = 7,
tau_socIma_3_4 = 9,
tau_socIma_4_1 = 0,
tau_socIma_4_2 = 5,
tau_socIma_4_3 = 7,
tau_socIma_4_4 = 9,

#Latent variable_2 (it has 3 indicators)
lambda_envEnth = 1,
sigma_eta_envEnth =-3,
zeta_envEnth_1 = 1,
zeta_envEnth_2 = 1,
zeta_envEnth_3 = 1,
constant_envEnth_1 = 0,
constant_envEnth_2 = 0,
constant_envEnth_3 = 0,
tau_envEnth_1_1 = 0,
tau_envEnth_1_2 = 5,
tau_envEnth_1_3 = 7,
tau_envEnth_1_4 = 9,
tau_envEnth_2_1 = 0,
tau_envEnth_2_2 = 5,
tau_envEnth_2_3 = 7,
tau_envEnth_2_4 = 9,
tau_envEnth_3_1 = 0,
tau_envEnth_3_2 = 5,
tau_envEnth_3_3 = 7,
tau_envEnth_3_4 = 9)

apollo_fixed = c("asc_CV","gamma_female_socIma","gamma_female_envEnth","tau_socIma_1_1","tau_socIma_2_1","tau_socIma_3_1","tau_socIma_4_1","zeta_socIma_1","tau_envEnth_1_1","tau_envEnth_2_1","tau_envEnth_3_1","zeta_envEnth_1")

# ################################################################# #
#### DEFINE RANDOM COMPONENTS ####
# ################################################################# #

### Set parameters for generating draws
apollo_draws = list(
interDrawsType="halton",
interNDraws=100,
interUnifDraws=c(),
interNormDraws=c("eta_socIma","eta_envEnth"),

intraDrawsType="",
intraNDraws=0,
intraUnifDraws=c(),
intraNormDraws=c()
)


### Create random parameters
apollo_randCoeff=function(apollo_beta, apollo_inputs){
randcoeff = list()


randcoeff[["LV_socIma"]] = gamma_Male_socIma*genderCoded + gamma_dailyDistanceAvg_socIma*dailyDistanceAvg + sigma_eta_socIma*eta_socIma
randcoeff[["LV_envEnth"]] = gamma_Male_envEnth*genderCoded + gamma_dailyDistanceAvg_envEnth*dailyDistanceAvg + sigma_eta_envEnth*eta_envEnth

return(randcoeff)
}

# ################################################################# #
#### GROUP AND VALIDATE INPUTS ####
# ################################################################# #

apollo_inputs = apollo_validateInputs()

# ################################################################# #
#### DEFINE MODEL AND LIKELIHOOD FUNCTION ####
# ################################################################# #

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()

### Likelihood of indicators
ol_settings1 = list(outcomeOrdered = socIma_1,
V = constant_socIma_1 + zeta_socIma_1*LV_socIma,
tau = list(tau_socIma_1_1, tau_socIma_1_2, tau_socIma_1_3, tau_socIma_1_4),
#rows = (task==1),
componentName = "indic_socIma_1")
ol_settings2 = list(outcomeOrdered = socIma_2,
V = constant_socIma_2 + zeta_socIma_2*LV_socIma,
tau = list(tau_socIma_2_1, tau_socIma_2_2, tau_socIma_2_3, tau_socIma_2_4),
#rows = (task==1),
componentName = "indic_socIma_2")
ol_settings3 = list(outcomeOrdered = socIma_3,
V = constant_socIma_3 + zeta_socIma_3*LV_socIma,
tau = list(tau_socIma_3_1, tau_socIma_3_2, tau_socIma_3_3, tau_socIma_3_4),
#rows = (task==1),
componentName = "indic_socIma_3")
ol_settings4 = list(outcomeOrdered = socIma_4,
V = constant_socIma_4 + zeta_socIma_4*LV_socIma,
tau = list(tau_socIma_4_1, tau_socIma_4_2, tau_socIma_4_3, tau_socIma_4_4),
#rows = (task==1),
componentName = "indic_socIma_4")
ol_settings5 = list(outcomeOrdered = envEnth_1,
V = constant_envEnth_1 + zeta_envEnth_1*LV_envEnth,
tau = list(tau_envEnth_1_1, tau_envEnth_1_2, tau_envEnth_1_3, tau_envEnth_1_4),
#rows = (task==1),
componentName = "indic_envEnth_1")
ol_settings6 = list(outcomeOrdered = envEnth_2,
V = constant_envEnth_2 + zeta_envEnth_2*LV_envEnth,
tau = list(tau_envEnth_2_1, tau_envEnth_2_2, tau_envEnth_2_3, tau_envEnth_2_4),
#rows = (task==1),
componentName = "indic_envEnth_2")
ol_settings7 = list(outcomeOrdered = envEnth_3,
V = constant_envEnth_3 + zeta_envEnth_3*LV_envEnth,
tau = list(tau_envEnth_3_1, tau_envEnth_3_2, tau_envEnth_3_3, tau_envEnth_3_4),
#rows = (task==1),
componentName = "indic_envEnth_3")


P[["indic_socIma_1"]] = apollo_ol(ol_settings1, functionality)
P[["indic_socIma_2"]] = apollo_ol(ol_settings2, functionality)
P[["indic_socIma_3"]] = apollo_ol(ol_settings3, functionality)
P[["indic_socIma_4"]] = apollo_ol(ol_settings4, functionality)
P[["indic_envEnth_1"]] = apollo_ol(ol_settings5, functionality)
P[["indic_envEnth_2"]] = apollo_ol(ol_settings6, functionality)
P[["indic_envEnth_3"]] = apollo_ol(ol_settings7, functionality)

### Likelihood of choices
### List of utilities: these must use the same names as in mnl_settings, order is irrelevant
V = list()

V[["alt1"]] = asc_EV + (b_pp*(ppEV*(50+20*log(incomeAvg/10000))) + b_oc*ocEV + b_ct*ctEV/60 )
V[["alt2"]] = asc_CV + (b_pp*(ppCV*(50+20*log(incomeAvg/10000))) + b_oc*ocCV + lambda_socIma*LV_socIma + lambda_envEnth*LV_envEnth )


### Define settings for MNL model component
mnl_settings = list(
alternatives = c(alt1=1, alt2=2),
avail = list(alt1=1, alt2=1),
choiceVar = choiceVehicle,
utilities = V,
componentName = "choice"
)

### Compute probabilities for MNL model component
P[["choice"]] = apollo_mnl(mnl_settings, 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)
}

model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs, estimate_settings = list(scaleAfterConvergence=FALSE))


apollo_modelOutput(model)