Hi
Kindly find attached the code
# ####################################################### #
#### 1. Definition of core settings
# ####################################################### #
### Clear memory
rm(list = ls())
### Load libraries
library(apollo)
#> Apollo 0.2.8
#>
http://www.ApolloChoiceModelling.com
#> See url for a detailed manual, examples and a user forum.
#> Sign up to the user forum to receive updates on new releases.
### Initialise code
apollo_initialise()
### Set core controls
apollo_control = list(
modelName ="MNL6_final_PAPER",
modelDescr ="Simple MNL model on mode choice SP data",
indivID ="ID",
panelData=FALSE,
outputDirectory = "output"
)
# ####################################################### #
#### 2. Data loading ####
# ####################################################### #
database = read.csv("apollo5.csv",header=TRUE)
#database$EDU = as.factor(database$EDU)
#database$age_1 = as.factor(database$age_1)
choiceAnalysis_settings <- list(
alternatives = c(car=1, tw=2, h=3, bus=4, ipt=5, nmt=6, van=7, TM=8),
avail = list(car=database$CAR_AV, tw=database$TW_AV, h=database$H_AV, bus=database$BUS_AV, ipt=database$IPT_AV, nmt=database$NMT_AV, van=database$VAN_AV, TM=database$TM_AV),
choiceVar = database$choice,
explanators = database[,c("VEH","age_1")]
)
### Run function to analyse choice data
apollo_choiceAnalysis(choiceAnalysis_settings, apollo_control, database)
# ####################################################### #
#### 3. Parameter definition ####
# ####################################################### #
### Vector of parameters, including any that are kept fixed
### during estimation
apollo_beta=c(asc_car = 0,
asc_tw=0,
asc_h=0,
asc_van=0,
asc_bus = 0,
asc_ipt = 0,
asc_tm=0,
asc_nmt = 0,
b_t=0,
age1=0,
edu1=0,
cc=0,
b_cost1=0
)
### Vector with names war(in quotes) of parameters to be
### kept fixed at their starting value in apollo_beta.
### Use apollo_beta_fixed = c() for no fixed parameters.
apollo_fixed = c("asc_nmt")
# ####################################################### #
#### 4. Input validation ####
# ####################################################### #
apollo_inputs = apollo_validateInputs()
# ####################################################### #
#### 5. Likelihood definition ####
# ####################################################### #
apollo_probabilities=function(apollo_beta, apollo_inputs,
functionality="output"){
### 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()
V[["car"]] = asc_car + b_t *(TTC) + b_cost1*TCC+cc*(TCC*TTC)+age1*age_1+edu1*VEH
V[["tw"]] = asc_tw + b_t *(TTTW) + b_cost1*TCTW+age1*age_1+edu1*VEH+cc*(TCTW*TTTW)
V[["h"]] = asc_h + b_t *(TTH) + b_cost1*TCH+age1*age_1+edu1*VEH+cc*(TCH*TTH)
V[["bus"]] = asc_bus + b_t *(TTB) + b_cost1*TCB+age1*age_1+edu1*VEH+cc*(TCB*TTB)
V[["ipt"]] = asc_ipt + b_t *(TTIPT) + b_cost1*TCIPT+age1*age_1+edu1*VEH+cc*(TCIPT*TTIPT)
V[["van"]] = asc_van + b_t *(TTVAN) + b_cost1*TCVAN+age1*age_1+edu1*VEH+cc*(TCVAN*TTVAN)
V[["nmt"]]= asc_nmt+ b_t*(TTNMT)
V[["TM"]]= asc_tm+ b_t*(TTTM)+age1*age_1+edu1*VEH+ b_cost1*TCTM+cc*(TCTM*TTTM)
#V[['car']] = asc_car
#V[['tw']] = asc_tw
#V[['h']] = asc_h
#V[['bus']] = asc_bus
#V[['ipt']] = asc_ipt
#V[['nmt']]= asc_nmt
#V[['van']]= asc_van
#V[['TM']]= asc_tm
### Define settings for MNL model component
mnl_settings = list(
alternatives = c(car=1, tw=2, h=3, bus=4, ipt=5, nmt=6, van=7, TM=8),
avail = list(car=CAR_AV, tw=TW_AV, h=H_AV, bus=BUS_AV, ipt=IPT_AV, nmt=NMT_AV, van=VAN_AV, TM=TM_AV),
choiceVar = choice,
utilities = V
)
P[["model"]] = apollo_mnl(mnl_settings, functionality)
### Take product across observation for same individual
## P = apollo_panelProd(P, apollo_inputs, functionality)
### Prepare and return outputs of function
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
# ####################################################### #
#### 6. Model estimation and reporting ####
# ####################################################### #
model = apollo_estimate(apollo_beta, apollo_fixed,
apollo_probabilities,
apollo_inputs,
list(writeIter=FALSE))
modelOutput_Liste = list(printChange=TRUE, printClassical=TRUE, printCorr=TRUE,
printCovar=TRUE, printDataReport=TRUE, printFixed=TRUE,
printFunctions=TRUE, printModelStructure=TRUE,
printOutliers=TRUE, printPVal=2, printT1=TRUE)
apollo_modelOutput(model,modelOutput_settings=modelOutput_Liste)
apollo_saveOutput(model,modelOutput_Liste)
### Use the estimated model to make predictions
predictions_base = apollo_prediction(model,
apollo_probabilities,
apollo_inputs)
database$TCC= 1.01*database$TCC
database$LNTCC=log(database$TCC)
apollo_inputs = apollo_validateInputs()
#> Several observations per individual detected based on the value of ID.
#> Setting panelData in apollo_control set to TRUE.
#> All checks on apollo_control completed.
#> All checks on database completed.
predictions_new = apollo_prediction(model,
apollo_probabilities,
apollo_inputs)
### Compare predictions
change=(predictions_new-predictions_base)/predictions_base
### Not interested in chosen alternative now,
### so drop last column
change=change[,-ncol(change)]
### Summary of changes (possible presence of NAs due to
### unavailable alternatives)
summary(change)
### Compute own elasticity for ipt:
log(sum(predictions_new[,3])/sum(predictions_base[,3]))/log(1.01)
# ----------------------------------------------------------------- #
#---- RECOVERY OF SHARES FOR ALTERNATIVES IN DATABASE ----
# ----------------------------------------------------------------- #
sharesTest_settings = list()
sharesTest_settings[["alternatives"]] = c(car=1, tw=2, h=3, bus=4, ipt=5, nmt=6, van=7, TM=8)
sharesTest_settings[["choiceVar"]] = database$choice
#sharesTest_settings[["subsamples"]] = list(business=(database$business==1),
#leisure=(database$business==0))
apollo_sharesTest(model, apollo_probabilities, apollo_inputs, sharesTest_settings)
deltaMethod_settings=list(expression=c(VTT_car_min1="(b_t/b_cost1)",
VTT_ipt_min1="(b_t/b_cost1)"
))
apollo_deltaMethod(model, deltaMethod_settings)