diff --git a/R_Scripts/mnl_CMI_id_cont.R b/R_Scripts/mnl_CMI_id_cont.R new file mode 100644 index 0000000000000000000000000000000000000000..207e37337cbeaedcb96af64d137a276f964d58ed --- /dev/null +++ b/R_Scripts/mnl_CMI_id_cont.R @@ -0,0 +1,184 @@ +### Initialise code +apollo_initialise() + +### Set core controls +apollo_control = list( + modelName = "MNL_SP", + modelDescr = "Simple MNL model on mode choice SP data", + indivID = "id", + outputDirectory = "Output", + panelData = TRUE +) + + + +# ################################################################# # +#### DEFINE MODEL PARAMETERS #### +# ################################################################# # + +### Vector of parameters, including any that are kept fixed in estimation +apollo_beta=c(asc_a = 0, + asc_b = 0, + b_profit =1, + b_hold = 0, + b_loc = 0, + b_admin1 = 0, + b_admin2 = 0, + b_hold_CMI = 0, + b_hold_Q35_1 = 0, + b_hold_Q35_1_CMI = 0 + + + + +) + +### 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() + +# ################################################################# # +#### 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() + V[["alt1"]] = asc_a + + b_profit * profit1 - + b_hold * hold1 - + b_hold_CMI*hold1*CMI - + b_hold_Q35_1_CMI*hold1*CMI*Q35_1 - + b_hold_Q35_1*hold1*Q35_1+ + b_loc * loc1 + + b_admin1 *admin_11+ + b_admin2 *admin_21 + + + + + V[["alt2"]] =asc_b + + b_profit * profit2 - + b_hold * hold2 - + b_hold_CMI*hold2*CMI - + b_hold_Q35_1_CMI*hold2*CMI*Q35_1 - + b_hold_Q35_1*hold2*Q35_1+ + b_loc * loc2 + + b_admin1 *admin_12+ + b_admin2 *admin_22 + + + + + V[["alt3"]] = b_profit * profit3 + + ### Define settings for MNL model component + mnl_settings = list( + alternatives = c(alt1=1, alt2=2, alt3=3), + avail = 1, + choiceVar = choosen, + utilities = V + ) + + ### Compute probabilities using MNL model + 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) +} + +# ################################################################# # +#### MODEL ESTIMATION #### +# ################################################################# # + +model_CMI_Q35_1 = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs) + +# ################################################################# # +#### MODEL OUTPUTS #### +# ################################################################# # + +# ----------------------------------------------------------------- # +#---- FORMATTED OUTPUT (TO SCREEN) ---- +# ----------------------------------------------------------------- # + +apollo_modelOutput(model_CMI_Q35_1) + +# ----------------------------------------------------------------- # +#---- FORMATTED OUTPUT (TO FILE, using model name) ---- +# ----------------------------------------------------------------- # +summary(model_CMI_Q35_1) + + +m<-mean(database$Q35_1) +sd<-sd(database$Q35_1) +min<-min(database$CMI) +max<-max(database$CMI) +x_list=seq(min,max,0.1) + +# Results Table V +deltaMethod_settings=list(expression=c(paste0(mean_rate="100*(b_hold/b_profit+b_hold_Q35_1/b_profit*",(m-sd),")"))) +apollo_deltaMethod(model_CMI_Q35_1, deltaMethod_settings) +deltaMethod_settings=list(expression=c(paste0(mean_rate="100*(b_hold_CMI/b_profit+b_hold_Q35_1_CMI/b_profit*",(m-sd),")"))) +apollo_deltaMethod(model_CMI_Q35_1, deltaMethod_settings) +deltaMethod_settings=list(expression=c(paste0(mean_rate="100*(b_hold/b_profit+b_hold_Q35_1/b_profit*",(m+sd),")"))) +apollo_deltaMethod(model_CMI_Q35_1, deltaMethod_settings) +deltaMethod_settings=list(expression=c(paste0(mean_rate="100*(b_hold_CMI/b_profit+b_hold_Q35_1_CMI/b_profit*",(m+sd),")"))) +apollo_deltaMethod(model_CMI_Q35_1, deltaMethod_settings) + +df <- data.frame(Mean=double(), + Index=double(), + UB=double(), + LB=double(), + ID=character()) +i=1 +for(j in x_list){ + deltaMethod_settings=list(expression=c(paste0(mean_rate="100*(b_hold/b_profit+b_hold_CMI/b_profit*",j,"+b_hold_Q35_1_CMI/b_profit*",j,"*",(m-sd),"+b_hold_Q35_1/b_profit*",(m-sd),")"))) + a<-apollo_deltaMethod(model_CMI_Q35_1, deltaMethod_settings) + df[i,"Mean"]<-a[["Value"]] + df[i,"Index"]<-j + df[i,"UB"]<-a[["Value"]]+1.96*a[["Robust s.e."]] + df[i,"LB"]<-a[["Value"]]-1.96*a[["Robust s.e."]] + df[i,"ID"]<- "-1SD" + i=i+1 +} + +for(j in x_list){ + deltaMethod_settings=list(expression=c(paste0(mean_rate="100*(b_hold/b_profit+b_hold_CMI/b_profit*",j,"+b_hold_Q35_1_CMI/b_profit*",j,"*",(m+sd),"+b_hold_Q35_1/b_profit*",(m+sd),")"))) + a<-apollo_deltaMethod(model_CMI_Q35_1, deltaMethod_settings) + df[i,"Mean"]<-a[["Value"]] + df[i,"Index"]<-j + df[i,"UB"]<-a[["Value"]]+1.96*a[["Robust s.e."]] + df[i,"LB"]<-a[["Value"]]-1.96*a[["Robust s.e."]] + df[i,"ID"]<- "+1SD" + i=i+1 +} +#Figure +fig_id<-ggplot(df, aes(x=Index, y=Mean, color=ID, fill=ID)) + + geom_ribbon(aes(ymin=LB, ymax=UB),alpha=.2) + + geom_line() + + labs(x = "Collective motivation index", y= "Money discount rate in %") +fig_id +ggsave("Graphs/CMI_id.png") + +ggsave("Graphs/CMI_id.tiff") + + + +