WTP for MNL model
Posted: 30 May 2022, 17:53
Hi,
I´ve estimated WTP in two different ways:
1. MNL in preference space and then used delta_method:
###MNL IN PREFERENCE SPACE
# ################################################################# #
#### LOAD LIBRARY AND DEFINE CORE SETTINGS ####
# ################################################################# #
### Initialise
rm(list = ls())
library(apollo)
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "mnl_pretest",
modelDescr = "MNL model for pretest data",
indivID = "sys_RespNum"
)
# ################################################################# #
#### LOAD DATA AND APPLY ANY TRANSFORMATIONS ####
# ################################################################# #
Daten_Choice_Pivot <- read.csv("DatenApollo.csv", header = TRUE)
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==1)] <- 1.6
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==2)] <- 1.8
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==3)] <- 3.3
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==4)] <- 4.8
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==1)] <- 1.6
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==2)] <- 1.8
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==3)] <- 3.3
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==4)] <- 4.8
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==1)] <- 1.6
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==2)] <- 1.8
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==3)] <- 3.3
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==4)] <- 4.8
database = Daten_Choice_Pivot
# ################################################################# #
#### DEFINE MODEL PARAMETERS ####
# ################################################################# #
### Vector of parameters, including any kept fixed during estimation
apollo_beta = c(b0 = 0, b_Beitr = 0,
b_HoeheEEE300 = 0,
b_HoeheEEE600 = 0,
b_HoeheEEE900 = 0,
b_HoeheEEEunb = 0,
b_ZeitEEE12 = 0,
b_ZeitEEE42 = 0,
b_ZeitEEE72 = 0,
b_ZeitEEEunb = 0)
### Vector with parameter names (in quotes) to be kept fixed at
# their starting values during estimation.
# Use apollo_beta_fixed = c() if none
apollo_fixed = c("b_HoeheEEEunb", "b_ZeitEEEunb")
# ################################################################# #
#### GROUP AND VALIDATE INPUTS ####
# ################################################################# #
apollo_inputs = apollo_validateInputs()
# ################################################################# #
#### DEFINE MODEL AND LIKELIHOOD FUNCTION ####
# ################################################################# #
apollo_probabilities=function(apollo_beta, apollo_inputs,
functionality="estimate"){
### Function initialisation: do not change the following three commands
### Attach and detach inputs, and create empty list of probabilities
apollo_attach(apollo_beta, apollo_inputs)
on.exit(apollo_detach(apollo_beta, apollo_inputs))
P = list()
### List of MNL utilities: must use the same names as in mnl_settings
V = list()
V[["SQ"]] = b0 + b_Beitr*Beitr_1 + b_HoeheEEE300*(HoeheEEE_1==1) + b_HoeheEEE600*(HoeheEEE_1==2) +
b_HoeheEEE900*(HoeheEEE_1==3)+ b_HoeheEEEunb*(HoeheEEE_1==4) + b_ZeitEEE12*(ZeitEEE_1==1) +
b_ZeitEEE42*(ZeitEEE_1==2) + b_ZeitEEE72*(ZeitEEE_1==3) + b_ZeitEEEunb*(ZeitEEE_1==4)
V[["RefA"]] = b_Beitr*Beitr_2 + b_HoeheEEE300*(HoeheEEE_2==1) + b_HoeheEEE600*(HoeheEEE_2==2) +
b_HoeheEEE900*(HoeheEEE_2==3)+ b_HoeheEEEunb*(HoeheEEE_2==4) + b_ZeitEEE12*(ZeitEEE_2==1) +
b_ZeitEEE42*(ZeitEEE_2==2) + b_ZeitEEE72*(ZeitEEE_2==3) + b_ZeitEEEunb*(ZeitEEE_2==4)
V[["RefB"]] = b_Beitr*Beitr_3 + b_HoeheEEE300*(HoeheEEE_3==1) + b_HoeheEEE600*(HoeheEEE_3==2) +
b_HoeheEEE900*(HoeheEEE_3==3)+ b_HoeheEEEunb*(HoeheEEE_3==4) + b_ZeitEEE12*(ZeitEEE_3==1) +
b_ZeitEEE42*(ZeitEEE_3==2) + b_ZeitEEE72*(ZeitEEE_3==3) + b_ZeitEEEunb*(ZeitEEE_3==4)
### Define settings for MNL model component
mnl_settings = list(
alternatives = c(SQ=1, RefA=2, RefB=3),
choiceVar = Choice,
utilities = V
)
### Compute probabilities using MNL model
P[["model"]] = apollo_mnl(mnl_settings, functionality)
### Comment out as necessary
P = apollo_panelProd(P, apollo_inputs, functionality)
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
# ################################################################# #
#### MODEL ESTIMATION AND OUTPUT ####
# ################################################################# #
model = apollo_estimate(apollo_beta, apollo_fixed,
apollo_probabilities, apollo_inputs)
Output_MNL <- apollo_modelOutput(model, modelOutput_settings = modelOutput_Liste)
apollo_saveOutput(model, saveOutput_settings = modelOutput_Liste)
### WTP with Delta-Method
deltaMethod_settings=list(expression=c(WTP_Hoehe300="-1*(b_HoeheEEE300/b_Beitr)", WTP_Hoehe600="-1*(b_HoeheEEE600/b_Beitr)",
WTP_Hoehe900="-1*(b_HoeheEEE900/b_Beitr)", WTP_Zeit12="-1*(b_ZeitEEE12/b_Beitr)",
WTP_Zeit42="-1*(b_ZeitEEE42/b_Beitr)", WTP_Zeit72="-1*(b_ZeitEEE72/b_Beitr)" ))
apollo_deltaMethod(model, deltaMethod_settings)
_____Results_____
Estimates:
b0 -0.9618
b_Beitr -0.4862
b_HoeheEEE300 1.4049
b_HoeheEEE600 1.0240
b_HoeheEEE900 0.4527
b_HoeheEEEunb 0.0000
b_ZeitEEE12 1.0609
b_ZeitEEE42 0.5951
b_ZeitEEE72 0.2733
b_ZeitEEEunb 0.0000
WTP from delta_method:
Expression Value Robust s.e. Rob t-ratio (0)
WTP_Hoehe300 2.8895 0.6395 4.52
WTP_Hoehe600 2.1062 0.6731 3.13
WTP_Hoehe900 0.9310 0.5385 1.73
WTP_Zeit12 2.1820 0.5779 3.78
WTP_Zeit42 1.2238 0.5815 2.10
WTP_Zeit72 0.5622 0.5601 1.00
_____________________
2. MNL in WTP space:
### MNL IN WTP SPACE
# ################################################################# #
#### LOAD LIBRARY AND DEFINE CORE SETTINGS ####
# ################################################################# #
rm(list = ls())
library(apollo)
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "mnl_wtp_pretest",
modelDescr = "MNL model for pretest data, in wtp space",
indivID = "sys_RespNum",
outputDirectory = "output"
)
# ################################################################# #
#### LOAD DATA AND APPLY ANY TRANSFORMATIONS ####
# ################################################################# #
Daten_Choice_Pivot <- read.csv("DatenApollo.csv", header = TRUE)
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==1)] <- 1.6
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==2)] <- 1.8
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==3)] <- 3.3
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==4)] <- 4.8
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==1)] <- 1.6
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==2)] <- 1.8
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==3)] <- 3.3
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==4)] <- 4.8
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==1)] <- 1.6
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==2)] <- 1.8
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==3)] <- 3.3
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==4)] <- 4.8
database = Daten_Choice_Pivot
# ################################################################# #
#### DEFINE MODEL PARAMETERS ####
# ################################################################# #
### Vector of parameters, including any that are kept fixed in estimation
apollo_beta = c(b0 = 0, b_Beitr = 0,
wtp_HoeheEEE300 = 0,
wtp_HoeheEEE600 = 0,
wtp_HoeheEEE900 = 0,
wtp_HoeheEEEunb = 0,
wtp_ZeitEEE12 = 0,
wtp_ZeitEEE42 = 0,
wtp_ZeitEEE72 = 0,
wtp_ZeitEEEunb = 0)
### Vector with names (in quotes) of parameters to be kept fixed at their starting value in apollo_beta, use apollo_beta_fixed = c() if none
apollo_fixed = c("wtp_HoeheEEEunb", "wtp_ZeitEEEunb")
# ################################################################# #
#### GROUP AND VALIDATE INPUTS ####
# ################################################################# #
apollo_inputs = apollo_validateInputs()
# ################################################################# #
#### DEFINE MODEL AND LIKELIHOOD FUNCTION ####
# ################################################################# #
apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){
### 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: these must use the same names as in mnl_settings, order is irrelevant
V = list()
V[["SQ"]] = b0 + b_Beitr * ( wtp_HoeheEEE300*(HoeheEEE_1==1) + wtp_HoeheEEE600*(HoeheEEE_1==2) +
wtp_HoeheEEE900*(HoeheEEE_1==3)+ wtp_HoeheEEEunb*(HoeheEEE_1==4) + wtp_ZeitEEE12*(ZeitEEE_1==1) +
wtp_ZeitEEE42*(ZeitEEE_1==2) + wtp_ZeitEEE72*(ZeitEEE_1==3) + wtp_ZeitEEEunb*(ZeitEEE_1==4) + Beitr_1 )
V[["RefA"]] = b_Beitr * ( wtp_HoeheEEE300*(HoeheEEE_2==1) + wtp_HoeheEEE600*(HoeheEEE_2==2) +
wtp_HoeheEEE900*(HoeheEEE_2==3)+ wtp_HoeheEEEunb*(HoeheEEE_2==4) + wtp_ZeitEEE12*(ZeitEEE_2==1) +
wtp_ZeitEEE42*(ZeitEEE_2==2) + wtp_ZeitEEE72*(ZeitEEE_2==3) + wtp_ZeitEEEunb*(ZeitEEE_2==4) + Beitr_2 )
V[["RefB"]] = b_Beitr * ( wtp_HoeheEEE300*(HoeheEEE_3==1) + wtp_HoeheEEE600*(HoeheEEE_3==2) +
wtp_HoeheEEE900*(HoeheEEE_3==3)+ wtp_HoeheEEEunb*(HoeheEEE_3==4) + wtp_ZeitEEE12*(ZeitEEE_3==1) +
wtp_ZeitEEE42*(ZeitEEE_3==2) + wtp_ZeitEEE72*(ZeitEEE_3==3) + wtp_ZeitEEEunb*(ZeitEEE_3==4) + Beitr_3 )
### Define settings for MNL model component
mnl_settings = list(
alternatives = c(SQ=1, RefA=2, RefB=3),
choiceVar = Choice,
utilities = V
)
### 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)
### Prepare and return outputs of function
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
# ################################################################# #
#### MODEL ESTIMATION AND OUTPUT ####
# ################################################################# #
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
Output_MNL_WTP <- apollo_modelOutput(model, modelOutput_settings = modelOutput_Liste)
apollo_saveOutput(model, saveOutput_settings = modelOutput_Liste)
_____Results_____
Estimates:
b0 -0.9609
b_Beitr -0.4863
wtp_HoeheEEE300 -2.8896
wtp_HoeheEEE600 -2.1069
wtp_HoeheEEE900 -0.9317
wtp_HoeheEEEunb 0.0000
wtp_ZeitEEE12 -2.1826
wtp_ZeitEEE42 -1.2246
wtp_ZeitEEE72 -0.5634
wtp_ZeitEEEunb 0.0000
_______________________
Questions:
- When using the Delta-method I´ve multiplied the estimate with "-1" (see code) as all parameters besides cost parameter (b_Beitr) were positive. Is that the right approach? Delta-method results then make perfect sense but the results from WTP space have the "wrong" sign as there e.g. should be higher WTP for HoeheEEE300 than for HoeheEEE600. Do you see why this issue with the sign could be the case? I did not find any similar case in the manual or the forum.
- My cost attribute Beitr is in the unit of percent (1,6%, 1,8%, 3,3%, 4,8%). How can it be derived from the coefficients how much percentage points more someone is willing to pay for a shift from HoeheEEEunb (reference category) to HoeheEEE300 (or from HoeheEEE300 to HoeheEEE600 etc.)?
And can it also be said that WTP for HoeheEEE300 is xy%? I am a bit confused, as I could not find examples for concrete wtp estimates interpretation for dummy coded attributes.
Any clarification is highly appreciated.
Thanks and best,
J.
I´ve estimated WTP in two different ways:
1. MNL in preference space and then used delta_method:
###MNL IN PREFERENCE SPACE
# ################################################################# #
#### LOAD LIBRARY AND DEFINE CORE SETTINGS ####
# ################################################################# #
### Initialise
rm(list = ls())
library(apollo)
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "mnl_pretest",
modelDescr = "MNL model for pretest data",
indivID = "sys_RespNum"
)
# ################################################################# #
#### LOAD DATA AND APPLY ANY TRANSFORMATIONS ####
# ################################################################# #
Daten_Choice_Pivot <- read.csv("DatenApollo.csv", header = TRUE)
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==1)] <- 1.6
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==2)] <- 1.8
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==3)] <- 3.3
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==4)] <- 4.8
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==1)] <- 1.6
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==2)] <- 1.8
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==3)] <- 3.3
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==4)] <- 4.8
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==1)] <- 1.6
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==2)] <- 1.8
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==3)] <- 3.3
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==4)] <- 4.8
database = Daten_Choice_Pivot
# ################################################################# #
#### DEFINE MODEL PARAMETERS ####
# ################################################################# #
### Vector of parameters, including any kept fixed during estimation
apollo_beta = c(b0 = 0, b_Beitr = 0,
b_HoeheEEE300 = 0,
b_HoeheEEE600 = 0,
b_HoeheEEE900 = 0,
b_HoeheEEEunb = 0,
b_ZeitEEE12 = 0,
b_ZeitEEE42 = 0,
b_ZeitEEE72 = 0,
b_ZeitEEEunb = 0)
### Vector with parameter names (in quotes) to be kept fixed at
# their starting values during estimation.
# Use apollo_beta_fixed = c() if none
apollo_fixed = c("b_HoeheEEEunb", "b_ZeitEEEunb")
# ################################################################# #
#### GROUP AND VALIDATE INPUTS ####
# ################################################################# #
apollo_inputs = apollo_validateInputs()
# ################################################################# #
#### DEFINE MODEL AND LIKELIHOOD FUNCTION ####
# ################################################################# #
apollo_probabilities=function(apollo_beta, apollo_inputs,
functionality="estimate"){
### Function initialisation: do not change the following three commands
### Attach and detach inputs, and create empty list of probabilities
apollo_attach(apollo_beta, apollo_inputs)
on.exit(apollo_detach(apollo_beta, apollo_inputs))
P = list()
### List of MNL utilities: must use the same names as in mnl_settings
V = list()
V[["SQ"]] = b0 + b_Beitr*Beitr_1 + b_HoeheEEE300*(HoeheEEE_1==1) + b_HoeheEEE600*(HoeheEEE_1==2) +
b_HoeheEEE900*(HoeheEEE_1==3)+ b_HoeheEEEunb*(HoeheEEE_1==4) + b_ZeitEEE12*(ZeitEEE_1==1) +
b_ZeitEEE42*(ZeitEEE_1==2) + b_ZeitEEE72*(ZeitEEE_1==3) + b_ZeitEEEunb*(ZeitEEE_1==4)
V[["RefA"]] = b_Beitr*Beitr_2 + b_HoeheEEE300*(HoeheEEE_2==1) + b_HoeheEEE600*(HoeheEEE_2==2) +
b_HoeheEEE900*(HoeheEEE_2==3)+ b_HoeheEEEunb*(HoeheEEE_2==4) + b_ZeitEEE12*(ZeitEEE_2==1) +
b_ZeitEEE42*(ZeitEEE_2==2) + b_ZeitEEE72*(ZeitEEE_2==3) + b_ZeitEEEunb*(ZeitEEE_2==4)
V[["RefB"]] = b_Beitr*Beitr_3 + b_HoeheEEE300*(HoeheEEE_3==1) + b_HoeheEEE600*(HoeheEEE_3==2) +
b_HoeheEEE900*(HoeheEEE_3==3)+ b_HoeheEEEunb*(HoeheEEE_3==4) + b_ZeitEEE12*(ZeitEEE_3==1) +
b_ZeitEEE42*(ZeitEEE_3==2) + b_ZeitEEE72*(ZeitEEE_3==3) + b_ZeitEEEunb*(ZeitEEE_3==4)
### Define settings for MNL model component
mnl_settings = list(
alternatives = c(SQ=1, RefA=2, RefB=3),
choiceVar = Choice,
utilities = V
)
### Compute probabilities using MNL model
P[["model"]] = apollo_mnl(mnl_settings, functionality)
### Comment out as necessary
P = apollo_panelProd(P, apollo_inputs, functionality)
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
# ################################################################# #
#### MODEL ESTIMATION AND OUTPUT ####
# ################################################################# #
model = apollo_estimate(apollo_beta, apollo_fixed,
apollo_probabilities, apollo_inputs)
Output_MNL <- apollo_modelOutput(model, modelOutput_settings = modelOutput_Liste)
apollo_saveOutput(model, saveOutput_settings = modelOutput_Liste)
### WTP with Delta-Method
deltaMethod_settings=list(expression=c(WTP_Hoehe300="-1*(b_HoeheEEE300/b_Beitr)", WTP_Hoehe600="-1*(b_HoeheEEE600/b_Beitr)",
WTP_Hoehe900="-1*(b_HoeheEEE900/b_Beitr)", WTP_Zeit12="-1*(b_ZeitEEE12/b_Beitr)",
WTP_Zeit42="-1*(b_ZeitEEE42/b_Beitr)", WTP_Zeit72="-1*(b_ZeitEEE72/b_Beitr)" ))
apollo_deltaMethod(model, deltaMethod_settings)
_____Results_____
Estimates:
b0 -0.9618
b_Beitr -0.4862
b_HoeheEEE300 1.4049
b_HoeheEEE600 1.0240
b_HoeheEEE900 0.4527
b_HoeheEEEunb 0.0000
b_ZeitEEE12 1.0609
b_ZeitEEE42 0.5951
b_ZeitEEE72 0.2733
b_ZeitEEEunb 0.0000
WTP from delta_method:
Expression Value Robust s.e. Rob t-ratio (0)
WTP_Hoehe300 2.8895 0.6395 4.52
WTP_Hoehe600 2.1062 0.6731 3.13
WTP_Hoehe900 0.9310 0.5385 1.73
WTP_Zeit12 2.1820 0.5779 3.78
WTP_Zeit42 1.2238 0.5815 2.10
WTP_Zeit72 0.5622 0.5601 1.00
_____________________
2. MNL in WTP space:
### MNL IN WTP SPACE
# ################################################################# #
#### LOAD LIBRARY AND DEFINE CORE SETTINGS ####
# ################################################################# #
rm(list = ls())
library(apollo)
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "mnl_wtp_pretest",
modelDescr = "MNL model for pretest data, in wtp space",
indivID = "sys_RespNum",
outputDirectory = "output"
)
# ################################################################# #
#### LOAD DATA AND APPLY ANY TRANSFORMATIONS ####
# ################################################################# #
Daten_Choice_Pivot <- read.csv("DatenApollo.csv", header = TRUE)
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==1)] <- 1.6
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==2)] <- 1.8
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==3)] <- 3.3
Daten_Choice_Pivot$Beitr_1[which(Daten_Choice_Pivot$Beitr_1==4)] <- 4.8
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==1)] <- 1.6
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==2)] <- 1.8
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==3)] <- 3.3
Daten_Choice_Pivot$Beitr_2[which(Daten_Choice_Pivot$Beitr_2==4)] <- 4.8
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==1)] <- 1.6
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==2)] <- 1.8
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==3)] <- 3.3
Daten_Choice_Pivot$Beitr_3[which(Daten_Choice_Pivot$Beitr_3==4)] <- 4.8
database = Daten_Choice_Pivot
# ################################################################# #
#### DEFINE MODEL PARAMETERS ####
# ################################################################# #
### Vector of parameters, including any that are kept fixed in estimation
apollo_beta = c(b0 = 0, b_Beitr = 0,
wtp_HoeheEEE300 = 0,
wtp_HoeheEEE600 = 0,
wtp_HoeheEEE900 = 0,
wtp_HoeheEEEunb = 0,
wtp_ZeitEEE12 = 0,
wtp_ZeitEEE42 = 0,
wtp_ZeitEEE72 = 0,
wtp_ZeitEEEunb = 0)
### Vector with names (in quotes) of parameters to be kept fixed at their starting value in apollo_beta, use apollo_beta_fixed = c() if none
apollo_fixed = c("wtp_HoeheEEEunb", "wtp_ZeitEEEunb")
# ################################################################# #
#### GROUP AND VALIDATE INPUTS ####
# ################################################################# #
apollo_inputs = apollo_validateInputs()
# ################################################################# #
#### DEFINE MODEL AND LIKELIHOOD FUNCTION ####
# ################################################################# #
apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){
### 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: these must use the same names as in mnl_settings, order is irrelevant
V = list()
V[["SQ"]] = b0 + b_Beitr * ( wtp_HoeheEEE300*(HoeheEEE_1==1) + wtp_HoeheEEE600*(HoeheEEE_1==2) +
wtp_HoeheEEE900*(HoeheEEE_1==3)+ wtp_HoeheEEEunb*(HoeheEEE_1==4) + wtp_ZeitEEE12*(ZeitEEE_1==1) +
wtp_ZeitEEE42*(ZeitEEE_1==2) + wtp_ZeitEEE72*(ZeitEEE_1==3) + wtp_ZeitEEEunb*(ZeitEEE_1==4) + Beitr_1 )
V[["RefA"]] = b_Beitr * ( wtp_HoeheEEE300*(HoeheEEE_2==1) + wtp_HoeheEEE600*(HoeheEEE_2==2) +
wtp_HoeheEEE900*(HoeheEEE_2==3)+ wtp_HoeheEEEunb*(HoeheEEE_2==4) + wtp_ZeitEEE12*(ZeitEEE_2==1) +
wtp_ZeitEEE42*(ZeitEEE_2==2) + wtp_ZeitEEE72*(ZeitEEE_2==3) + wtp_ZeitEEEunb*(ZeitEEE_2==4) + Beitr_2 )
V[["RefB"]] = b_Beitr * ( wtp_HoeheEEE300*(HoeheEEE_3==1) + wtp_HoeheEEE600*(HoeheEEE_3==2) +
wtp_HoeheEEE900*(HoeheEEE_3==3)+ wtp_HoeheEEEunb*(HoeheEEE_3==4) + wtp_ZeitEEE12*(ZeitEEE_3==1) +
wtp_ZeitEEE42*(ZeitEEE_3==2) + wtp_ZeitEEE72*(ZeitEEE_3==3) + wtp_ZeitEEEunb*(ZeitEEE_3==4) + Beitr_3 )
### Define settings for MNL model component
mnl_settings = list(
alternatives = c(SQ=1, RefA=2, RefB=3),
choiceVar = Choice,
utilities = V
)
### 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)
### Prepare and return outputs of function
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
# ################################################################# #
#### MODEL ESTIMATION AND OUTPUT ####
# ################################################################# #
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
Output_MNL_WTP <- apollo_modelOutput(model, modelOutput_settings = modelOutput_Liste)
apollo_saveOutput(model, saveOutput_settings = modelOutput_Liste)
_____Results_____
Estimates:
b0 -0.9609
b_Beitr -0.4863
wtp_HoeheEEE300 -2.8896
wtp_HoeheEEE600 -2.1069
wtp_HoeheEEE900 -0.9317
wtp_HoeheEEEunb 0.0000
wtp_ZeitEEE12 -2.1826
wtp_ZeitEEE42 -1.2246
wtp_ZeitEEE72 -0.5634
wtp_ZeitEEEunb 0.0000
_______________________
Questions:
- When using the Delta-method I´ve multiplied the estimate with "-1" (see code) as all parameters besides cost parameter (b_Beitr) were positive. Is that the right approach? Delta-method results then make perfect sense but the results from WTP space have the "wrong" sign as there e.g. should be higher WTP for HoeheEEE300 than for HoeheEEE600. Do you see why this issue with the sign could be the case? I did not find any similar case in the manual or the forum.
- My cost attribute Beitr is in the unit of percent (1,6%, 1,8%, 3,3%, 4,8%). How can it be derived from the coefficients how much percentage points more someone is willing to pay for a shift from HoeheEEEunb (reference category) to HoeheEEE300 (or from HoeheEEE300 to HoeheEEE600 etc.)?
And can it also be said that WTP for HoeheEEE300 is xy%? I am a bit confused, as I could not find examples for concrete wtp estimates interpretation for dummy coded attributes.
Any clarification is highly appreciated.
Thanks and best,
J.