Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
H
Hot Topic_Cool Choices
Manage
Activity
Members
Labels
Plan
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package registry
Model registry
Operate
Environments
Terraform modules
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
nc71qaxa
Hot Topic_Cool Choices
Commits
3bd85a3a
Commit
3bd85a3a
authored
9 months ago
by
nc71qaxa
Browse files
Options
Downloads
Patches
Plain Diff
new matching models
parent
ff117b7f
Branches
Branches containing commit
No related tags found
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
Scripts/logit/chr_vol_treat.R
+13
-13
13 additions, 13 deletions
Scripts/logit/chr_vol_treat.R
Scripts/mxl/Prediction models/mxl_wtp_space_pred_matching_complete.R
+191
-0
191 additions, 0 deletions
.../Prediction models/mxl_wtp_space_pred_matching_complete.R
with
204 additions
and
13 deletions
Scripts/logit/chr_vol_treat.R
+
13
−
13
View file @
3bd85a3a
...
...
@@ -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
This diff is collapsed.
Click to expand it.
Scripts/mxl/Prediction models/mxl_wtp_space_pred_matching_complete.R
0 → 100644
+
191
−
0
View file @
3bd85a3a
#### 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
)
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment