I have a pretty complex model (lots of interactions). Originally, I estimated it in WTP space, but now I'd like to have it also in preference space (easier to interpret, at least for me). The problem is that the preference space version doesn't work (the error always is "CALCULATION ISSUE - Log-likelihood calculation fails at values close to the starting values!") - even though it's mostly copy-and-pasted code... I played around a bit with the starting values; the only situation in which the model didn't fail was when I threw out the socio-demographic interactions - but I need them, and in the WTP-space version, they worked just fine. Any ideas where the problem might be?
Here's the WTP-space version:
Code: Select all
apollo_beta <- c(asc_1 = 0,
asc_2 = 0,
asc_3 = 0,
# attribute level means
b_climate_1.8 = 0,
m_b_climate_1.5 = 0.01,
m_b_climate_1.2 = 0.01,
b_flood_freq = 0,
m_b_flood_10 = 0.01,
m_b_flood_20 = 0.01,
b_drought_freq = 0,
m_b_drought_10 = 0.01,
m_b_drought_20 = 0.01,
b_water_30 = 0,
m_b_water_35 = 0.01,
m_b_water_40 = 0.01,
b_habitat_high = 0,
m_b_habitat_half = 0.01,
m_log_b_cost = -1,
# attribute level standard deviations
sigma_b_climate_1.5 = 0.01,
sigma_b_climate_1.2 = 0.01,
sigma_b_flood_10 = 0.01,
sigma_b_flood_20 = 0.01,
sigma_b_drought_10 = 0.01,
sigma_b_drought_20 = 0.01,
sigma_b_water_35 = 0.01,
sigma_b_water_40 = 0.01,
sigma_b_habitat_half = 0.01,
sigma_log_b_cost = 1,
# regional interactions
b_basinds_climate15 = 0,
b_basinds_climate12 = 0,
b_basinds_flood10 = 0,
b_basinds_flood20 = 0,
b_basinds_drought10 = 0,
b_basinds_drought20 = 0,
b_basinds_water35 = 0,
b_basinds_water40 = 0,
b_basinds_habitathalf = 0,
b_basinwt_climate15 = 0,
b_basinwt_climate12 = 0,
b_basinwt_flood10 = 0,
b_basinwt_flood20 = 0,
b_basinwt_drought10 = 0,
b_basinwt_drought20 = 0,
b_basinwt_water35 = 0,
b_basinwt_water40 = 0,
b_basinwt_habitathalf = 0,
# socio-demographic interactions
b_male_climate15 = 0,
b_male_climate12 = 0,
b_male_flood10 = 0,
b_male_flood20 = 0,
b_male_drought10 = 0,
b_male_drought20 = 0,
b_male_water35 = 0,
b_male_water40 = 0,
b_male_habitathalf = 0,
b_urban_climate15 = 0,
b_urban_climate12 = 0,
b_urban_flood10 = 0,
b_urban_flood20 = 0,
b_urban_drought10 = 0,
b_urban_drought20 = 0,
b_urban_water35 = 0,
b_urban_water40 = 0,
b_urban_habitathalf = 0,
b_edu_climate15 = 0,
b_edu_climate12 = 0,
b_edu_flood10 = 0,
b_edu_flood20 = 0,
b_edu_drought10 = 0,
b_edu_drought20 = 0,
b_edu_water35 = 0,
b_edu_water40 = 0,
b_edu_habitathalf = 0,
b_income_climate15 = 0,
b_income_climate12 = 0,
b_income_flood10 = 0,
b_income_flood20 = 0,
b_income_drought10 = 0,
b_income_drought20 = 0,
b_income_water35 = 0,
b_income_water40 = 0,
b_income_habitathalf = 0,
# experience interactions
b_exp_drought10 = 0,
b_exp_drought20 = 0,
b_exp_flood10 = 0,
b_exp_flood20 = 0
)
apollo_fixed <- c("asc_1",
"b_climate_1.8",
"b_flood_freq",
"b_drought_freq",
"b_water_30",
"b_habitat_high"
)
apollo_draws = list(interDrawsType = "sobol",
interNDraws = 1000,
interNormDraws = c("draws_cost_inter",
"draws_climate15_inter",
"draws_climate12_inter",
"draws_flood10_inter",
"draws_flood20_inter",
"draws_drought10_inter",
"draws_drought20_inter",
"draws_water35_inter",
"draws_water40_inter",
"draws_habitatha_inter")
)
apollo_randCoeff = function(apollo_beta,apollo_inputs){
randcoeff = list()
randcoeff[["b_climate_1.5"]] = m_b_climate_1.5 + sigma_b_climate_1.5 * draws_climate15_inter
randcoeff[["b_climate_1.2"]] = m_b_climate_1.2 + sigma_b_climate_1.2 * draws_climate12_inter
randcoeff[["b_flood_10"]] = m_b_flood_10 + sigma_b_flood_10 * draws_flood10_inter
randcoeff[["b_flood_20"]] = m_b_flood_20 + sigma_b_flood_20 * draws_flood20_inter
randcoeff[["b_drought_10"]] = m_b_drought_10 + sigma_b_drought_10 * draws_drought10_inter
randcoeff[["b_drought_20"]] = m_b_drought_20 + sigma_b_drought_20 * draws_drought20_inter
randcoeff[["b_water_35"]] = m_b_water_35 + sigma_b_water_35 * draws_water35_inter
randcoeff[["b_water_40"]] = m_b_water_40 + sigma_b_water_40 * draws_water40_inter
randcoeff[["b_habitat_half"]] = m_b_habitat_half + sigma_b_habitat_half * draws_habitatha_inter
randcoeff[["b_cost"]] = -exp(m_log_b_cost + sigma_log_b_cost * draws_cost_inter)
return(randcoeff)
}
apollo_inputs <- apollo_validateInputs()
apollo_probabilities <- function(apollo_beta, apollo_inputs, functionality = "estimate"){
apollo_attach(apollo_beta, apollo_inputs)
on.exit(apollo_detach(apollo_beta, apollo_inputs))
P = list()
# interaction terms
b_climate15 = b_climate_1.5 + b_basinds_climate15 * (basin == "ds") + b_basinwt_climate15 * (basin == "wt") +
b_male_climate15 * (gender == 1) + b_urban_climate15 * (household == 1) + b_edu_climate15 * edu + b_income_climate15 * income
b_climate12 = b_climate_1.2 + b_basinds_climate12 * (basin == "ds") + b_basinwt_climate12 * (basin == "wt") +
b_male_climate12 * (gender == 1) + b_urban_climate12 * (household == 1) + b_edu_climate12 * edu + b_income_climate12 * income
b_flood10 = b_flood_10 + b_basinds_flood10 * (basin == "ds") + b_basinwt_flood10 * (basin == "wt") +
b_male_flood10 * (gender == 1) + b_urban_flood10 * (household == 1) + b_edu_flood10 * edu + b_income_flood10 * income +
b_exp_flood10 * exp_flood
b_flood20 = b_flood_20 + b_basinds_flood20 * (basin == "ds") + b_basinwt_flood20 * (basin == "wt") +
b_male_flood20 * (gender == 1) + b_urban_flood20 * (household == 1) + b_edu_flood20 * edu + b_income_flood20 * income +
b_exp_flood20 * exp_flood
b_drought10 = b_drought_10 + b_basinds_drought10 * (basin == "ds") + b_basinwt_drought10 * (basin == "wt") +
b_male_drought10 * (gender == 1) + b_urban_drought10 * (household == 1) + b_edu_drought10 * edu + b_income_drought10 * income +
b_exp_drought10 * exp_drought
b_drought20 = b_drought_20 + b_basinds_drought20 * (basin == "ds") + b_basinwt_drought20 * (basin == "wt") +
b_male_drought20 * (gender == 1) + b_urban_drought20 * (household == 1) + b_edu_drought20 * edu + b_income_drought20 * income +
b_exp_drought20 * exp_drought
b_water35 = b_water_35 + b_basinds_water35 * (basin == "ds") + b_basinwt_water35 * (basin == "wt") +
b_male_water35 * (gender == 1) + b_urban_water35 * (household == 1) + b_edu_water35 * edu + b_income_water35 * income
b_water40 = b_water_40 + b_basinds_water40 * (basin == "ds") + b_basinwt_water40 * (basin == "wt") +
b_male_water40 * (gender == 1) + b_urban_water40 * (household == 1) + b_edu_water40 * edu + b_income_water40 * income
b_habitathalf = b_habitat_half + b_basinds_habitathalf * (basin == "ds") + b_basinwt_habitathalf * (basin == "wt") +
b_male_habitathalf * (gender == 1) + b_urban_habitathalf * (household == 1) + b_edu_habitathalf * edu + b_income_habitathalf * income
V = list()
V[['alt1']] = (asc_1 + b_cost * (
b_climate_1.8 * (alt1.climate == "1.8_degrees") + b_climate15 * (alt1.climate == "1.5_degrees") + b_climate12 * (alt1.climate == "1.2_degrees") +
b_flood_freq * (alt1.flood == "frequent") + b_flood10 * (alt1.flood == "10_%") + b_flood20 * (alt1.flood == "20_%") +
b_drought_freq * (alt1.drought == "frequent") + b_drought10 * (alt1.drought == "10_%") + b_drought20 * (alt1.drought == "20_%") +
b_water_30 * (alt1.freshwater == "30_mil") + b_water35 * (alt1.freshwater == "35_mil") + b_water40 * (alt1.freshwater == "40_mil") +
b_habitat_high * (alt1.habitat == "high_risk") + b_habitathalf * (alt1.habitat == "half_risk") +
alt1.cost))
V[['alt2']] = (asc_2 + b_cost * (
b_climate_1.8 * (alt2.climate == "1.8_degrees") + b_climate15 * (alt2.climate == "1.5_degrees") + b_climate12 * (alt2.climate == "1.2_degrees") +
b_flood_freq * (alt2.flood == "frequent") + b_flood10 * (alt2.flood == "10_%") + b_flood20 * (alt2.flood == "20_%") +
b_drought_freq * (alt2.drought == "frequent") + b_drought10 * (alt2.drought == "10_%") + b_drought20 * (alt2.drought == "20_%") +
b_water_30 * (alt2.freshwater == "30_mil") + b_water35 * (alt2.freshwater == "35_mil") + b_water40 * (alt2.freshwater == "40_mil") +
b_habitat_high * (alt2.habitat == "high_risk") + b_habitathalf * (alt2.habitat == "half_risk") +
alt2.cost))
V[['alt3']] = (asc_3 + b_cost* (
b_climate_1.8 * (sq.climate == "1.8_degrees") +
b_flood_freq * (sq.flood == "frequent") +
b_drought_freq * (sq.drought == "frequent") +
b_water_30 * (sq.freshwater == "30_mil") +
b_habitat_high * (sq.habitat == "high_risk") +
sq.cost))
mnl_settings = list(
alternatives = c(alt1 = 1, alt2 = 2, alt3 = 3),
choiceVar = RES,
V = V
)
P[["model"]] = apollo_mnl(mnl_settings, functionality)
P = apollo_panelProd(P, apollo_inputs, functionality)
P = apollo_avgInterDraws(P, apollo_inputs, functionality)
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
mxl_wtp_inter <- apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
Code: Select all
apollo_beta <- c(asc_1 = 0,
asc_2 = 0,
asc_3 = 0,
# attribute level means
b_climate_1.8 = 0,
m_b_climate_1.5 = 0.01,
m_b_climate_1.2 = 0.01,
b_flood_freq = 0,
m_b_flood_10 = 0.01,
m_b_flood_20 = 0.01,
b_drought_freq = 0,
m_b_drought_10 = 0.01,
m_b_drought_20 = 0.01,
b_water_30 = 0,
m_b_water_35 = 0.01,
m_b_water_40 = 0.01,
b_habitat_high = 0,
m_b_habitat_half = 0.01,
m_log_b_cost = -1,
# attribute level standard deviations
sigma_b_climate_1.5 = 0.01,
sigma_b_climate_1.2 = 0.01,
sigma_b_flood_10 = 0.01,
sigma_b_flood_20 = 0.01,
sigma_b_drought_10 = 0.01,
sigma_b_drought_20 = 0.01,
sigma_b_water_35 = 0.01,
sigma_b_water_40 = 0.01,
sigma_b_habitat_half = 0.01,
sigma_log_b_cost = 1,
# regional interactions
b_basinds_climate15 = 0,
b_basinds_climate12 = 0,
b_basinds_flood10 = 0,
b_basinds_flood20 = 0,
b_basinds_drought10 = 0,
b_basinds_drought20 = 0,
b_basinds_water35 = 0,
b_basinds_water40 = 0,
b_basinds_habitathalf = 0,
b_basinwt_climate15 = 0,
b_basinwt_climate12 = 0,
b_basinwt_flood10 = 0,
b_basinwt_flood20 = 0,
b_basinwt_drought10 = 0,
b_basinwt_drought20 = 0,
b_basinwt_water35 = 0,
b_basinwt_water40 = 0,
b_basinwt_habitathalf = 0,
# socio-demographic interactions
b_male_climate15 = 0,
b_male_climate12 = 0,
b_male_flood10 = 0,
b_male_flood20 = 0,
b_male_drought10 = 0,
b_male_drought20 = 0,
b_male_water35 = 0,
b_male_water40 = 0,
b_male_habitathalf = 0,
b_urban_climate15 = 0,
b_urban_climate12 = 0,
b_urban_flood10 = 0,
b_urban_flood20 = 0,
b_urban_drought10 = 0,
b_urban_drought20 = 0,
b_urban_water35 = 0,
b_urban_water40 = 0,
b_urban_habitathalf = 0,
b_edu_climate15 = 0,
b_edu_climate12 = 0,
b_edu_flood10 = 0,
b_edu_flood20 = 0,
b_edu_drought10 = 0,
b_edu_drought20 = 0,
b_edu_water35 = 0,
b_edu_water40 = 0,
b_edu_habitathalf = 0,
b_income_climate15 = 0,
b_income_climate12 = 0,
b_income_flood10 = 0,
b_income_flood20 = 0,
b_income_drought10 = 0,
b_income_drought20 = 0,
b_income_water35 = 0,
b_income_water40 = 0,
b_income_habitathalf = 0,
# experience interactions
b_exp_drought10 = 0,
b_exp_drought20 = 0,
b_exp_flood10 = 0,
b_exp_flood20 = 0
)
apollo_fixed <- c("asc_1",
"b_climate_1.8",
"b_flood_freq",
"b_drought_freq",
"b_water_30",
"b_habitat_high"
)
apollo_draws = list(interDrawsType = "sobol",
interNDraws = 1000,
interNormDraws = c("draws_cost_inter",
"draws_climate15_inter",
"draws_climate12_inter",
"draws_flood10_inter",
"draws_flood20_inter",
"draws_drought10_inter",
"draws_drought20_inter",
"draws_water35_inter",
"draws_water40_inter",
"draws_habitatha_inter")
)
apollo_randCoeff = function(apollo_beta,apollo_inputs){
randcoeff = list()
randcoeff[["b_climate_1.5"]] = m_b_climate_1.5 + sigma_b_climate_1.5 * draws_climate15_inter
randcoeff[["b_climate_1.2"]] = m_b_climate_1.2 + sigma_b_climate_1.2 * draws_climate12_inter
randcoeff[["b_flood_10"]] = m_b_flood_10 + sigma_b_flood_10 * draws_flood10_inter
randcoeff[["b_flood_20"]] = m_b_flood_20 + sigma_b_flood_20 * draws_flood20_inter
randcoeff[["b_drought_10"]] = m_b_drought_10 + sigma_b_drought_10 * draws_drought10_inter
randcoeff[["b_drought_20"]] = m_b_drought_20 + sigma_b_drought_20 * draws_drought20_inter
randcoeff[["b_water_35"]] = m_b_water_35 + sigma_b_water_35 * draws_water35_inter
randcoeff[["b_water_40"]] = m_b_water_40 + sigma_b_water_40 * draws_water40_inter
randcoeff[["b_habitat_half"]] = m_b_habitat_half + sigma_b_habitat_half * draws_habitatha_inter
randcoeff[["b_cost"]] = -exp(m_log_b_cost + sigma_log_b_cost * draws_cost_inter)
return(randcoeff)
}
apollo_inputs <- apollo_validateInputs()
apollo_probabilities <- function(apollo_beta, apollo_inputs, functionality = "estimate"){
apollo_attach(apollo_beta, apollo_inputs)
on.exit(apollo_detach(apollo_beta, apollo_inputs))
P = list()
# interaction terms
b_climate15 = b_climate_1.5 + b_basinds_climate15 * (basin == "ds") + b_basinwt_climate15 * (basin == "wt") +
b_male_climate15 * (gender == 1) + b_urban_climate15 * (household == 1) + b_edu_climate15 * edu + b_income_climate15 * income
b_climate12 = b_climate_1.2 + b_basinds_climate12 * (basin == "ds") + b_basinwt_climate12 * (basin == "wt") +
b_male_climate12 * (gender == 1) + b_urban_climate12 * (household == 1) + b_edu_climate12 * edu + b_income_climate12 * income
b_flood10 = b_flood_10 + b_basinds_flood10 * (basin == "ds") + b_basinwt_flood10 * (basin == "wt") +
b_male_flood10 * (gender == 1) + b_urban_flood10 * (household == 1) + b_edu_flood10 * edu + b_income_flood10 * income +
b_exp_flood10 * exp_flood
b_flood20 = b_flood_20 + b_basinds_flood20 * (basin == "ds") + b_basinwt_flood20 * (basin == "wt") +
b_male_flood20 * (gender == 1) + b_urban_flood20 * (household == 1) + b_edu_flood20 * edu + b_income_flood20 * income +
b_exp_flood20 * exp_flood
b_drought10 = b_drought_10 + b_basinds_drought10 * (basin == "ds") + b_basinwt_drought10 * (basin == "wt") +
b_male_drought10 * (gender == 1) + b_urban_drought10 * (household == 1) + b_edu_drought10 * edu + b_income_drought10 * income +
b_exp_drought10 * exp_drought
b_drought20 = b_drought_20 + b_basinds_drought20 * (basin == "ds") + b_basinwt_drought20 * (basin == "wt") +
b_male_drought20 * (gender == 1) + b_urban_drought20 * (household == 1) + b_edu_drought20 * edu + b_income_drought20 * income +
b_exp_drought20 * exp_drought
b_water35 = b_water_35 + b_basinds_water35 * (basin == "ds") + b_basinwt_water35 * (basin == "wt") #+
b_male_water35 * (gender == 1) + b_urban_water35 * (household == 1) + b_edu_water35 * edu + b_income_water35 * income
b_water40 = b_water_40 + b_basinds_water40 * (basin == "ds") + b_basinwt_water40 * (basin == "wt") #+
b_male_water40 * (gender == 1) + b_urban_water40 * (household == 1) + b_edu_water40 * edu + b_income_water40 * income
b_habitathalf = b_habitat_half + b_basinds_habitathalf * (basin == "ds") + b_basinwt_habitathalf * (basin == "wt") #+
b_male_habitathalf * (gender == 1) + b_urban_habitathalf * (household == 1) + b_edu_habitathalf * edu + b_income_habitathalf * income
V = list()
V[['alt1']] = (asc_1 +
b_climate_1.8 * (alt1.climate == "1.8_degrees") + b_climate15 * (alt1.climate == "1.5_degrees") + b_climate12 * (alt1.climate == "1.2_degrees") +
b_flood_freq * (alt1.flood == "frequent") + b_flood10 * (alt1.flood == "10_%") + b_flood20 * (alt1.flood == "20_%") +
b_drought_freq * (alt1.drought == "frequent") + b_drought10 * (alt1.drought == "10_%") + b_drought20 * (alt1.drought == "20_%") +
b_water_30 * (alt1.freshwater == "30_mil") + b_water35 * (alt1.freshwater == "35_mil") + b_water40 * (alt1.freshwater == "40_mil") +
b_habitat_high * (alt1.habitat == "high_risk") + b_habitathalf * (alt1.habitat == "half_risk") +
b_cost * alt1.cost)
V[['alt2']] = (asc_2 +
b_climate_1.8 * (alt2.climate == "1.8_degrees") + b_climate15 * (alt2.climate == "1.5_degrees") + b_climate12 * (alt2.climate == "1.2_degrees") +
b_flood_freq * (alt2.flood == "frequent") + b_flood10 * (alt2.flood == "10_%") + b_flood20 * (alt2.flood == "20_%") +
b_drought_freq * (alt2.drought == "frequent") + b_drought10 * (alt2.drought == "10_%") + b_drought20 * (alt2.drought == "20_%") +
b_water_30 * (alt2.freshwater == "30_mil") + b_water35 * (alt2.freshwater == "35_mil") + b_water40 * (alt2.freshwater == "40_mil") +
b_habitat_high * (alt2.habitat == "high_risk") + b_habitathalf * (alt2.habitat == "half_risk") +
b_cost * alt2.cost)
V[['alt3']] = (asc_sq +
b_climate_1.8 * (sq.climate == "1.8_degrees") +
b_flood_freq * (sq.flood == "frequent") +
b_drought_freq * (sq.drought == "frequent") +
b_water_30 * (sq.freshwater == "30_mil") +
b_habitat_high * (sq.habitat == "high_risk") +
b_cost * sq.cost)
mnl_settings = list(
alternatives = c(alt1 = 1, alt2 = 2, alt3 = 3),
choiceVar = RES,
V = V
)
P[["model"]] = apollo_mnl(mnl_settings, functionality)
P = apollo_panelProd(P, apollo_inputs, functionality)
P = apollo_avgInterDraws(P, apollo_inputs, functionality)
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
mxl_all_inter <- apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)