diff --git a/Scripts/logit/chr_vol_treat.R b/Scripts/logit/chr_vol_treat.R
index 6bd1e6bd7199aaa9ab8cfee687e5a14fcef7fc64..5b494acb94e817a3895f194338df8a505a011609 100644
--- a/Scripts/logit/chr_vol_treat.R
+++ b/Scripts/logit/chr_vol_treat.R
@@ -28,21 +28,21 @@ data <- database_full %>%
ungroup()
data <- data %>%
mutate(Choice_Treat = ifelse( Dummy_Video_2 == 1 | Dummy_Info_nv2 == 1, 1,
- ifelse(Dummy_no_info==1 ,0,NA)))
+ ifelse(Dummy_no_info==1 ,0,NA)))
table(data$Choice_Treat)
-
+
logit_choice_treat<-glm(Choice_Treat ~ as.factor(Gender)+Z_Mean_NR+Age_mean + QFIncome +
as.factor(Education), data, family=binomial)
summary(logit_choice_treat)
logit_choice_treat_uni<-glm(Choice_Treat ~ as.factor(Gender)+Z_Mean_NR+Age_mean + QFIncome +
- Uni_degree + Kids_Dummy + Engagement_ugs + UGS_visits, data, family=binomial)
+ Uni_degree + Kids_Dummy + Engagement_ugs + UGS_visits, data, family=binomial)
summary(logit_choice_treat_uni)
@@ -94,6 +94,7 @@ data <- data %>%
# Split the data into labeled and unlabeled sets
labeled_data <- filter(data, Choice_Treat==1| Choice_Treat==0)
unlabeled_data <- filter(data, is.na(Choice_Treat))
+labeled_data_id<-labeled_data
labeled_data<-select(labeled_data,-id)
# Assuming the group information is in the column called 'Group'
labeled_data$Choice_Treat<- as.factor(labeled_data$Choice_Treat)
@@ -120,10 +121,10 @@ tuneGrid <- expand.grid(
model3 <- train(Choice_Treat ~ .,
- data = trainData,
- method = "xgbTree",
- tuneGrid = tuneGrid,
- trControl = trainControl(method = "cv", number = 5))
+ data = trainData,
+ method = "xgbTree",
+ tuneGrid = tuneGrid,
+ trControl = trainControl(method = "cv", number = 5))
# Get variable importance
@@ -140,6 +141,10 @@ labeled_data$PredictedGroup <- labeled_predictions
table(labeled_data$Choice_Treat, labeled_data$PredictedGroup)
unlabeled_predictions <- predict(model3, newdata = unlabeled_data)
+labeled_data_id$PredictedGroup <- labeled_predictions
+data_prediction_labeled<-select(labeled_data_id, c("id", "PredictedGroup"))
+saveRDS(data_prediction_labeled, "Data/predictions_labeled.RDS")
+
unlabeled_data$PredictedGroup <- unlabeled_predictions
data_prediction<-select(unlabeled_data, c("id", "PredictedGroup"))
saveRDS(data_prediction, "Data/predictions.RDS")
@@ -178,9 +183,4 @@ auc_value <- auc(roc_obj)
best_coords <- coords(roc_obj, "best", best.method="youden")
-cut_off <- best_coords$threshold
-
-<<<<<<< HEAD
-
-=======
->>>>>>> refs/remotes/origin/main
+cut_off <- best_coords$threshold
\ No newline at end of file
diff --git a/Scripts/mxl/Prediction models/mxl_wtp_space_pred_matching_complete.R b/Scripts/mxl/Prediction models/mxl_wtp_space_pred_matching_complete.R
new file mode 100644
index 0000000000000000000000000000000000000000..31ff5c68f04ef53b6d56ce4cf3cbea069a188f25
--- /dev/null
+++ b/Scripts/mxl/Prediction models/mxl_wtp_space_pred_matching_complete.R
@@ -0,0 +1,191 @@
+#### 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 = "MXL_wtp_Prediction matching all complete",
+ modelDescr = "MXL wtp space Prediction matching all complete",
+ indivID ="id",
+ mixing = TRUE,
+ HB= FALSE,
+ nCores = n_cores,
+ outputDirectory = "Estimation_results/mxl/prediction"
+)
+
+##### 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_ASC_sq_opt_treated_pred = 0,
+ mu_ASC_sq_opt_treated_not_pred = 0,
+ mu_ASC_sq_treat_pred = 0,
+ mu_ASC_sq_treat_not_pred = 0,
+ mu_ASC_sq_control_not_pred = 0,
+ mu_nat_opt_treated_pred = 0,
+ mu_nat_opt_treated_not_pred = 0,
+ mu_nat_treat_pred = 0,
+ mu_nat_treat_not_pred = 0,
+ mu_nat_control_not_pred = 0,
+ mu_walking_opt_treated_pred = 0,
+ mu_walking_opt_treated_not_pred = 0,
+ mu_walking_treat_pred = 0,
+ mu_walking_treat_not_pred = 0,
+ mu_walking_control_not_pred = 0,
+ mu_rent_opt_treated_pred = 0,
+ mu_rent_opt_treated_not_pred = 0,
+ mu_rent_treat_pred = 0,
+ mu_rent_treat_not_pred = 0,
+ mu_rent_control_not_pred = 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_opt_treated_pred * Dummy_Opt_Treat_Pred + mu_rent_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred + mu_rent_treat_pred * Dummy_Treated_Pred +
+ mu_rent_treat_not_pred * Dummy_Treated_Not_Pred + mu_rent_control_not_pred * Dummy_Control_Not_Pred)*
+ (b_mu_natural*Naturalness_1 + b_mu_walking*WalkingDistance_1
+ + mu_nat_opt_treated_pred * Dummy_Opt_Treat_Pred * Naturalness_1 + mu_nat_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred * Naturalness_1
+ + mu_nat_treat_pred * Dummy_Treated_Pred * Naturalness_1 + mu_nat_treat_not_pred * Dummy_Treated_Not_Pred * Naturalness_1 + mu_nat_control_not_pred * Dummy_Control_Not_Pred * Naturalness_1
+ + mu_walking_opt_treated_pred * Dummy_Opt_Treat_Pred * WalkingDistance_1 + mu_walking_opt_treated_not_pred* Dummy_Opt_Treat_Not_Pred * WalkingDistance_1
+ + mu_walking_treat_pred * Dummy_Treated_Pred * WalkingDistance_1 + mu_walking_treat_not_pred * Dummy_Treated_Not_Pred * WalkingDistance_1 + mu_walking_control_not_pred * Dummy_Control_Not_Pred * WalkingDistance_1
+ - Rent_1)
+
+ V[['alt2']] = -(b_mu_rent + mu_rent_opt_treated_pred * Dummy_Opt_Treat_Pred + mu_rent_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred + mu_rent_treat_pred * Dummy_Treated_Pred +
+ mu_rent_treat_not_pred * Dummy_Treated_Not_Pred + mu_rent_control_not_pred * Dummy_Control_Not_Pred)*
+ (b_mu_natural*Naturalness_2 + b_mu_walking*WalkingDistance_2
+ + mu_nat_opt_treated_pred * Dummy_Opt_Treat_Pred * Naturalness_2 + mu_nat_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred * Naturalness_2
+ + mu_nat_treat_pred * Dummy_Treated_Pred * Naturalness_2 + mu_nat_treat_not_pred * Dummy_Treated_Not_Pred * Naturalness_2 + mu_nat_control_not_pred * Dummy_Control_Not_Pred * Naturalness_2
+ + mu_walking_opt_treated_pred * Dummy_Opt_Treat_Pred * WalkingDistance_2 + mu_walking_opt_treated_not_pred* Dummy_Opt_Treat_Not_Pred * WalkingDistance_2
+ + mu_walking_treat_pred * Dummy_Treated_Pred * WalkingDistance_2 + mu_walking_treat_not_pred * Dummy_Treated_Not_Pred * WalkingDistance_2 + mu_walking_control_not_pred * Dummy_Control_Not_Pred * WalkingDistance_2
+ - Rent_2)
+
+ V[['alt3']] = -(b_mu_rent + mu_rent_opt_treated_pred * Dummy_Opt_Treat_Pred + mu_rent_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred + mu_rent_treat_pred * Dummy_Treated_Pred +
+ mu_rent_treat_not_pred * Dummy_Treated_Not_Pred + mu_rent_control_not_pred * Dummy_Control_Not_Pred)*
+ (b_mu_natural*Naturalness_3 + b_mu_walking*WalkingDistance_3
+ + mu_nat_opt_treated_pred * Dummy_Opt_Treat_Pred * Naturalness_3 + mu_nat_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred * Naturalness_3
+ + mu_nat_treat_pred * Dummy_Treated_Pred * Naturalness_3 + mu_nat_treat_not_pred * Dummy_Treated_Not_Pred * Naturalness_3 + mu_nat_control_not_pred * Dummy_Control_Not_Pred * Naturalness_3
+ + mu_walking_opt_treated_pred * Dummy_Opt_Treat_Pred * WalkingDistance_3 + mu_walking_opt_treated_not_pred* Dummy_Opt_Treat_Not_Pred * WalkingDistance_3
+ + mu_walking_treat_pred * Dummy_Treated_Pred * WalkingDistance_3 + mu_walking_treat_not_pred * Dummy_Treated_Not_Pred * WalkingDistance_3 + mu_walking_control_not_pred * Dummy_Control_Not_Pred * WalkingDistance_3
+ + b_ASC_sq + mu_ASC_sq_opt_treated_pred * Dummy_Opt_Treat_Pred + mu_ASC_sq_opt_treated_not_pred * Dummy_Opt_Treat_Not_Pred
+ + mu_ASC_sq_treat_pred * Dummy_Treated_Pred + mu_ASC_sq_treat_not_pred * Dummy_Treated_Not_Pred + mu_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)
+
+ ### 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_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(mxl_wtp_matching_all_complete)
+
+