mxl_wtp_space_NR_caseC_wdlog.R

#### 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_wdlog",
  modelDescr = "MXL wtp space NR Case C wdlog",
  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_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_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)

### 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"),
  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)
  
  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*(b_mu_natural * Naturalness_1 + b_mu_walking * log(WalkingDistance_1) +
                              mu_nat_NR * Naturalness_1 * Z_Mean_NR + mu_wd_NR * log(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 * log(WalkingDistance_1) *Dummy_Video_1 + mu_walking_no_info * log(WalkingDistance_1) * Dummy_no_info
                            +  mu_walking_info_nv1 * log(WalkingDistance_1) *Dummy_Info_nv1 + mu_walking_vid2 * log(WalkingDistance_1) * Dummy_Video_2
                            +  mu_walking_info_nv2 * log(WalkingDistance_1) *Dummy_Info_nv2- Rent_1)
  
  V[['alt2']] = -b_mu_rent*(b_mu_natural * Naturalness_2 + b_mu_walking * log(WalkingDistance_2) +
                              mu_nat_NR * Naturalness_2 * Z_Mean_NR + mu_wd_NR * log(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 * log(WalkingDistance_2) *Dummy_Video_1 + mu_walking_no_info * log(WalkingDistance_2) * Dummy_no_info
                            +  mu_walking_info_nv1 * log(WalkingDistance_2) *Dummy_Info_nv1 + mu_walking_vid2 * log(WalkingDistance_2) * Dummy_Video_2
                            +  mu_walking_info_nv2 * log(WalkingDistance_2) *Dummy_Info_nv2 - Rent_2)
  
  V[['alt3']] = -b_mu_rent*(ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * log(WalkingDistance_3) + 
                              mu_asc_NR * ASC_sq * Z_Mean_NR + mu_nat_NR * Naturalness_3 * Z_Mean_NR +
                              mu_wd_NR * log(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 * log(WalkingDistance_3) *Dummy_Video_1 + mu_walking_no_info * log(WalkingDistance_3) * Dummy_no_info
                            +  mu_walking_info_nv1 * log(WalkingDistance_3) *Dummy_Info_nv1 + mu_walking_vid2 * log(WalkingDistance_3) * Dummy_Video_2
                            +  mu_walking_info_nv2 * log(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_wdlog = 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_wdlog)