Thank you for your quick response. I was trying to do some debug myself. I think the problem occurs when a latent class is added to the MDCEV model. Within the prediction function, apollo_probabilities uses the function "prediction" rather than "estimate". But P[[paste0("Class_",s)]] = apollo_panelProd(P[[paste0("Class_",s)]], apollo_inputs ,functionality = "prediction") caused the bug. Because when functionality is "estimate", apollo_panelProd calculates the probability for each INDIVIDUAL instead of each OBSERVATION for the panel data. But when it is "prediction", somehow it still gives the probability at the observation level instead of the individual level. My guess is MDCEV takes a lot of draws and somehow messed it up when latent class is added? I tried the prediction without latent class and no problem at all.
Here is my code which is a bit long. I can provide the saved R file in private if it helps.
Code: Select all
apollo_beta = c(
gamma_v1_a = 1.073,
gamma_v2_a = 1.192,
gamma_v3_a = 1.369,
gamma_v4_a = 1.120,
gamma_v5_a = 1.185,
gamma_outside_a = 0,
delta_v1_a = -6.252,
delta_v2_a = -6.242,
delta_v3_a = -6.264,
delta_v4_a = -6.151,
delta_v5_a = -6.237,
delta_outside_a = 0,
gamma_v1_b = 1.152,
gamma_v2_b = 1.194,
gamma_v3_b = 1.282,
gamma_v4_b = 1.272,
gamma_v5_b = 1.155,
gamma_outside_b = 0,
delta_v1_b = -3.759,
delta_v2_b = -3.873,
delta_v3_b = -3.705,
delta_v4_b = -3.812,
delta_v5_b = -3.484,
delta_outside_b = 0,
sigma = 0.99,
bweekend_a = 0.059, bnpv_a = -0.005, bnclick_a = 0.077, bnbuy_a = -0.540 , nrccpv_a=-0.011, nrccclick_a=0.267, nrccbuy_a=0.112,
badstockpsai_a = 1.082, badstockgamma1_a = 0.203, bresidual_a = 0,
bweekend_b = -0.013, bnpv_b = -0.011, bnclick_b = 0.080, bnbuy_b = -1.005 , nrccpv_b=-0.055, nrccclick_b=0.194, nrccbuy_b=-0.806,
badstockpsai_b = 1.087, badstockgamma1_b = 0.098, bresidual_b = 0,
delta_a = 8.197,
gamma_N_pot_subcat_full_a = -3.338,
gamma_Z_pvperday_a = -5.954
)
### 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( "delta_outside_a", "delta_outside_b", "gamma_outside_a", "gamma_outside_b" , "sigma" ) #, "delta_v5_b")
# ################################################################# #
#### DEFINE LATENT CLASS COMPONENTS ####
# ################################################################# #
apollo_lcPars=function(apollo_beta, apollo_inputs){
lcpars = list()
lcpars[["gamma_v1"]] = list(gamma_v1_a, gamma_v1_b)
lcpars[["gamma_v2"]] = list(gamma_v2_a, gamma_v2_b)
lcpars[["gamma_v3"]] = list(gamma_v3_a, gamma_v3_b)
lcpars[["gamma_v4"]] = list(gamma_v4_a, gamma_v4_b)
lcpars[["gamma_v5"]] = list(gamma_v5_a, gamma_v5_b)
lcpars[["gamma_outside"]] = list(gamma_outside_a, gamma_outside_b)
lcpars[["delta_v1"]] = list(delta_v1_a, delta_v1_b)
lcpars[["delta_v2"]] = list(delta_v2_a, delta_v2_b)
lcpars[["delta_v3"]] = list(delta_v3_a, delta_v3_b)
lcpars[["delta_v4"]] = list(delta_v4_a, delta_v4_b)
lcpars[["delta_v5"]] = list(delta_v5_a, delta_v5_b)
lcpars[["delta_outside"]] = list(delta_outside_a, delta_outside_b)
lcpars[["bweekend"]] = list(bweekend_a , bweekend_b )
lcpars[["bnpv"]] = list( bnpv_a , bnpv_b )
lcpars[["bnclick"]] = list( bnclick_a , bnclick_b )
lcpars[["bnbuy"]] = list(bnbuy_a , bnbuy_b )
lcpars[["nrccpv"]] = list(nrccpv_a , nrccpv_b )
lcpars[["nrccclick"]] = list(nrccclick_a , nrccclick_b )
lcpars[["nrccbuy"]] = list(nrccbuy_a , nrccbuy_b )
lcpars[["badstockpsai"]] = list(badstockpsai_a , badstockpsai_b )
lcpars[["badstockgamma1"]] = list(badstockgamma1_a , badstockgamma1_b )
lcpars[["bresidual"]] = list(bresidual_a, bresidual_b)
#This part is the probability of each class.
V=list()
V[["class_a"]] = delta_a + gamma_N_pot_subcat_full_a*N_pot_subcat_full + gamma_Z_pvperday_a*Z_pvperday
V[["class_b"]] = 0
#This part is the probability of each class.
mnl_settings = list(
alternatives = c(class_a=1, class_b=2),
avail = 1,
choiceVar = NA,
V = V
)
lcpars[["pi_values"]] = apollo_mnl(mnl_settings, functionality="raw") #this part returns the probability. It use "raw" to ensure that the probabilities are returned for all alternatives.
#This is also why avail choicevar is NA
##This code below makes sure that the probability is assigned to each individual, not each observation in panel data
lcpars[["pi_values"]] = apollo_firstRow(lcpars[["pi_values"]], apollo_inputs)
return(lcpars)
}
# ################################################################# #
#### 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()
### Define individual alternatives
alternatives = c("v1",
"v2",
"v3",
"v4",
"v5",
"outside")
### Define availabilities
avail = list(v1 = availnew1, ######Need to check whether it works here
v2 = availnew2,
v3 = availnew3,
v4 = availnew4,
v5 = availnew5,
outside = avail15)
### Define continuous consumption for individual alternatives
continuousChoice = list(v1 =clicknew1,
v2 =clicknew2,
v3 =clicknew3,
v4 =clicknew4,
v5 =clicknew5,
outside =outsideclick)
### Define alpha parameters
alpha = list(v1 = 1e-3 ,
v2 = 1e-3 ,
v3 = 1e-3 ,
v4 = 1e-3 ,
v5 = 1e-3 ,
# v6 = 1e-3 ,
# v7 = 1e-3 ,
# v8 = 1e-3 ,
# v9 = 1e-3 ,
# v10 = 1e-3 ,
# v11 = 1e-3 ,
# v12 = 1e-3 ,
# v13 = 1e-3 ,
# v14 = 1e-3 ,
outside = 1e-3 )
### Define costs for individual alternatives
cost = list(v1 = 1,
v2 = 1,
v3 = 1,
v4 = 1,
v5 = 1,
# v6 = 1,
# v7 = 1,
# v8 = 1,
# v9 = 1,
# v10 = 1,
# v11 = 1,
# v12 = 1,
# v13 = 1,
# v14 = 1,
outside = 1)
### Define budget
budget = sum_click_updated
### Define settings for MDCEV model
mdcev_settings <- list(alternatives = alternatives,
avail = avail,
continuousChoice = continuousChoice,
#V = V,
alpha = alpha,
#gamma = gamma,
sigma = sigma,
cost = cost,
budget = budget)
### Loop over classes
s=1
while(s<=2){
### ### Compute class-specific utilities
V = list()
V[["v1" ]] = delta_v1[[s]] + bweekend[[s]]*weekend + bnpv[[s]]*npvnew1 + bnclick[[s]]*nclicknew1 + bnbuy[[s]]*nbuynew1 +
nrccpv[[s]]*rccpvnew1 + nrccclick[[s]]*rccclicknew1 + nrccbuy[[s]]*rccbuynew1 + badstockpsai[[s]]*ad1new + bresidual[[s]]*res1
V[["v2" ]] = delta_v2[[s]] + bweekend[[s]]*weekend + bnpv[[s]]*npvnew2 + bnclick[[s]]*nclicknew2 + bnbuy[[s]]*nbuynew2 +
nrccpv[[s]]*rccpvnew2 + nrccclick[[s]]*rccclicknew2 + nrccbuy[[s]]*rccbuynew2 + badstockpsai[[s]]*ad2new + bresidual[[s]]*res2
V[["v3" ]] = delta_v3[[s]] + bweekend[[s]]*weekend + bnpv[[s]]*npvnew3 + bnclick[[s]]*nclicknew3 + bnbuy[[s]]*nbuynew3 +
nrccpv[[s]]*rccpvnew3 + nrccclick[[s]]*rccclicknew3 + nrccbuy[[s]]*rccbuynew3 + badstockpsai[[s]]*ad3new + bresidual[[s]]*res3
V[["v4"]] = delta_v4[[s]] + bweekend[[s]]*weekend + bnpv[[s]]*npvnew4 + bnclick[[s]]*nclicknew4 + bnbuy[[s]]*nbuynew4 +
nrccpv[[s]]*rccpvnew4 + nrccclick[[s]]*rccclicknew4 + nrccbuy[[s]]*rccbuynew4 + badstockpsai[[s]]*ad4new + bresidual[[s]]*res4
V[["v5"]] = delta_v5[[s]] + bweekend[[s]]*weekend + bnpv[[s]]*npvnew5 + bnclick[[s]]*nclicknew5 + bnbuy[[s]]*nbuynew5 +
nrccpv[[s]]*rccpvnew5 + nrccclick[[s]]*rccclicknew5 + nrccbuy[[s]]*rccbuynew5 + badstockpsai[[s]]*ad5new + bresidual[[s]]*res5
V[["outside"]] = delta_outside[[s]]
### Define gamma parameters
gamma = list(v1 = gamma_v1[[s]]+ badstockgamma1[[s]]*ad1new,
v2 = gamma_v2[[s]]+ badstockgamma1[[s]]*ad2new,
v3 = gamma_v3[[s]]+ badstockgamma1[[s]]*ad3new,
v4 = gamma_v4[[s]]+ badstockgamma1[[s]]*ad4new,
v5 = gamma_v5[[s]]+ badstockgamma1[[s]]*ad5new,
outside = gamma_outside[[s]])
mdcev_settings$V = V
mdcev_settings$gamma = gamma
mdcev_settings$componentName = paste0("Class_",s)
### Compute within-class choice probabilities using MNL model
P[[paste0("Class_",s)]] = apollo_mdcev(mdcev_settings, functionality)
### Take product across observation for same individual
P[[paste0("Class_",s)]] = apollo_panelProd(P[[paste0("Class_",s)]], apollo_inputs ,functionality)
s=s+1}
### Compute latent class model probabilities
lc_settings = list(inClassProb = P, classProb=pi_values)
P[["model"]] = apollo_lc(lc_settings, apollo_inputs, functionality)
### Prepare and return outputs of function
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
# ################################################################# #
#### MODEL ESTIMATION ####
# ################################################################# #
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs, estimate_settings = list(estimationRoutine = "bhhh", maxIterations = 20000))
# ----------------------------------------------------------------- #
#---- MODEL PREDICTIONS AND ELASTICITY CALCULATIONS ----
# ----------------------------------------------------------------- #
### Use the estimated model to make predictions not working here.
predictions_base = apollo_prediction(model, apollo_probabilities, apollo_inputs, prediction_settings=list(runs=30, modelComponent = "LC"))