diff --git a/Scripts/clogit/predictions/clogit_wtp_space_pred_macthing.R b/Scripts/clogit/predictions/clogit_wtp_space_pred_macthing.R new file mode 100644 index 0000000000000000000000000000000000000000..9b845fbcfc8bd9575ef2a3716e7bd36f63d43d6f --- /dev/null +++ b/Scripts/clogit/predictions/clogit_wtp_space_pred_macthing.R @@ -0,0 +1,158 @@ +#### Apollo standard script ##### + + +data_predictions <- readRDS("Data/predictions.RDS") + +database <- left_join(database_full, data_predictions, by="id") + + + +database <- database %>% + filter(!is.na(Treatment_new)) %>% + mutate(Dummy_Treated = case_when(Treatment_new == 1|Treatment_new == 2 ~ 1, TRUE ~ 0), + Dummy_Vol_Treated = case_when(Treatment_new == 5 |Treatment_new == 4 ~ 1, TRUE ~ 0), + Dummy_no_info = case_when(Treatment_new == 3 ~ 1, TRUE~0)) %>% + mutate(Dummy_Treated_Pred = case_when(Dummy_Treated == 1 & PredictedGroup == 1 ~1, TRUE~0), + Dummy_Treated_Not_Pred = case_when(Dummy_Treated == 1 & PredictedGroup == 0 ~1, TRUE~0)) %>% + mutate(Dummy_Control_Not_Pred = case_when(Treatment_new == 6 & PredictedGroup == 0 ~1, TRUE~0)) + + + + +#initialize model + +apollo_initialise() + + +### Set core controls +apollo_control = list( + modelName = "clogit_wtp_Prediction_matching", + modelDescr = "clogit wtp space Prediction matching", + indivID ="id", + mixing = FALSE, + HB= FALSE, + nCores = n_cores, + outputDirectory = "Estimation_results/clogit/prediction" +) + +##### Define model parameters depending on your attributes and model specification! #### +# set values to 0 for conditional logit model + +apollo_beta=c(b_natural = 15, + b_walking = -1, + b_rent = 0, + b_ASC_sq = 0, + b_ASC_sq_opt_yes= 0, + b_ASC_sq_opt_no= 0, + b_ASC_sq_treat_pred = 0, + b_ASC_sq_treat_not_pred = 0, + b_ASC_sq_control_not_pred = 0, + b_nat_opt_yes= 0, + b_nat_opt_no= 0, + b_nat_treat_pred = 0, + b_nat_treat_not_pred = 0, + b_nat_control_not_pred = 0, + b_walking_opt_yes= 0, + b_walking_opt_no = 0, + b_walking_treat_pred = 0, + b_walking_treat_not_pred = 0, + b_walking_control_not_pred = 0, + b_rent_opt_yes = 0, + b_rent_opt_no = 0, + b_rent_treat_pred = 0, + b_rent_treat_not_pred = 0, + b_rent_control_not_pred = 0 +) + +### specify parameters that should be kept fixed, here = none +apollo_fixed = c() + + +### validate +apollo_inputs = apollo_validateInputs() +apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){ + + ### Function initialisation: do not change the following three commands + ### 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 (later integrated in mnl_settings below) #### + # Define utility functions here: + + V = list() + V[['alt1']] = -(b_rent + b_rent_opt_yes * Dummy_Vol_Treated + b_rent_opt_no * Dummy_no_info + b_rent_treat_pred * Dummy_Treated_Pred + + b_rent_treat_not_pred * Dummy_Treated_Not_Pred + b_rent_control_not_pred * Dummy_Control_Not_Pred)* + (b_natural*Naturalness_1 + b_walking*WalkingDistance_1 + + b_nat_opt_yes * Dummy_Vol_Treated * Naturalness_1 + b_nat_opt_no * Dummy_no_info * Naturalness_1 + + b_nat_treat_pred * Dummy_Treated_Pred * Naturalness_1 + b_nat_treat_not_pred * Dummy_Treated_Not_Pred * Naturalness_1 + b_nat_control_not_pred * Dummy_Control_Not_Pred * Naturalness_1 + + b_walking_opt_yes * Dummy_Vol_Treated * WalkingDistance_1 + b_walking_opt_no* Dummy_no_info * WalkingDistance_1 + + b_walking_treat_pred * Dummy_Treated_Pred * WalkingDistance_1 + b_walking_treat_not_pred * Dummy_Treated_Not_Pred * WalkingDistance_1 + b_walking_control_not_pred * Dummy_Control_Not_Pred * WalkingDistance_1 + - Rent_1) + + V[['alt2']] = -(b_rent + b_rent_opt_yes * Dummy_Vol_Treated + b_rent_opt_no * Dummy_no_info + b_rent_treat_pred * Dummy_Treated_Pred + + b_rent_treat_not_pred * Dummy_Treated_Not_Pred + b_rent_control_not_pred * Dummy_Control_Not_Pred)* + (b_natural*Naturalness_2 + b_walking*WalkingDistance_2 + + b_nat_opt_yes * Dummy_Vol_Treated * Naturalness_2 + b_nat_opt_no * Dummy_no_info * Naturalness_2 + + b_nat_treat_pred * Dummy_Treated_Pred * Naturalness_2 + b_nat_treat_not_pred * Dummy_Treated_Not_Pred * Naturalness_2 + b_nat_control_not_pred * Dummy_Control_Not_Pred * Naturalness_2 + + b_walking_opt_yes * Dummy_Vol_Treated * WalkingDistance_2 + b_walking_opt_no* Dummy_no_info * WalkingDistance_2 + + b_walking_treat_pred * Dummy_Treated_Pred * WalkingDistance_2 + b_walking_treat_not_pred * Dummy_Treated_Not_Pred * WalkingDistance_2 + b_walking_control_not_pred * Dummy_Control_Not_Pred * WalkingDistance_2 + - Rent_2) + + V[['alt3']] = -(b_rent + b_rent_opt_yes * Dummy_Vol_Treated + b_rent_opt_no * Dummy_no_info + b_rent_treat_pred * Dummy_Treated_Pred + + b_rent_treat_not_pred * Dummy_Treated_Not_Pred + b_rent_control_not_pred * Dummy_Control_Not_Pred)* + (b_natural*Naturalness_3 + b_walking*WalkingDistance_3 + + b_nat_opt_yes * Dummy_Vol_Treated * Naturalness_3 + b_nat_opt_no * Dummy_no_info * Naturalness_3 + + b_nat_treat_pred * Dummy_Treated_Pred * Naturalness_3 + b_nat_treat_not_pred * Dummy_Treated_Not_Pred * Naturalness_3 + b_nat_control_not_pred * Dummy_Control_Not_Pred * Naturalness_3 + + b_walking_opt_yes * Dummy_Vol_Treated * WalkingDistance_3 + b_walking_opt_no* Dummy_no_info * WalkingDistance_3 + + b_walking_treat_pred * Dummy_Treated_Pred * WalkingDistance_3 + b_walking_treat_not_pred * Dummy_Treated_Not_Pred * WalkingDistance_3 + b_walking_control_not_pred * Dummy_Control_Not_Pred * WalkingDistance_3 + + b_ASC_sq + b_ASC_sq_opt_yes * Dummy_Vol_Treated + b_ASC_sq_opt_no * Dummy_no_info + + b_ASC_sq_treat_pred * Dummy_Treated_Pred + b_ASC_sq_treat_not_pred * Dummy_Treated_Not_Pred + b_ASC_sq_control_not_pred * Dummy_Control_Not_Pred - Rent_3) + + + ### Define settings for MNL model component + mnl_settings = list( + alternatives = c(alt1=1, alt2=2, alt3=3), + avail = 1, # all alternatives are available in every choice + choiceVar = choice, + V = V#, # tell function to use list vector defined above + + ) + + ### 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 ## +# ################################################################# # +# estimate model with bfgs algorithm + +clogit_wtp_matching_1 = apollo_estimate(apollo_beta, apollo_fixed, + apollo_probabilities, apollo_inputs, + estimate_settings=list(maxIterations=400, + estimationRoutine="bfgs", + hessianRoutine="analytic")) + + + +# ################################################################# # +#### MODEL OUTPUTS ## +# ################################################################# # +apollo_saveOutput(clogit_wtp_matching_1) +apollo_modelOutput(clogit_wtp_matching_1) + diff --git a/Scripts/clogit/predictions/clogit_wtp_space_pred_macthing_complete.R b/Scripts/clogit/predictions/clogit_wtp_space_pred_macthing_complete.R new file mode 100644 index 0000000000000000000000000000000000000000..ea2e682bcd542e5161f18a40f323e2f4c5516c0c --- /dev/null +++ b/Scripts/clogit/predictions/clogit_wtp_space_pred_macthing_complete.R @@ -0,0 +1,163 @@ +#### Apollo standard script ##### + +library(apollo) # Load apollo package + +data_predictions1 <- readRDS("Data/predictions.RDS") +data_predictions2 <- readRDS("Data/predictions_labeled.RDS") + +data_predictions <- bind_rows(data_predictions1, data_predictions2) + +database <- left_join(database_full, data_predictions, by="id") + + + +database <- database %>% + filter(!is.na(Treatment_new)) %>% + mutate(Dummy_Treated = case_when(Treatment_new == 1|Treatment_new == 2 ~ 1, TRUE ~ 0), + Dummy_Vol_Treated = case_when(Treatment_new == 5 |Treatment_new == 4 ~ 1, TRUE ~ 0), + Dummy_no_info = case_when(Treatment_new == 3 ~ 1, TRUE~0)) %>% + mutate(Dummy_Treated_Pred = case_when(Dummy_Treated == 1 & PredictedGroup == 1 ~1, TRUE~0), + Dummy_Treated_Not_Pred = case_when(Dummy_Treated == 1 & PredictedGroup == 0 ~1, TRUE~0)) %>% + mutate(Dummy_Control_Not_Pred = case_when(Treatment_new == 6 & PredictedGroup == 0 ~1, TRUE~0), + Dummy_Opt_Treat_Pred = case_when(Treatment_A == "Vol_Treated" & PredictedGroup == 1 ~1, TRUE~0), + Dummy_Opt_Treat_Not_Pred = case_when(Treatment_A == "Vol_Treated" & PredictedGroup == 0 ~1, TRUE~0)) + + + +#initialize model + +apollo_initialise() + + +### Set core controls +apollo_control = list( + modelName = "clogit_wtp_Prediction matching all complete", + modelDescr = "clogit wtp space Prediction matching all complete", + indivID ="id", + mixing = FALSE, + HB= FALSE, + nCores = n_cores, + outputDirectory = "Estimation_results/clogit/prediction" +) + +##### Define model parameters depending on your attributes and model specification! #### +# set values to 0 for conditional logit model + +apollo_beta=c(b_natural = 15, + b_walking = -1, + b_rent = 0, + b_ASC_sq = 0, + b_ASC_sq_opt_treated_pred = 0, + b_ASC_sq_opt_treated_not_pred = 0, + b_ASC_sq_treat_pred = 0, + b_ASC_sq_treat_not_pred = 0, + b_ASC_sq_control_not_pred = 0, + b_nat_opt_treated_pred = 0, + b_nat_opt_treated_not_pred = 0, + b_nat_treat_pred = 0, + b_nat_treat_not_pred = 0, + b_nat_control_not_pred = 0, + b_walking_opt_treated_pred = 0, + b_walking_opt_treated_not_pred = 0, + b_walking_treat_pred = 0, + b_walking_treat_not_pred = 0, + b_walking_control_not_pred = 0, + b_rent_opt_treated_pred = 0, + b_rent_opt_treated_not_pred = 0, + b_rent_treat_pred = 0, + b_rent_treat_not_pred = 0, + b_rent_control_not_pred = 0 + ) + +### specify parameters that should be kept fixed, here = none +apollo_fixed = c() + + +### validate +apollo_inputs = apollo_validateInputs() +apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){ + + ### Function initialisation: do not change the following three commands + ### 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 (later integrated in mnl_settings below) #### + # Define utility functions here: + + V = list() + V[['alt1']] = -(b_rent + b_rent_opt_treated_pred * Dummy_Opt_Treat_Pred + b_rent_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred + b_rent_treat_pred * Dummy_Treated_Pred + + b_rent_treat_not_pred * Dummy_Treated_Not_Pred + b_rent_control_not_pred * Dummy_Control_Not_Pred)* + (b_natural*Naturalness_1 + b_walking*WalkingDistance_1 + + b_nat_opt_treated_pred * Dummy_Opt_Treat_Pred * Naturalness_1 + b_nat_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred * Naturalness_1 + + b_nat_treat_pred * Dummy_Treated_Pred * Naturalness_1 + b_nat_treat_not_pred * Dummy_Treated_Not_Pred * Naturalness_1 + b_nat_control_not_pred * Dummy_Control_Not_Pred * Naturalness_1 + + b_walking_opt_treated_pred * Dummy_Opt_Treat_Pred * WalkingDistance_1 + b_walking_opt_treated_not_pred* Dummy_Opt_Treat_Not_Pred * WalkingDistance_1 + + b_walking_treat_pred * Dummy_Treated_Pred * WalkingDistance_1 + b_walking_treat_not_pred * Dummy_Treated_Not_Pred * WalkingDistance_1 + b_walking_control_not_pred * Dummy_Control_Not_Pred * WalkingDistance_1 + - Rent_1) + + V[['alt2']] = -(b_rent + b_rent_opt_treated_pred * Dummy_Opt_Treat_Pred + b_rent_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred + b_rent_treat_pred * Dummy_Treated_Pred + + b_rent_treat_not_pred * Dummy_Treated_Not_Pred + b_rent_control_not_pred * Dummy_Control_Not_Pred)* + (b_natural*Naturalness_2 + b_walking*WalkingDistance_2 + + b_nat_opt_treated_pred * Dummy_Opt_Treat_Pred * Naturalness_2 + b_nat_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred * Naturalness_2 + + b_nat_treat_pred * Dummy_Treated_Pred * Naturalness_2 + b_nat_treat_not_pred * Dummy_Treated_Not_Pred * Naturalness_2 + b_nat_control_not_pred * Dummy_Control_Not_Pred * Naturalness_2 + + b_walking_opt_treated_pred * Dummy_Opt_Treat_Pred * WalkingDistance_2 + b_walking_opt_treated_not_pred* Dummy_Opt_Treat_Not_Pred * WalkingDistance_2 + + b_walking_treat_pred * Dummy_Treated_Pred * WalkingDistance_2 + b_walking_treat_not_pred * Dummy_Treated_Not_Pred * WalkingDistance_2 + b_walking_control_not_pred * Dummy_Control_Not_Pred * WalkingDistance_2 + - Rent_2) + + V[['alt3']] = -(b_rent + b_rent_opt_treated_pred * Dummy_Opt_Treat_Pred + b_rent_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred + b_rent_treat_pred * Dummy_Treated_Pred + + b_rent_treat_not_pred * Dummy_Treated_Not_Pred + b_rent_control_not_pred * Dummy_Control_Not_Pred)* + (b_natural*Naturalness_3 + b_walking*WalkingDistance_3 + + b_nat_opt_treated_pred * Dummy_Opt_Treat_Pred * Naturalness_3 + b_nat_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred * Naturalness_3 + + b_nat_treat_pred * Dummy_Treated_Pred * Naturalness_3 + b_nat_treat_not_pred * Dummy_Treated_Not_Pred * Naturalness_3 + b_nat_control_not_pred * Dummy_Control_Not_Pred * Naturalness_3 + + b_walking_opt_treated_pred * Dummy_Opt_Treat_Pred * WalkingDistance_3 + b_walking_opt_treated_not_pred* Dummy_Opt_Treat_Not_Pred * WalkingDistance_3 + + b_walking_treat_pred * Dummy_Treated_Pred * WalkingDistance_3 + b_walking_treat_not_pred * Dummy_Treated_Not_Pred * WalkingDistance_3 + b_walking_control_not_pred * Dummy_Control_Not_Pred * WalkingDistance_3 + + b_ASC_sq + b_ASC_sq_opt_treated_pred * Dummy_Opt_Treat_Pred + b_ASC_sq_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred + + b_ASC_sq_treat_pred * Dummy_Treated_Pred + b_ASC_sq_treat_not_pred * Dummy_Treated_Not_Pred + b_ASC_sq_control_not_pred * Dummy_Control_Not_Pred - Rent_3) + + + ### Define settings for MNL model component + mnl_settings = list( + alternatives = c(alt1=1, alt2=2, alt3=3), + avail = 1, # all alternatives are available in every choice + choiceVar = choice, + V = V#, # tell function to use list vector defined above + + ) + + ### 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 ## +# ################################################################# # +# estimate model with bfgs algorithm + +clogit_wtp_matching_all_complete = apollo_estimate(apollo_beta, apollo_fixed, + apollo_probabilities, apollo_inputs, + estimate_settings=list(maxIterations=400, + estimationRoutine="bfgs", + hessianRoutine="analytic")) + + + +# ################################################################# # +#### MODEL OUTPUTS ## +# ################################################################# # +apollo_saveOutput(clogit_wtp_matching_all_complete) +apollo_modelOutput(clogit_wtp_matching_all_complete) +