diff --git a/Scripts/mxl/mxl_wtp_space_NR_caseC_RentINT_X.R b/Scripts/mxl/mxl_wtp_space_NR_caseC_RentINT_X.R new file mode 100644 index 0000000000000000000000000000000000000000..f659244af4f120bb0f57b2c9a4e5bed19b7d1ec4 --- /dev/null +++ b/Scripts/mxl/mxl_wtp_space_NR_caseC_RentINT_X.R @@ -0,0 +1,194 @@ +#### Apollo standard script ##### + +library(apollo) # Load apollo package + + + +# Test treatment effect + +database <- database_full %>% + filter(!is.na(Treatment_new)) %>% + mutate(Dummy_Video_1 = case_when(Treatment_new == 1 ~ 1, TRUE ~ 0), + Dummy_Video_2 = case_when(Treatment_new == 5 ~ 1, TRUE ~ 0), + Dummy_no_info = case_when(Treatment_new == 3 ~ 1, TRUE~0), + Dummy_Info_nv1 = case_when(Treatment_new == 2 ~1, TRUE~0), + Dummy_Info_nv2 = case_when(Treatment_new == 4 ~1 , TRUE~0)) + +#initialize model + +apollo_initialise() + + +### Set core controls +apollo_control = list( + modelName = "MXL_wtp_NR_Case_C Rent INT X", + modelDescr = "MXL wtp space NR Case C Rent INT X", + indivID ="id", + mixing = TRUE, + HB= FALSE, + nCores = n_cores, + outputDirectory = "Estimation_results/mxl" +) + +##### Define model parameters depending on your attributes and model specification! #### +# set values to 0 for conditional logit model + +apollo_beta=c(mu_natural = 15, + mu_walking = -1, + mu_rent = -2, + ASC_sq = 0, + mu_rent_NR = 0, + mu_nat_NR = 0, + mu_wd_NR = 0, + mu_asc_NR = 0, + mu_ASC_sq_vid1 = 0, + mu_ASC_sq_vid2 = 0, + mu_ASC_sq_no_info = 0, + mu_ASC_sq_info_nv1 = 0, + mu_ASC_sq_info_nv2 = 0, + mu_rent_vid1 = 0, + mu_rent_vid2 = 0, + mu_rent_no_info = 0, + mu_rent_info_nv1 = 0, + mu_rent_info_nv2 = 0, + mu_nat_vid1 =0, + mu_nat_vid2 = 0, + mu_nat_no_info = 0, + mu_nat_info_nv1 = 0, + mu_nat_info_nv2 = 0, + mu_walking_vid1 =0, + mu_walking_vid2 = 0, + mu_walking_no_info = 0, + mu_walking_info_nv1 = 0, + mu_walking_info_nv2 = 0, + sig_natural = 15, + sig_walking = 2, + sig_rent = 2, + sig_ASC_sq = 2) + +### specify parameters that should be kept fixed, here = none +apollo_fixed = c() + +### Set parameters for generating draws, use 2000 sobol draws +apollo_draws = list( + interDrawsType = "sobol", + interNDraws = n_draws, + interUnifDraws = c(), + interNormDraws = c("draws_natural", "draws_walking", "draws_rent", "draws_asc"), + intraDrawsType = "halton", + intraNDraws = 0, + intraUnifDraws = c(), + intraNormDraws = c() +) + +### Create random parameters, define distribution of the parameters +apollo_randCoeff = function(apollo_beta, apollo_inputs){ + randcoeff = list() + + randcoeff[["b_mu_natural"]] = mu_natural + sig_natural * draws_natural + randcoeff[["b_mu_walking"]] = mu_walking + sig_walking * draws_walking + randcoeff[["b_mu_rent"]] = -exp(mu_rent + sig_rent * draws_rent) + randcoeff[["b_ASC_sq"]] = ASC_sq + sig_ASC_sq * draws_asc + + return(randcoeff) +} + + +### 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_mu_rent + mu_rent_vid1 *Dummy_Video_1 + mu_rent_vid2 * Dummy_Video_2 + mu_rent_no_info * Dummy_no_info + + mu_rent_info_nv1 * Dummy_Info_nv1 + mu_rent_info_nv2 * Dummy_Info_nv2 + mu_rent_NR * Z_Mean_NR) * + (b_mu_natural * Naturalness_1 + b_mu_walking * WalkingDistance_1 + + mu_nat_NR * Naturalness_1 * Z_Mean_NR + mu_wd_NR * WalkingDistance_1 * Z_Mean_NR + + mu_nat_vid1 * Naturalness_1 *Dummy_Video_1 + mu_nat_no_info * Naturalness_1 * Dummy_no_info + + mu_nat_info_nv1 * Naturalness_1 *Dummy_Info_nv1 + mu_nat_vid2 * Naturalness_1 * Dummy_Video_2 + + mu_nat_info_nv2 * Naturalness_1 *Dummy_Info_nv2 + + mu_walking_vid1 * WalkingDistance_1 *Dummy_Video_1 + mu_walking_no_info * WalkingDistance_1 * Dummy_no_info + + mu_walking_info_nv1 * WalkingDistance_1 *Dummy_Info_nv1 + mu_walking_vid2 * WalkingDistance_1 * Dummy_Video_2 + + mu_walking_info_nv2 * WalkingDistance_1 *Dummy_Info_nv2- Rent_1) + + V[['alt2']] = -(b_mu_rent + mu_rent_vid1 *Dummy_Video_1 + mu_rent_vid2 * Dummy_Video_2 + mu_rent_no_info * Dummy_no_info + + mu_rent_info_nv1 * Dummy_Info_nv1 + mu_rent_info_nv2 * Dummy_Info_nv2 + mu_rent_NR * Z_Mean_NR)* + (b_mu_natural * Naturalness_2 + b_mu_walking * WalkingDistance_2 + + mu_nat_NR * Naturalness_2 * Z_Mean_NR + mu_wd_NR * WalkingDistance_2 * Z_Mean_NR + + mu_nat_vid1 * Naturalness_2 *Dummy_Video_1 + mu_nat_no_info * Naturalness_2 * Dummy_no_info + + mu_nat_info_nv1 * Naturalness_2 *Dummy_Info_nv1 + mu_nat_vid2 * Naturalness_2 * Dummy_Video_2 + + mu_nat_info_nv2 * Naturalness_2 *Dummy_Info_nv2+ + mu_walking_vid1 * WalkingDistance_2 *Dummy_Video_1 + mu_walking_no_info * WalkingDistance_2 * Dummy_no_info + + mu_walking_info_nv1 * WalkingDistance_2 *Dummy_Info_nv1 + mu_walking_vid2 * WalkingDistance_2 * Dummy_Video_2 + + mu_walking_info_nv2 * WalkingDistance_2 *Dummy_Info_nv2 - Rent_2) + + V[['alt3']] = -(b_mu_rent + mu_rent_vid1 *Dummy_Video_1 + mu_rent_vid2 * Dummy_Video_2 + mu_rent_no_info * Dummy_no_info + + mu_rent_info_nv1 * Dummy_Info_nv1 + mu_rent_info_nv2 * Dummy_Info_nv2 + mu_rent_NR * Z_Mean_NR) * + (b_ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * WalkingDistance_3 + + mu_asc_NR * Z_Mean_NR + mu_nat_NR * Naturalness_3 * Z_Mean_NR + + mu_wd_NR * WalkingDistance_3 * Z_Mean_NR + + mu_nat_vid1 * Naturalness_3 *Dummy_Video_1 + mu_nat_no_info * Naturalness_3 * Dummy_no_info + + mu_nat_info_nv1 * Naturalness_3 *Dummy_Info_nv1 + mu_nat_vid2 * Naturalness_3 * Dummy_Video_2 + + mu_nat_info_nv2 * Naturalness_3 *Dummy_Info_nv2+ + mu_walking_vid1 * WalkingDistance_3 *Dummy_Video_1 + mu_walking_no_info * WalkingDistance_3 * Dummy_no_info + + mu_walking_info_nv1 * WalkingDistance_3 *Dummy_Info_nv1 + mu_walking_vid2 * WalkingDistance_3 * Dummy_Video_2 + + mu_walking_info_nv2 * WalkingDistance_3 *Dummy_Info_nv2 + + mu_ASC_sq_vid1 * Dummy_Video_1 + mu_ASC_sq_vid2 * Dummy_Video_2 + + mu_ASC_sq_no_info * Dummy_no_info + mu_ASC_sq_info_nv1 * Dummy_Info_nv1 + + mu_ASC_sq_info_nv2 * Dummy_Info_nv2 - 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) + + ### Average across inter-individual draws - nur bei Mixed Logit! + P = apollo_avgInterDraws(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 + +mxl_wtp_NR_case_c_rentINTX = apollo_estimate(apollo_beta, apollo_fixed, + apollo_probabilities, apollo_inputs, + estimate_settings=list(maxIterations=400, + estimationRoutine="bfgs", + hessianRoutine="analytic")) + + + +# ################################################################# # +#### MODEL OUTPUTS ## +# ################################################################# # +apollo_saveOutput(mxl_wtp_NR_case_c_rentINTX) + +