Code: Select all
###################################################################
#### LOAD LIBRARY AND DEFINE CORE SETTINGS ##
###################################################################
#### Library and data
library(apollo)
### Clear memory
#rm(list = ls())
#Initialise code
apollo_initialise()
#Set core control
apollo_control = list(
modelName = "MNL_RP",
modelDescr = "Simple MNL model on mode choice RP data",
indivID = "Obs", #Identifiant ménage
outputDirectory = "output")
###################################################################
#### LOAD DATA AND APPLY ANY TRANSFORMATIONS ##
###################################################################
N = nrow(data)
J = 1316 #nb alternatives
K = 8 #nb attributes
database = read_rds("output/data_final_4.rds")#data_final
###################################################################
#### DEFINE MODEL PARAMETERS ##
###################################################################
### Vector of parameters, including any that are kept fixed in estimation
apollo_beta = c(alpha = 1,
#beta_ch = 0,
beta_ruc = 0,
beta_work = 0,
beta_mont = 0,
beta_mer = 0,
#beta_poll = 0,
#beta_icu = 0,
#beta_bruit = 0,
setNames(rep(0,K),paste0("beta_",1:K)))
### Vector with names (in quotes) of parameters to be kept fixed at their
# starting value in apollo_beta, use apollo_beta_fixed = c() if none
apollo_fixed = c()
###################################################################
#### GROUP AND VALIDATE INPUTS ##
###################################################################
apollo_inputs = apollo_validateInputs()
apollo_inputs$J = J # need to retain J (number of alternatives) for use
# inside apollo_probabilities
apollo_inputs$K = K # need to retain K (number of attributes) for use
# inside apollo_probabilities
###################################################################
#### 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()
### List of utilities: these must use the same names as in mnl_settings,
#order is irrelevant
V = list()
# for(j in 1:apollo_inputs$J){
# V[[paste0("alt_",j)]] = 0
# for(k in 1:apollo_inputs$K) V[[paste0("alt_",j)]] = V[[paste0("alt_",j)]] +
# get(paste0("beta_",k))*get(paste0("x_",j,"_",k))
# }
for(j in 1:apollo_inputs$J){
V[[paste0("alt_",j)]] =
alpha +
#beta_ch * nb_chambres + #taille_log
beta_ruc * log_ruc +
beta_work * log_dwork +
beta_mont * vue_montagne +
beta_mer * vue_mer +
#beta_poll * pollution +
#beta_icu * icu_1 +
#beta_bruit * bruit +
get(paste0("beta_",1))*get(paste0("x_",j,"_",1)) + #prix m2
get(paste0("beta_",2))*get(paste0("x_",j,"_",2)) + #log(pop)
get(paste0("beta_",3))*get(paste0("x_",j,"_",3)) + #densite
get(paste0("beta_",4))*get(paste0("x_",j,"_",4)) + #jobs
get(paste0("beta_",5))*get(paste0("x_",j,"_",5)) + #taille men
get(paste0("beta_",6))*get(paste0("x_",j,"_",6)) + #parc logements
get(paste0("beta_",7))*get(paste0("x_",j,"_",7)) + #ecoles
get(paste0("beta_",8))*get(paste0("x_",j,"_",8)) #distance cbd
}
### Define settings for MNL model component
mnl_settings = list(
alternatives = setNames(1:apollo_inputs$J, names(V)),
avail = setNames(apollo_inputs$database[,paste0("av_",1:apollo_inputs$J)], names(V)),
choiceVar = Choice, #Alternative choisie
utilities = V
)
### Compute probabilities using MNL model
P[["model"]] = apollo_mnl(mnl_settings, functionality)
### Prepare and return outputs of function
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
###################################################################
#### MODEL ESTIMATION ##
###################################################################
model = apollo_estimate(apollo_beta, apollo_fixed,
apollo_probabilities, apollo_inputs)