Skip to content
Snippets Groups Projects
Commit d5f8ec4b authored by Marder's avatar Marder
Browse files

mxl split

parent 226f946d
No related branches found
No related tags found
1 merge request!4mxl split
#### 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))
table(database$Treatment)
database<- filter(database,Dummy_Control_Not_Pred==1 )
#initialize model
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "MXL_wtp_Control_Not_Pred",
modelDescr = "MXL_wtp_Control_Not_Pred",
indivID ="id",
mixing = TRUE,
HB= FALSE,
nCores = n_cores,
outputDirectory = "Estimation_results/mxl/prediction/Split_samples"
)
##### 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,
sig_natural = 15,
sig_walking = 2,
sig_rent = 2,
sig_ASC_sq = 0)
### 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*(b_mu_natural * Naturalness_1 + b_mu_walking * WalkingDistance_1 -
Rent_1)
V[['alt2']] = -b_mu_rent*(b_mu_natural * Naturalness_2 + b_mu_walking * WalkingDistance_2 -
Rent_2)
V[['alt3']] = -b_mu_rent*(b_ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * WalkingDistance_3 -
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
model = apollo_estimate(apollo_beta, apollo_fixed,
apollo_probabilities, apollo_inputs,
estimate_settings=list(maxIterations=400,
estimationRoutine="bfgs",
hessianRoutine="analytic"))
# ################################################################# #
#### MODEL OUTPUTS ##
# ################################################################# #
apollo_saveOutput(model)
apollo_modelOutput(model)
#### 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))
table(database$Treatment)
database<- filter(database,Dummy_Control_Not_Pred==0 & Dummy_Treated_Pred==0 &
Dummy_Treated_Not_Pred == 0 & Dummy_Opt_Treat_Pred==0 &
Dummy_Opt_Treat_Not_Pred == 0)
#initialize model
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "MXL_wtp_Control_Pred",
modelDescr = "MXL_wtp_Control_Pred",
indivID ="id",
mixing = TRUE,
HB= FALSE,
nCores = n_cores,
outputDirectory = "Estimation_results/mxl/prediction/Split_samples"
)
##### 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,
sig_natural = 15,
sig_walking = 2,
sig_rent = 2,
sig_ASC_sq = 0)
### 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*(b_mu_natural * Naturalness_1 + b_mu_walking * WalkingDistance_1 -
Rent_1)
V[['alt2']] = -b_mu_rent*(b_mu_natural * Naturalness_2 + b_mu_walking * WalkingDistance_2 -
Rent_2)
V[['alt3']] = -b_mu_rent*(b_ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * WalkingDistance_3 -
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
model = apollo_estimate(apollo_beta, apollo_fixed,
apollo_probabilities, apollo_inputs,
estimate_settings=list(maxIterations=400,
estimationRoutine="bfgs",
hessianRoutine="analytic"))
# ################################################################# #
#### MODEL OUTPUTS ##
# ################################################################# #
apollo_saveOutput(model)
apollo_modelOutput(model)
#### 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))
table(database$Treatment)
database<- filter(database,Dummy_Opt_Treat_Not_Pred==1 )
#initialize model
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "MXL_wtp_Opt_Not_Pred",
modelDescr = "MXL_wtp_Opt_Not_Pred",
indivID ="id",
mixing = TRUE,
HB= FALSE,
nCores = n_cores,
outputDirectory = "Estimation_results/mxl/prediction/Split_samples"
)
##### 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,
sig_natural = 15,
sig_walking = 2,
sig_rent = 2,
sig_ASC_sq = 0)
### 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*(b_mu_natural * Naturalness_1 + b_mu_walking * WalkingDistance_1 -
Rent_1)
V[['alt2']] = -b_mu_rent*(b_mu_natural * Naturalness_2 + b_mu_walking * WalkingDistance_2 -
Rent_2)
V[['alt3']] = -b_mu_rent*(b_ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * WalkingDistance_3 -
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
model = apollo_estimate(apollo_beta, apollo_fixed,
apollo_probabilities, apollo_inputs,
estimate_settings=list(maxIterations=400,
estimationRoutine="bfgs",
hessianRoutine="analytic"))
# ################################################################# #
#### MODEL OUTPUTS ##
# ################################################################# #
apollo_saveOutput(model)
apollo_modelOutput(model)
#### 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))
table(database$Treatment)
database<- filter(database,Dummy_Opt_Treat_Pred==1 )
#initialize model
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "MXL_wtp_Opt_Pred",
modelDescr = "MXL_wtp_Opt_Pred",
indivID ="id",
mixing = TRUE,
HB= FALSE,
nCores = n_cores,
outputDirectory = "Estimation_results/mxl/prediction/Split_samples"
)
##### 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,
sig_natural = 15,
sig_walking = 2,
sig_rent = 2,
sig_ASC_sq = 0)
### 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*(b_mu_natural * Naturalness_1 + b_mu_walking * WalkingDistance_1 -
Rent_1)
V[['alt2']] = -b_mu_rent*(b_mu_natural * Naturalness_2 + b_mu_walking * WalkingDistance_2 -
Rent_2)
V[['alt3']] = -b_mu_rent*(b_ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * WalkingDistance_3 -
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
model = apollo_estimate(apollo_beta, apollo_fixed,
apollo_probabilities, apollo_inputs,
estimate_settings=list(maxIterations=400,
estimationRoutine="bfgs",
hessianRoutine="analytic"))
# ################################################################# #
#### MODEL OUTPUTS ##
# ################################################################# #
apollo_saveOutput(model)
apollo_modelOutput(model)
#### 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))
table(database$Treatment)
database<- filter(database,Dummy_Treated_Not_Pred==1 )
#initialize model
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "MXL_wtp_Treated_Not_Pred",
modelDescr = "MXL_wtp_Treated_Not_Pred",
indivID ="id",
mixing = TRUE,
HB= FALSE,
nCores = n_cores,
outputDirectory = "Estimation_results/mxl/prediction/Split_samples"
)
##### 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,
sig_natural = 15,
sig_walking = 2,
sig_rent = 2,
sig_ASC_sq = 0)
### 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*(b_mu_natural * Naturalness_1 + b_mu_walking * WalkingDistance_1 -
Rent_1)
V[['alt2']] = -b_mu_rent*(b_mu_natural * Naturalness_2 + b_mu_walking * WalkingDistance_2 -
Rent_2)
V[['alt3']] = -b_mu_rent*(b_ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * WalkingDistance_3 -
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
model = apollo_estimate(apollo_beta, apollo_fixed,
apollo_probabilities, apollo_inputs,
estimate_settings=list(maxIterations=400,
estimationRoutine="bfgs",
hessianRoutine="analytic"))
# ################################################################# #
#### MODEL OUTPUTS ##
# ################################################################# #
apollo_saveOutput(model)
apollo_modelOutput(model)
#### 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))
table(database$Treatment)
database<- filter(database,Dummy_Treated_Pred==1 )
#initialize model
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "MXL_wtp_Treated_Pred",
modelDescr = "MXL_wtp_Treated_Pred",
indivID ="id",
mixing = TRUE,
HB= FALSE,
nCores = n_cores,
outputDirectory = "Estimation_results/mxl/prediction/Split_samples"
)
##### 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,
sig_natural = 15,
sig_walking = 2,
sig_rent = 2,
sig_ASC_sq = 0)
### 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*(b_mu_natural * Naturalness_1 + b_mu_walking * WalkingDistance_1 -
Rent_1)
V[['alt2']] = -b_mu_rent*(b_mu_natural * Naturalness_2 + b_mu_walking * WalkingDistance_2 -
Rent_2)
V[['alt3']] = -b_mu_rent*(b_ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * WalkingDistance_3 -
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
model = apollo_estimate(apollo_beta, apollo_fixed,
apollo_probabilities, apollo_inputs,
estimate_settings=list(maxIterations=400,
estimationRoutine="bfgs",
hessianRoutine="analytic"))
# ################################################################# #
#### MODEL OUTPUTS ##
# ################################################################# #
apollo_saveOutput(model)
apollo_modelOutput(model)
# Load models
MXL_wtp_Control_Not_Pred_model <- readRDS("C:/nextcloud/Hot_Topic_Cool_Choices/Estimation_results/mxl/prediction/Split_samples/MXL_wtp_Control_Not_Pred_model.rds")
MXL_wtp_Control_Pred_model <- readRDS("C:/nextcloud/Hot_Topic_Cool_Choices/Estimation_results/mxl/prediction/Split_samples/MXL_wtp_Control_Pred_model.rds")
MXL_wtp_Opt_Not_Pred_model <- readRDS("C:/nextcloud/Hot_Topic_Cool_Choices/Estimation_results/mxl/prediction/Split_samples/MXL_wtp_Opt_Not_Pred_model.rds")
MXL_wtp_Opt_Pred_model <- readRDS("C:/nextcloud/Hot_Topic_Cool_Choices/Estimation_results/mxl/prediction/Split_samples/MXL_wtp_Opt_Pred_model.rds")
MXL_wtp_Treated_Not_Pred_model <- readRDS("C:/nextcloud/Hot_Topic_Cool_Choices/Estimation_results/mxl/prediction/Split_samples/MXL_wtp_Treated_Not_Pred_model.rds")
MXL_wtp_Treated_Pred_model <- readRDS("C:/nextcloud/Hot_Topic_Cool_Choices/Estimation_results/mxl/prediction/Split_samples/MXL_wtp_Treated_Pred_model.rds")
# List of models
models <- list(
"Treated Not Pred" = MXL_wtp_Treated_Not_Pred_model,
"Control Not Pred" = MXL_wtp_Control_Not_Pred_model,
"Control Pred" = MXL_wtp_Control_Pred_model,
"Opt Not Pred" = MXL_wtp_Opt_Not_Pred_model,
"Opt Pred" = MXL_wtp_Opt_Pred_model,
"Treated Pred" = MXL_wtp_Treated_Pred_model
)
# Define the x-range for plotting (1000 values)
x_range <- seq(-10, 100, length.out = 1000)
# Define colors and line types for each model
colors <- c("blue", "red", "green", "purple", "orange", "brown")
line_types <- 1:6
# Initialize the plot with the first model
model <- models[["Treated Not Pred"]]
coef <- summary(model)$estimate
mean <- coef["mu_natural", "Estimate"]
sd <- coef["sig_natural", "Estimate"]
y <- dnorm(x_range, mean, sd)
plot(x_range, y, type = "l", col = colors[1], lwd = 2, lty = line_types[1],
ylim = c(0, max(y)), xlab = "x", ylab = "Density",
main = "Normal Distributions from Multiple MXL Models")
# Loop through the remaining models and add their distributions to the plot
for (i in 2:length(models)) {
model <- models[[i]]
# Extract mean and standard deviation for 'mu_natural' and 'sig_natural'
coef <- summary(model)$estimate
mean <- coef["mu_natural", "Estimate"]
sd <- coef["sig_natural", "Estimate"]
# Compute the normal distribution based on extracted mean and sd
y <- dnorm(x_range, mean, sd)
# Add the distribution to the existing plot
lines(x_range, y, col = colors[i], lwd = 2, lty = line_types[i])
}
# Add a legend
legend("topright", inset = c(-0.25, 0), legend = names(models), col = colors,
lty = line_types, lwd = 2, xpd = TRUE)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment