Hi Prof. Hess,
I am facing a similar issue. I am computing latent-class latent-variable model. It has 7 random parameters (all LVs) and a total of 24 OL models for LVs. It is running since last 20 days on my 8 core PC (I am using 7 cores for computation). I have around 7200 observations for 702 IDs. Can you suggest how to increase the speed (other than using HPC, of course that is one of the solutions)?
Code: Select all
## Clear memory
rm(list = ls())
## Load apollo library
library(apollo)
## Initialise code
apollo_initialise()
## Set core controls
apollo_control = list(
modelName = "LC with MMNL",
modelDescr = "LC with random coefficients",
indivID = "ID",
nCores = 7,
outputDirectory = "output"
)
## Load data
database = read.csv("Analysis.csv", header = T)
## Define model parameters
## Vector of parameters to be estimated
apollo_beta = c(
## class-specific choice utility
# class a
asc_car_a = 0, car_ivtt_a = 0, car_egt_a = 0, car_tc_a = 0, car_pc_a = 0, lm_innv_car_a = 0, lm_skpt_car_a = 0, lm_risk_car_a = 0, lm_use_car_a = 0, lm_sn_car_a = 0, lm_env_car_a = 0,
asc_pt_a = 0, pt_ivtt_a = 0, pt_act_a = 0, pt_egt_a = 0, pt_wt_a = 0, pt_tc_a = 0, lm_innv_pt_a = 0, lm_skpt_pt_a = 0, lm_risk_pt_a = 0, lm_use_pt_a = 0, lm_sn_pt_a = 0, lm_env_pt_a = 0,
asc_ecar_a = 0, ecar_ivtt_a = 0, ecar_act_a = 0, ecar_egt_a = 0, ecar_tc_a = 0, ecar_av_a = 0, ecar_wt_a = 0, lm_innv_ecar_a = 0, lm_skpt_ecar_a = 0, lm_risk_ecar_a = 0, lm_use_ecar_a = 0, lm_sn_ecar_a = 0, lm_env_ecar_a = 0,
asc_ebike_a = 0, ebike_ivtt_a = 0, ebike_act_a = 0, ebike_egt_a = 0, ebike_tc_a = 0, ebike_av_a = 0, ebike_wt_a = 0, lm_innv_ebike_a = 0, lm_skpt_ebike_a = 0, lm_risk_ebike_a = 0, lm_use_ebike_a = 0, lm_sn_ebike_a = 0, lm_env_ebike_a = 0,
asc_escoot_a = 0, escoot_ivtt_a = 0, escoot_act_a = 0, escoot_egt_a = 0, escoot_tc_a = 0, escoot_av_a = 0, escoot_wt_a = 0, lm_innv_escoot_a = 0, lm_skpt_escoot_a = 0, lm_risk_escoot_a = 0, lm_use_escoot_a = 0, lm_sn_escoot_a = 0, lm_env_escoot_a = 0,
asc_aebike_a = 0, aebike_ivtt_a = 0, aebike_wk_a = 0, aebike_tc_a = 0, aebike_av_a = 0, aebike_wt_a = 0, lm_innv_aebike_a = 0, lm_skpt_aebike_a = 0, lm_risk_aebike_a = 0, lm_use_aebike_a = 0, lm_sn_aebike_a = 0, lm_env_aebike_a = 0,
asc_aescoot_a = 0, aescoot_ivtt_a = 0, aescoot_wk_a = 0, aescoot_tc_a = 0, aescoot_av_a = 0, aescoot_wt_a = 0, lm_innv_aescoot_a = 0, lm_skpt_aescoot_a = 0, lm_risk_aescoot_a = 0, lm_use_aescoot_a = 0, lm_sn_aescoot_a = 0, lm_env_aescoot_a = 0,
asc_awalk_a = 0, awalk_a = 0, lm_risk_awalk_a = 0, lm_use_awalk_a = 0,
# class b
asc_car_b = 0, car_ivtt_b = 0, car_egt_b = 0, car_tc_b = 0, car_pc_b = 0, lm_innv_car_b = 0, lm_skpt_car_b = 0, lm_risk_car_b = 0, lm_use_car_b = 0, lm_sn_car_b = 0, lm_env_car_b = 0,
asc_pt_b = 0, pt_ivtt_b = 0, pt_act_b = 0, pt_egt_b = 0, pt_wt_b = 0, pt_tc_b = 0, lm_innv_pt_b = 0, lm_skpt_pt_b = 0, lm_risk_pt_b = 0, lm_use_pt_b = 0, lm_sn_pt_b = 0, lm_env_pt_b = 0,
asc_ecar_b = 0, ecar_ivtt_b = 0, ecar_act_b = 0, ecar_egt_b = 0, ecar_tc_b = 0, ecar_av_b = 0, ecar_wt_b = 0, lm_innv_ecar_b = 0, lm_skpt_ecar_b = 0, lm_risk_ecar_b = 0, lm_use_ecar_b = 0, lm_sn_ecar_b = 0, lm_env_ecar_b = 0,
asc_ebike_b = 0, ebike_ivtt_b = 0, ebike_act_b = 0, ebike_egt_b = 0, ebike_tc_b = 0, ebike_av_b = 0, ebike_wt_b = 0, lm_innv_ebike_b = 0, lm_skpt_ebike_b = 0, lm_risk_ebike_b = 0, lm_use_ebike_b = 0, lm_sn_ebike_b = 0, lm_env_ebike_b = 0,
asc_escoot_b = 0, escoot_ivtt_b = 0, escoot_act_b = 0, escoot_egt_b = 0, escoot_tc_b = 0, escoot_av_b = 0, escoot_wt_b = 0, lm_innv_escoot_b = 0, lm_skpt_escoot_b = 0, lm_risk_escoot_b = 0, lm_use_escoot_b = 0, lm_sn_escoot_b = 0, lm_env_escoot_b = 0,
asc_aebike_b = 0, aebike_ivtt_b = 0, aebike_wk_b = 0, aebike_tc_b = 0, aebike_av_b = 0, aebike_wt_b = 0, lm_innv_aebike_b = 0, lm_skpt_aebike_b = 0, lm_risk_aebike_b = 0, lm_use_aebike_b = 0, lm_sn_aebike_b = 0, lm_env_aebike_b = 0,
asc_aescoot_b = 0, aescoot_ivtt_b = 0, aescoot_wk_b = 0, aescoot_tc_b = 0, aescoot_av_b = 0, aescoot_wt_b = 0, lm_innv_aescoot_b = 0, lm_skpt_aescoot_b = 0, lm_risk_aescoot_b = 0, lm_use_aescoot_b = 0, lm_sn_aescoot_b = 0, lm_env_aescoot_b = 0,
asc_awalk_b = 0, awalk_b = 0, lm_risk_awalk_b = 0, lm_use_awalk_b = 0,
# class c
asc_car_c = 0, car_ivtt_c = 0, car_egt_c = 0, car_tc_c = 0, car_pc_c = 0, lm_innv_car_c = 0, lm_skpt_car_c = 0, lm_risk_car_c = 0, lm_use_car_c = 0, lm_sn_car_c = 0, lm_env_car_c = 0,
asc_pt_c = 0, pt_ivtt_c = 0, pt_act_c = 0, pt_egt_c = 0, pt_wt_c = 0, pt_tc_c = 0, lm_innv_pt_c = 0, lm_skpt_pt_c = 0, lm_risk_pt_c = 0, lm_use_pt_c = 0, lm_sn_pt_c = 0, lm_env_pt_c = 0,
asc_ecar_c = 0, ecar_ivtt_c = 0, ecar_act_c = 0, ecar_egt_c = 0, ecar_tc_c = 0, ecar_av_c = 0, ecar_wt_c = 0, lm_innv_ecar_c = 0, lm_skpt_ecar_c = 0, lm_risk_ecar_c = 0, lm_use_ecar_c = 0, lm_sn_ecar_c = 0, lm_env_ecar_c = 0,
asc_ebike_c = 0, ebike_ivtt_c = 0, ebike_act_c = 0, ebike_egt_c = 0, ebike_tc_c = 0, ebike_av_c = 0, ebike_wt_c = 0, lm_innv_ebike_c = 0, lm_skpt_ebike_c = 0, lm_risk_ebike_c = 0, lm_use_ebike_c = 0, lm_sn_ebike_c = 0, lm_env_ebike_c = 0,
asc_escoot_c = 0, escoot_ivtt_c = 0, escoot_act_c = 0, escoot_egt_c = 0, escoot_tc_c = 0, escoot_av_c = 0, escoot_wt_c = 0, lm_innv_escoot_c = 0, lm_skpt_escoot_c = 0, lm_risk_escoot_c = 0, lm_use_escoot_c = 0, lm_sn_escoot_c = 0, lm_env_escoot_c = 0,
asc_aebike_c = 0, aebike_ivtt_c = 0, aebike_wk_c = 0, aebike_tc_c = 0, aebike_av_c = 0, aebike_wt_c = 0, lm_innv_aebike_c = 0, lm_skpt_aebike_c = 0, lm_risk_aebike_c = 0, lm_use_aebike_c = 0, lm_sn_aebike_c = 0, lm_env_aebike_c = 0,
asc_aescoot_c = 0, aescoot_ivtt_c = 0, aescoot_wk_c = 0, aescoot_tc_c = 0, aescoot_av_c = 0, aescoot_wt_c = 0, lm_innv_aescoot_c = 0, lm_skpt_aescoot_c = 0, lm_risk_aescoot_c = 0, lm_use_aescoot_c = 0, lm_sn_aescoot_c = 0, lm_env_aescoot_c = 0,
asc_awalk_c = 0, awalk_c = 0, lm_risk_awalk_c = 0, lm_use_awalk_c = 0,
## class-membership model
# class a
delta_a = 0, gm_female_a = 0, gm_age1_a = 0, gm_age2_a = 0, gm_age3_a = 0, gm_hhinc1_a = 0, gm_hhinc2_a = 0, gm_hhinc3_a = 0,
gm_ncar0_a = 0, gm_ncar1_a = 0, gm_ncar2_a = 0, gm_nbic0_a = 0, gm_nbic1_a = 0, gm_nbic2_a = 0, gm_hhC_a = 0, lm_hab_a = 0,
# class b
delta_b = 0, gm_female_b = 0, gm_age1_b = 0, gm_age2_b = 0, gm_age3_b = 0, gm_hhinc1_b = 0, gm_hhinc2_b = 0, gm_hhinc3_b = 0,
gm_ncar0_b = 0, gm_ncar1_b = 0, gm_ncar2_b = 0, gm_nbic0_b = 0, gm_nbic1_b = 0, gm_nbic2_b = 0, gm_hhC_b = 0, lm_hab_b = 0,
# class c
delta_c = 0, gm_female_c = 0, gm_age1_c = 0, gm_age2_c = 0, gm_age3_c = 0, gm_hhinc1_c = 0, gm_hhinc2_c = 0, gm_hhinc3_c = 0,
gm_ncar0_c = 0, gm_ncar1_c = 0, gm_ncar2_c = 0, gm_nbic0_c = 0, gm_nbic1_c = 0, gm_nbic2_c = 0, gm_hhC_c = 0, lm_hab_c = 0,
## structural model for LVs
gamma_age1 = 0, gamma_age2 = 0, gamma_age3 = 0, gamma_hhinc1 = 0, gamma_hhinc2 = 0, gamma_hhinc3 = 0, gamma_grad = 0, gamma_female = 0, gamma_ncar0 = 0, gamma_ncar1 = 0, gamma_ncar2 = 0,
gamma_nbic0 = 0, gamma_nbic1 = 0, gamma_nbic2 = 0,
## measurement model - LV to indicators
zeta_innv1 = 0, zeta_innv2 = 0, zeta_innv3 = 0, zeta_skpt1 = 0, zeta_skpt2 = 0, zeta_skpt3 = 0, zeta_risk1 = 0, zeta_risk2 = 0, zeta_risk3 = 0,
zeta_use1 = 0, zeta_use2 = 0, zeta_use3 = 0, zeta_use4 = 0, zeta_use5 = 0, zeta_sn1 = 0, zeta_sn2 = 0,
zeta_env1 = 0, zeta_env2 = 0, zeta_env3 = 0, zeta_hab1 = 0, zeta_hab2 = 0, zeta_hab3 = 0, zeta_hab4 = 0, zeta_hab5 = 0,
tau_innv1_1 = -2, tau_innv1_2 = -1, tau_innv1_3 = 1, tau_innv1_4 = 2,
tau_innv2_1 = -2, tau_innv2_2 = -1, tau_innv2_3 = 1, tau_innv2_4 = 2,
tau_innv3_1 = -2, tau_innv3_2 = -1, tau_innv3_3 = 1, tau_innv3_4 = 2,
tau_skpt1_1 = -2, tau_skpt1_2 = -1, tau_skpt1_3 = 1, tau_skpt1_4 = 2,
tau_skpt2_1 = -2, tau_skpt2_2 = -1, tau_skpt2_3 = 1, tau_skpt2_4 = 2,
tau_skpt3_1 = -2, tau_skpt3_2 = -1, tau_skpt3_3 = 1, tau_skpt3_4 = 2,
tau_risk1_1 = -2, tau_risk1_2 = -1, tau_risk1_3 = 1, tau_risk1_4 = 2,
tau_risk2_1 = -2, tau_risk2_2 = -1, tau_risk2_3 = 1, tau_risk2_4 = 2,
tau_risk3_1 = -2, tau_risk3_2 = -1, tau_risk3_3 = 1, tau_risk3_4 = 2,
tau_use1_1 = -2, tau_use1_2 = -1, tau_use1_3 = 1, tau_use1_4 = 2,
tau_use2_1 = -2, tau_use2_2 = -1, tau_use2_3 = 1, tau_use2_4 = 2,
tau_use3_1 = -2, tau_use3_2 = -1, tau_use3_3 = 1, tau_use3_4 = 2,
tau_use4_1 = -2, tau_use4_2 = -1, tau_use4_3 = 1, tau_use4_4 = 2,
tau_use5_1 = -2, tau_use5_2 = -1, tau_use5_3 = 1, tau_use5_4 = 2,
tau_sn1_1 = -2, tau_sn1_2 = -1, tau_sn1_3 = 1, tau_sn1_4 = 2,
tau_sn2_1 = -2, tau_sn2_2 = -1, tau_sn2_3 = 1, tau_sn2_4 = 2,
tau_env1_1 = -2, tau_env1_2 = -1, tau_env1_3 = 1, tau_env1_4 = 2,
tau_env2_1 = -2, tau_env2_2 = -1, tau_env2_3 = 1, tau_env2_4 = 2,
tau_env3_1 = -2, tau_env3_2 = -1, tau_env3_3 = 1, tau_env3_4 = 2,
tau_hab1_1 = -2, tau_hab1_2 = -1, tau_hab1_3 = 1, tau_hab1_4 = 2,
tau_hab2_1 = -2, tau_hab2_2 = -1, tau_hab2_3 = 1, tau_hab2_4 = 2,
tau_hab3_1 = -2, tau_hab3_2 = -1, tau_hab3_3 = 1, tau_hab3_4 = 2,
tau_hab4_1 = -2, tau_hab4_2 = -1, tau_hab4_3 = 1, tau_hab4_4 = 2,
tau_hab5_1 = -2, tau_hab5_2 = -1, tau_hab5_3 = 1, tau_hab5_4 = 2
)
## Define fixed parameters in model
apollo_fixed = c("asc_car_a", "asc_awalk_a", "asc_car_b", "asc_awalk_b", "asc_car_c", "asc_awalk_c", "delta_c", "gm_female_c", "gm_age1_c", "gm_age2_c", "gm_age3_c", "gm_hhinc1_c",
"gm_hhinc2_c", "gm_hhinc3_c", "gm_ncar0_c", "gm_ncar1_c", "gm_ncar2_c", "gm_nbic0_c", "gm_nbic1_c", "gm_nbic2_c", "gm_hhC_c", "lm_hab_c",
"gm_age3_a", "gm_age3_b", "gm_hhinc3_a", "gm_hhinc3_b", "gm_ncar0_a", "gm_ncar0_b", "gm_nbic0_a", "gm_nbic0_b",
"gamma_age3", "gamma_hhinc3", "gamma_ncar0", "gamma_nbic0")
## Define random parameters
apollo_draws = list(
interDrawsType = "mlhs",
interNDraws = 1000,
interNormDraws = c("eta1", "eta2", "eta3", "eta4", "eta5", "eta6", "eta7")
)
apollo_randCoeff = function(apollo_beta, apollo_inputs) {
randcoeff = list()
randcoeff[["innv"]] = gamma_female*female + gamma_age1*(age==1) + gamma_age2*(age==3) + gamma_age3*(age==5) + gamma_hhinc1*(hhinc==1) + gamma_hhinc2*(hhinc==3) + gamma_hhinc3*(hhinc==5) + gamma_grad*edu + eta1
randcoeff[["skpt"]] = gamma_female*female + gamma_age1*(age==1) + gamma_age2*(age==3) + gamma_age3*(age==5) + gamma_hhinc1*(hhinc==1) + gamma_hhinc2*(hhinc==3) + gamma_hhinc3*(hhinc==5) + gamma_grad*edu + eta2
randcoeff[["risk"]] = gamma_female*female + gamma_age1*(age==1) + gamma_age2*(age==3) + gamma_age3*(age==5) + gamma_hhinc1*(hhinc==1) + gamma_hhinc2*(hhinc==3) + gamma_hhinc3*(hhinc==5) + gamma_grad*edu + eta3
randcoeff[["use"]] = gamma_female*female + gamma_age1*(age==1) + gamma_age2*(age==3) + gamma_age3*(age==5) + gamma_hhinc1*(hhinc==1) + gamma_hhinc2*(hhinc==3) + gamma_hhinc3*(hhinc==5) + gamma_grad*edu + eta4
randcoeff[["sn"]] = gamma_female*female + gamma_age1*(age==1) + gamma_age2*(age==3) + gamma_age3*(age==5) + gamma_hhinc1*(hhinc==1) + gamma_hhinc2*(hhinc==3) + gamma_hhinc3*(hhinc==5) + gamma_grad*edu + eta5
randcoeff[["env"]] = gamma_female*female + gamma_age1*(age==1) + gamma_age2*(age==3) + gamma_age3*(age==5) + gamma_hhinc1*(hhinc==1) + gamma_hhinc2*(hhinc==3) + gamma_hhinc3*(hhinc==5) + gamma_grad*edu + eta6
randcoeff[["hab"]] = gamma_female*female + gamma_age1*(age==1) + gamma_age2*(age==3) + gamma_age3*(age==5) + gamma_hhinc1*(hhinc==1) + gamma_hhinc2*(hhinc==3) + gamma_hhinc3*(hhinc==5) + gamma_grad*edu +
gamma_ncar0*(ncar==0) + gamma_ncar1*(ncar==1) + gamma_ncar2*(ncar==2) + gamma_nbic0*(nbic==0) + gamma_nbic1*(nbic==1) + gamma_nbic2*(nbic==2) + eta7
return(randcoeff)
}
## Define latent class components
apollo_lcPars = function(apollo_beta, apollo_inputs){
lcpars = list()
lcpars[["asc_car"]] = list(asc_car_a, asc_car_b, asc_car_c)
lcpars[["asc_pt"]] = list(asc_pt_a, asc_pt_b, asc_pt_c)
lcpars[["asc_ecar"]] = list(asc_ecar_a, asc_ecar_b, asc_ecar_c)
lcpars[["asc_ebike"]] = list(asc_ebike_a, asc_ebike_b, asc_ebike_c)
lcpars[["asc_escoot"]] = list(asc_escoot_a, asc_escoot_b, asc_escoot_c)
lcpars[["asc_aebike"]] = list(asc_aebike_a, asc_aebike_b, asc_aebike_c)
lcpars[["asc_aescoot"]] = list(asc_aescoot_a, asc_aescoot_b, asc_aescoot_c)
lcpars[["asc_awalk"]] = list(asc_awalk_a, asc_awalk_b, asc_awalk_c)
lcpars[["b_car_ivtt"]] = list(car_ivtt_a, car_ivtt_b, car_ivtt_c)
lcpars[["b_car_egt"]] = list(car_egt_a, car_egt_b, car_egt_c)
lcpars[["b_car_tc"]] = list(car_tc_a, car_tc_b, car_tc_c)
lcpars[["b_car_pc"]] = list(car_pc_a, car_pc_b, car_pc_c)
lcpars[["b_pt_ivtt"]] = list(pt_ivtt_a, pt_ivtt_b, pt_ivtt_c)
lcpars[["b_pt_act"]] = list(pt_act_a, pt_act_b, pt_act_c)
lcpars[["b_pt_egt"]] = list(pt_egt_a, pt_egt_b, pt_egt_c)
lcpars[["b_pt_wt"]] = list(pt_wt_a, pt_wt_b, pt_wt_c)
lcpars[["b_pt_tc"]] = list(pt_tc_a, pt_tc_b, pt_tc_c)
lcpars[["b_ecar_ivtt"]] = list(ecar_ivtt_a, ecar_ivtt_b, ecar_ivtt_c)
lcpars[["b_ecar_act"]] = list(ecar_act_a, ecar_act_b, ecar_act_c)
lcpars[["b_ecar_egt"]] = list(ecar_egt_a, ecar_egt_b, ecar_egt_c)
lcpars[["b_ecar_tc"]] = list(ecar_tc_a, ecar_tc_b, ecar_tc_c)
lcpars[["b_ecar_av"]] = list(ecar_av_a, ecar_av_b, ecar_av_c)
lcpars[["b_ecar_wt"]] = list(ecar_wt_a, ecar_wt_b, ecar_wt_c)
lcpars[["b_ebike_ivtt"]] = list(ebike_ivtt_a, ebike_ivtt_b, ebike_ivtt_c)
lcpars[["b_ebike_act"]] = list(ebike_act_a, ebike_act_b, ebike_act_c)
lcpars[["b_ebike_egt"]] = list(ebike_egt_a, ebike_egt_b, ebike_egt_c)
lcpars[["b_ebike_tc"]] = list(ebike_tc_a, ebike_tc_b, ebike_tc_c)
lcpars[["b_ebike_av"]] = list(ebike_av_a, ebike_av_b, ebike_av_c)
lcpars[["b_ebike_wt"]] = list(ebike_wt_a, ebike_wt_b, ebike_wt_c)
lcpars[["b_escoot_ivtt"]] = list(escoot_ivtt_a, escoot_ivtt_b, escoot_ivtt_c)
lcpars[["b_escoot_act"]] = list(escoot_act_a, escoot_act_b, escoot_act_c)
lcpars[["b_escoot_egt"]] = list(escoot_egt_a, escoot_egt_b, escoot_egt_c)
lcpars[["b_escoot_tc"]] = list(escoot_tc_a, escoot_tc_b, escoot_tc_c)
lcpars[["b_escoot_av"]] = list(escoot_av_a, escoot_av_b, escoot_av_c)
lcpars[["b_escoot_wt"]] = list(escoot_wt_a, escoot_wt_b, escoot_wt_c)
lcpars[["b_aebike_ivtt"]] = list(aebike_ivtt_a, aebike_ivtt_b, aebike_ivtt_c)
lcpars[["b_aebike_wk"]] = list(aebike_wk_a, aebike_wk_b, aebike_wk_c)
lcpars[["b_aebike_tc"]] = list(aebike_tc_a, aebike_tc_b, aebike_tc_c)
lcpars[["b_aebike_av"]] = list(aebike_av_a, aebike_av_b, aebike_av_c)
lcpars[["b_aebike_wt"]] = list(aebike_wt_a, aebike_wt_b, aebike_wt_c)
lcpars[["b_aescoot_ivtt"]] = list(aescoot_ivtt_a, aescoot_ivtt_b, aescoot_ivtt_c)
lcpars[["b_aescoot_wk"]] = list(aescoot_wk_a, aescoot_wk_b, aescoot_wk_c)
lcpars[["b_aescoot_tc"]] = list(aescoot_tc_a, aescoot_tc_b, aescoot_tc_c)
lcpars[["b_aescoot_av"]] = list(aescoot_av_a, aescoot_av_b, aescoot_av_c)
lcpars[["b_aescoot_wt"]] = list(aescoot_wt_a, aescoot_wt_b, aescoot_wt_c)
lcpars[["b_awalk"]] = list(awalk_a, awalk_b, awalk_c)
lcpars[["lm_innv_car"]] = list(lm_innv_car_a, lm_innv_car_b, lm_innv_car_c)
lcpars[["lm_skpt_car"]] = list(lm_skpt_car_a, lm_skpt_car_b, lm_skpt_car_c)
lcpars[["lm_risk_car"]] = list(lm_risk_car_a, lm_risk_car_b, lm_risk_car_c)
lcpars[["lm_use_car"]] = list(lm_use_car_a, lm_use_car_b, lm_use_car_c)
lcpars[["lm_sn_car"]] = list(lm_sn_car_a, lm_sn_car_b, lm_sn_car_c)
lcpars[["lm_env_car"]] = list(lm_env_car_a, lm_env_car_b, lm_env_car_c)
lcpars[["lm_innv_pt"]] = list(lm_innv_pt_a, lm_innv_pt_b, lm_innv_pt_c)
lcpars[["lm_skpt_pt"]] = list(lm_skpt_pt_a, lm_skpt_pt_b, lm_skpt_pt_c)
lcpars[["lm_risk_pt"]] = list(lm_risk_pt_a, lm_risk_pt_b, lm_risk_pt_c)
lcpars[["lm_use_pt"]] = list(lm_use_pt_a, lm_use_pt_b, lm_use_pt_c)
lcpars[["lm_sn_pt"]] = list(lm_sn_pt_a, lm_sn_pt_b, lm_sn_pt_c)
lcpars[["lm_env_pt"]] = list(lm_env_pt_a, lm_env_pt_b, lm_env_pt_c)
lcpars[["lm_innv_ecar"]] = list(lm_innv_ecar_a, lm_innv_ecar_b, lm_innv_ecar_c)
lcpars[["lm_skpt_ecar"]] = list(lm_skpt_ecar_a, lm_skpt_ecar_b, lm_skpt_ecar_c)
lcpars[["lm_risk_ecar"]] = list(lm_risk_ecar_a, lm_risk_ecar_b, lm_risk_ecar_c)
lcpars[["lm_use_ecar"]] = list(lm_use_ecar_a, lm_use_ecar_b, lm_use_ecar_c)
lcpars[["lm_sn_ecar"]] = list(lm_sn_ecar_a, lm_sn_ecar_b, lm_sn_ecar_c)
lcpars[["lm_env_ecar"]] = list(lm_env_ecar_a, lm_env_ecar_b, lm_env_ecar_c)
lcpars[["lm_innv_ebike"]] = list(lm_innv_ebike_a, lm_innv_ebike_b, lm_innv_ebike_c)
lcpars[["lm_skpt_ebike"]] = list(lm_skpt_ebike_a, lm_skpt_ebike_b, lm_skpt_ebike_c)
lcpars[["lm_risk_ebike"]] = list(lm_risk_ebike_a, lm_risk_ebike_b, lm_risk_ebike_c)
lcpars[["lm_use_ebike"]] = list(lm_use_ebike_a, lm_use_ebike_b, lm_use_ebike_c)
lcpars[["lm_sn_ebike"]] = list(lm_sn_ebike_a, lm_sn_ebike_b, lm_sn_ebike_c)
lcpars[["lm_env_ebike"]] = list(lm_env_ebike_a, lm_env_ebike_b, lm_env_ebike_c)
lcpars[["lm_innv_escoot"]] = list(lm_innv_escoot_a, lm_innv_escoot_b, lm_innv_escoot_c)
lcpars[["lm_skpt_escoot"]] = list(lm_skpt_escoot_a, lm_skpt_escoot_b, lm_skpt_escoot_c)
lcpars[["lm_risk_escoot"]] = list(lm_risk_escoot_a, lm_risk_escoot_b, lm_risk_escoot_c)
lcpars[["lm_use_escoot"]] = list(lm_use_escoot_a, lm_use_escoot_b, lm_use_escoot_c)
lcpars[["lm_sn_escoot"]] = list(lm_sn_escoot_a, lm_sn_escoot_b, lm_sn_escoot_c)
lcpars[["lm_env_escoot"]] = list(lm_env_escoot_a, lm_env_escoot_b, lm_env_escoot_c)
lcpars[["lm_innv_aebike"]] = list(lm_innv_aebike_a, lm_innv_aebike_b, lm_innv_aebike_c)
lcpars[["lm_skpt_aebike"]] = list(lm_skpt_aebike_a, lm_skpt_aebike_b, lm_skpt_aebike_c)
lcpars[["lm_risk_aebike"]] = list(lm_risk_aebike_a, lm_risk_aebike_b, lm_risk_aebike_c)
lcpars[["lm_use_aebike"]] = list(lm_use_aebike_a, lm_use_aebike_b, lm_use_aebike_c)
lcpars[["lm_sn_aebike"]] = list(lm_sn_aebike_a, lm_sn_aebike_b, lm_sn_aebike_c)
lcpars[["lm_env_aebike"]] = list(lm_env_aebike_a, lm_env_aebike_b, lm_env_aebike_c)
lcpars[["lm_innv_aescoot"]] = list(lm_innv_aescoot_a, lm_innv_aescoot_b, lm_innv_aescoot_c)
lcpars[["lm_skpt_aescoot"]] = list(lm_skpt_aescoot_a, lm_skpt_aescoot_b, lm_skpt_aescoot_c)
lcpars[["lm_risk_aescoot"]] = list(lm_risk_aescoot_a, lm_risk_aescoot_b, lm_risk_aescoot_c)
lcpars[["lm_use_aescoot"]] = list(lm_use_aescoot_a, lm_use_aescoot_b, lm_use_aescoot_c)
lcpars[["lm_sn_aescoot"]] = list(lm_sn_aescoot_a, lm_sn_aescoot_b, lm_sn_aescoot_c)
lcpars[["lm_env_aescoot"]] = list(lm_env_aescoot_a, lm_env_aescoot_b, lm_env_aescoot_c)
lcpars[["lm_risk_awalk"]] = list(lm_risk_awalk_a, lm_risk_awalk_b, lm_risk_awalk_c)
lcpars[["lm_use_awalk"]] = list(lm_use_awalk_a, lm_use_awalk_b, lm_use_awalk_c)
## Class segmentation model
V = list()
V[["class_a"]] = delta_a + gm_age1_a*(age==1) + gm_age2_a*(age==3) + gm_age3_a*(age==5) + gm_female_a*female + gm_hhinc1_a*(hhinc==1) + gm_hhinc2_a*(hhinc==3) + gm_hhinc3_a*(hhinc==5) +
gm_ncar0_a*(ncar==0) + gm_ncar1_a*(ncar==1) + gm_ncar2_a*(ncar==2) + gm_nbic0_a*(nbic==0) + gm_nbic1_a*(nbic==1) + gm_nbic2_a*(nbic==2) + gm_hhC_a*hhC + lm_hab_a*hab
V[["class_b"]] = delta_b + gm_age1_b*(age==1) + gm_age2_b*(age==3) + gm_age3_b*(age==5) + gm_female_b*female + gm_hhinc1_b*(hhinc==1) + gm_hhinc2_b*(hhinc==3) + gm_hhinc3_b*(hhinc==5) +
gm_ncar0_b*(ncar==0) + gm_ncar1_b*(ncar==1) + gm_ncar2_b*(ncar==2) + gm_nbic0_b*(nbic==0) + gm_nbic1_b*(nbic==1) + gm_nbic2_b*(nbic==2) + gm_hhC_b*hhC + lm_hab_b*hab
V[["class_c"]] = delta_c + gm_age1_c*(age==1) + gm_age2_c*(age==3) + gm_age3_c*(age==5) + gm_female_c*female + gm_hhinc1_c*(hhinc==1) + gm_hhinc2_c*(hhinc==3) + gm_hhinc3_c*(hhinc==5) +
gm_ncar0_c*(ncar==0) + gm_ncar1_c*(ncar==1) + gm_ncar2_c*(ncar==2) + gm_nbic0_c*(nbic==0) + gm_nbic1_c*(nbic==1) + gm_nbic2_c*(nbic==2) + gm_hhC_c*hhC + lm_hab_c*hab
## Class allocation settings
classAlloc_settings = list(
classes = c(class_a = 1, class_b = 2, class_c = 3),
utilities = V
)
lcpars[["pi_values"]] = apollo_classAlloc(classAlloc_settings)
return(lcpars)
}
## Group and Validate inputs
apollo_inputs = apollo_validateInputs()
## Define model and likelihood function
apollo_probabilities = function(apollo_beta, apollo_inputs, functionality = "estimate") {
## Initialize
apollo_attach(apollo_beta, apollo_inputs)
on.exit(apollo_detach(apollo_beta, apollo_inputs))
# Creating list of probabilities P
P = list()
## Likelihood of indicators to LVs
ol_settings1 = list(outcomeOrdered = att1,
V = zeta_innv1*innv,
tau = list(tau_innv1_1, tau_innv1_2, tau_innv1_3, tau_innv1_4),
rows = (task==1),
componentName = "indic_innv1")
ol_settings2 = list(outcomeOrdered = att2,
V = zeta_innv2*innv,
tau = list(tau_innv2_1, tau_innv2_2, tau_innv2_3, tau_innv2_4),
rows = (task==1),
componentName = "indic_innv2")
ol_settings3 = list(outcomeOrdered = att3,
V = zeta_innv3*innv,
tau = list(tau_innv3_1, tau_innv3_2, tau_innv3_3, tau_innv3_4),
rows = (task==1),
componentName = "indic_innv3")
ol_settings4 = list(outcomeOrdered = att4,
V = zeta_skpt1*skpt,
tau = list(tau_skpt1_1, tau_skpt1_2, tau_skpt1_3, tau_skpt1_4),
rows = (task==1),
componentName = "indic_skpt1")
ol_settings5 = list(outcomeOrdered = att5,
V = zeta_skpt2*skpt,
tau = list(tau_skpt2_1, tau_skpt2_2, tau_skpt2_3, tau_skpt2_4),
rows = (task==1),
componentName = "indic_skpt2")
ol_settings6 = list(outcomeOrdered = att10,
V = zeta_skpt3*skpt,
tau = list(tau_skpt3_1, tau_skpt3_2, tau_skpt3_3, tau_skpt3_4),
rows = (task==1),
componentName = "indic_skpt3")
ol_settings7 = list(outcomeOrdered = att11,
V = zeta_risk1*risk,
tau = list(tau_risk1_1, tau_risk1_2, tau_risk1_3, tau_risk1_4),
rows = (task==1),
componentName = "indic_risk1")
ol_settings8 = list(outcomeOrdered = att13,
V = zeta_risk2*risk,
tau = list(tau_risk2_1, tau_risk2_2, tau_risk2_3, tau_risk2_4),
rows = (task==1),
componentName = "indic_risk2")
ol_settings9 = list(outcomeOrdered = att14,
V = zeta_risk3*risk,
tau = list(tau_risk3_1, tau_risk3_2, tau_risk3_3, tau_risk3_4),
rows = (task==1),
componentName = "indic_risk3")
ol_settings10 = list(outcomeOrdered = att8,
V = zeta_use1*use,
tau = list(tau_use1_1, tau_use1_2, tau_use1_3, tau_use1_4),
rows = (task==1),
componentName = "indic_use1")
ol_settings11 = list(outcomeOrdered = att16,
V = zeta_use2*use,
tau = list(tau_use2_1, tau_use2_2, tau_use2_3, tau_use2_4),
rows = (task==1),
componentName = "indic_use2")
ol_settings12 = list(outcomeOrdered = att17,
V = zeta_use3*use,
tau = list(tau_use3_1, tau_use3_2, tau_use3_3, tau_use3_4),
rows = (task==1),
componentName = "indic_use3")
ol_settings13 = list(outcomeOrdered = att18,
V = zeta_use4*use,
tau = list(tau_use4_1, tau_use4_2, tau_use4_3, tau_use4_4),
rows = (task==1),
componentName = "indic_use4")
ol_settings14 = list(outcomeOrdered = att19,
V = zeta_use5*use,
tau = list(tau_use5_1, tau_use5_2, tau_use5_3, tau_use5_4),
rows = (task==1),
componentName = "indic_use5")
ol_settings15 = list(outcomeOrdered = att21,
V = zeta_sn1*sn,
tau = list(tau_sn1_1, tau_sn1_2, tau_sn1_3, tau_sn1_4),
rows = (task==1),
componentName = "indic_sn1")
ol_settings16 = list(outcomeOrdered = att22,
V = zeta_sn2*sn,
tau = list(tau_sn2_1, tau_sn2_2, tau_sn2_3, tau_sn2_4),
rows = (task==1),
componentName = "indic_sn2")
ol_settings17 = list(outcomeOrdered = att23,
V = zeta_env1*env,
tau = list(tau_env1_1, tau_env1_2, tau_env1_3, tau_env1_4),
rows = (task==1),
componentName = "indic_env1")
ol_settings18 = list(outcomeOrdered = att24,
V = zeta_env2*env,
tau = list(tau_env2_1, tau_env2_2, tau_env2_3, tau_env2_4),
rows = (task==1),
componentName = "indic_env2")
ol_settings19 = list(outcomeOrdered = att25,
V = zeta_env3*env,
tau = list(tau_env3_1, tau_env3_2, tau_env3_3, tau_env3_4),
rows = (task==1),
componentName = "indic_env3")
ol_settings20 = list(outcomeOrdered = hab1,
V = zeta_hab1*hab,
tau = list(tau_hab1_1, tau_hab1_2, tau_hab1_3, tau_hab1_4),
rows = (task==1),
componentName = "indic_hab1")
ol_settings21 = list(outcomeOrdered = hab2,
V = zeta_hab2*hab,
tau = list(tau_hab2_1, tau_hab2_2, tau_hab2_3, tau_hab2_4),
rows = (task==1),
componentName = "indic_hab2")
ol_settings22 = list(outcomeOrdered = hab3,
V = zeta_hab3*hab,
tau = list(tau_hab3_1, tau_hab3_2, tau_hab3_3, tau_hab3_4),
rows = (task==1),
componentName = "indic_hab3")
ol_settings23 = list(outcomeOrdered = hab4,
V = zeta_hab4*hab,
tau = list(tau_hab4_1, tau_hab4_2, tau_hab4_3, tau_hab4_4),
rows = (task==1),
componentName = "indic_hab4")
ol_settings24 = list(outcomeOrdered = hab5,
V = zeta_hab5*hab,
tau = list(tau_hab5_1, tau_hab5_2, tau_hab5_3, tau_hab5_4),
rows = (task==1),
componentName = "indic_hab5")
P[["indic_innv1"]] = apollo_ol(ol_settings1, functionality)
P[["indic_innv2"]] = apollo_ol(ol_settings2, functionality)
P[["indic_innv3"]] = apollo_ol(ol_settings3, functionality)
P[["indic_skpt1"]] = apollo_ol(ol_settings4, functionality)
P[["indic_skpt2"]] = apollo_ol(ol_settings5, functionality)
P[["indic_skpt3"]] = apollo_ol(ol_settings6, functionality)
P[["indic_risk1"]] = apollo_ol(ol_settings7, functionality)
P[["indic_risk2"]] = apollo_ol(ol_settings8, functionality)
P[["indic_risk3"]] = apollo_ol(ol_settings9, functionality)
P[["indic_use1"]] = apollo_ol(ol_settings10, functionality)
P[["indic_use2"]] = apollo_ol(ol_settings11, functionality)
P[["indic_use3"]] = apollo_ol(ol_settings12, functionality)
P[["indic_use4"]] = apollo_ol(ol_settings13, functionality)
P[["indic_use5"]] = apollo_ol(ol_settings14, functionality)
P[["indic_sn1"]] = apollo_ol(ol_settings15, functionality)
P[["indic_sn2"]] = apollo_ol(ol_settings16, functionality)
P[["indic_env1"]] = apollo_ol(ol_settings17, functionality)
P[["indic_env2"]] = apollo_ol(ol_settings18, functionality)
P[["indic_env3"]] = apollo_ol(ol_settings19, functionality)
P[["indic_hab1"]] = apollo_ol(ol_settings20, functionality)
P[["indic_hab2"]] = apollo_ol(ol_settings21, functionality)
P[["indic_hab3"]] = apollo_ol(ol_settings22, functionality)
P[["indic_hab4"]] = apollo_ol(ol_settings23, functionality)
P[["indic_hab5"]] = apollo_ol(ol_settings24, functionality)
P[["indic_innv1"]] = apollo_panelProd(P[["indic_innv1"]], apollo_inputs, functionality)
P[["indic_innv2"]] = apollo_panelProd(P[["indic_innv2"]], apollo_inputs, functionality)
P[["indic_innv3"]] = apollo_panelProd(P[["indic_innv3"]], apollo_inputs, functionality)
P[["indic_skpt1"]] = apollo_panelProd(P[["indic_skpt1"]], apollo_inputs, functionality)
P[["indic_skpt2"]] = apollo_panelProd(P[["indic_skpt2"]], apollo_inputs, functionality)
P[["indic_skpt3"]] = apollo_panelProd(P[["indic_skpt3"]], apollo_inputs, functionality)
P[["indic_risk1"]] = apollo_panelProd(P[["indic_risk1"]], apollo_inputs, functionality)
P[["indic_risk2"]] = apollo_panelProd(P[["indic_risk2"]], apollo_inputs, functionality)
P[["indic_risk3"]] = apollo_panelProd(P[["indic_risk3"]], apollo_inputs, functionality)
P[["indic_use1"]] = apollo_panelProd(P[["indic_use1"]], apollo_inputs, functionality)
P[["indic_use2"]] = apollo_panelProd(P[["indic_use2"]], apollo_inputs, functionality)
P[["indic_use3"]] = apollo_panelProd(P[["indic_use3"]], apollo_inputs, functionality)
P[["indic_use4"]] = apollo_panelProd(P[["indic_use4"]], apollo_inputs, functionality)
P[["indic_use5"]] = apollo_panelProd(P[["indic_use5"]], apollo_inputs, functionality)
P[["indic_sn1"]] = apollo_panelProd(P[["indic_sn1"]], apollo_inputs, functionality)
P[["indic_sn2"]] = apollo_panelProd(P[["indic_sn2"]], apollo_inputs, functionality)
P[["indic_env1"]] = apollo_panelProd(P[["indic_env1"]], apollo_inputs, functionality)
P[["indic_env2"]] = apollo_panelProd(P[["indic_env2"]], apollo_inputs, functionality)
P[["indic_env3"]] = apollo_panelProd(P[["indic_env3"]], apollo_inputs, functionality)
P[["indic_hab1"]] = apollo_panelProd(P[["indic_hab1"]], apollo_inputs, functionality)
P[["indic_hab2"]] = apollo_panelProd(P[["indic_hab2"]], apollo_inputs, functionality)
P[["indic_hab3"]] = apollo_panelProd(P[["indic_hab3"]], apollo_inputs, functionality)
P[["indic_hab4"]] = apollo_panelProd(P[["indic_hab4"]], apollo_inputs, functionality)
P[["indic_hab5"]] = apollo_panelProd(P[["indic_hab5"]], apollo_inputs, functionality)
## Compute class-specific utilities in choice sub-model
## Loop over classes
for (s in 1:3) {
V = list()
V[["car"]] = asc_car[[s]] + b_car_ivtt[[s]]*car_ivtt + b_car_egt[[s]]*car_egt + b_car_tc[[s]]*car_tc + b_car_pc[[s]]*car_pc +
lm_innv_car[[s]]*innv + lm_skpt_car[[s]]*skpt + lm_risk_car[[s]]*risk + lm_use_car[[s]]*use + lm_sn_car[[s]]*sn + lm_env_car[[s]]*env
V[["pt"]] = asc_pt[[s]] + b_pt_ivtt[[s]]*pt_ivtt + b_pt_act[[s]]*pt_act + b_pt_egt[[s]]*pt_egt + b_pt_wt[[s]]*pt_wt + b_pt_tc[[s]]*pt_tc +
lm_innv_pt[[s]]*innv + lm_skpt_pt[[s]]*skpt + lm_risk_pt[[s]]*risk + lm_use_pt[[s]]*use + lm_sn_pt[[s]]*sn + lm_env_pt[[s]]*env
V[["ecar"]] = asc_ecar[[s]] + b_ecar_ivtt[[s]]*ecar_ivtt + b_ecar_act[[s]]*ecar_act + b_ecar_egt[[s]]*ecar_egt + b_ecar_wt[[s]]*ecar_wt + b_ecar_tc[[s]]*ecar_tc + b_ecar_av[[s]]*ecar_av +
lm_innv_ecar[[s]]*innv + lm_skpt_ecar[[s]]*skpt + lm_risk_ecar[[s]]*risk + lm_use_ecar[[s]]*use + lm_sn_ecar[[s]]*sn + lm_env_ecar[[s]]*env
V[["ebike"]] = asc_ebike[[s]] + b_ebike_ivtt[[s]]*ebike_ivtt + b_ebike_act[[s]]*ebike_act + b_ebike_egt[[s]]*ebike_egt + b_ebike_wt[[s]]*ebike_wt + b_ebike_tc[[s]]*ebike_tc + b_ebike_av[[s]]*ebike_av +
lm_innv_ebike[[s]]*innv + lm_skpt_ebike[[s]]*skpt + lm_risk_ebike[[s]]*risk + lm_use_ebike[[s]]*use + lm_sn_ebike[[s]]*sn + lm_env_ebike[[s]]*env
V[["escoot"]] = asc_escoot[[s]] + b_escoot_ivtt[[s]]*escoot_ivtt + b_escoot_act[[s]]*escoot_act + b_escoot_egt[[s]]*escoot_egt + b_escoot_wt[[s]]*escoot_wt + b_escoot_tc[[s]]*escoot_tc + b_escoot_av[[s]]*escoot_av +
lm_innv_escoot[[s]]*innv + lm_skpt_escoot[[s]]*skpt + lm_risk_escoot[[s]]*risk + lm_use_escoot[[s]]*use + lm_sn_escoot[[s]]*sn + lm_env_escoot[[s]]*env
V[["aebike"]] = asc_aebike[[s]] + b_aebike_ivtt[[s]]*aebike_ivtt + b_aebike_wk[[s]]*aebike_wk + b_aebike_wt[[s]]*aebike_wt + b_aebike_tc[[s]]*aebike_tc + b_aebike_av[[s]]*aebike_av +
lm_innv_aebike[[s]]*innv + lm_skpt_aebike[[s]]*skpt + lm_risk_aebike[[s]]*risk + lm_use_aebike[[s]]*use + lm_sn_aebike[[s]]*sn + lm_env_aebike[[s]]*env
V[["aescoot"]] = asc_aescoot[[s]] + b_aescoot_ivtt[[s]]*aescoot_ivtt + b_aescoot_wk[[s]]*aescoot_wk + b_aescoot_wt[[s]]*aescoot_wt + b_aescoot_tc[[s]]*aescoot_tc + b_aescoot_av[[s]]*aescoot_av +
lm_innv_aescoot[[s]]*innv + lm_skpt_aescoot[[s]]*skpt + lm_risk_aescoot[[s]]*risk + lm_use_aescoot[[s]]*use + lm_sn_aescoot[[s]]*sn + lm_env_aescoot[[s]]*env
V[["awalk"]] = asc_awalk[[s]] + b_awalk[[s]]*awalk + lm_risk_awalk[[s]]*risk + lm_use_awalk[[s]]*use
## Settings for MNL model component
mnl_settings = list(
alternatives = c(car=1, pt=2, ecar=3, ebike=4, escoot=5, aebike=6, aescoot=7, awalk=8),
avail = list(car=av_car, pt=av_pt, ecar=av_ecar, ebike=av_ebike, escoot=av_escoot, aebike=av_aebike, aescoot=av_aescoot, awalk=av_awalk),
choiceVar = mode,
utilities = V,
componentName = paste0("class_", s)
)
## Compute within-class choice probabilities using MNL
P[[paste0("class_",s)]] = apollo_mnl(mnl_settings, functionality)
## Product across observations for same ID
P[[paste0("class_",s)]] = apollo_panelProd(P[[paste0("class_",s)]], apollo_inputs, functionality)
}
### Compute latent class model probabilities
lc_settings = list(inClassProb = P[paste0("class_", 1:3)], classProb=pi_values, componentName="choice")
P[["choice"]] = apollo_lc(lc_settings, apollo_inputs, functionality)
### Comment out as necessary
P = apollo_combineModels(P, apollo_inputs, functionality, components=c("indic_innv1", "indic_innv2", "indic_innv3",
"indic_skpt1", "indic_skpt2", "indic_skpt3",
"indic_risk1", "indic_risk2", "indic_risk3",
"indic_use1", "indic_use2", "indic_use3", "indic_use4", "indic_use5",
"indic_sn1", "indic_sn2",
"indic_env1", "indic_env2", "indic_env3",
"indic_hab1", "indic_hab2", "indic_hab3", "indic_hab4", "indic_hab5",
"choice"))
## Average across inter-individual draws
P = apollo_avgInterDraws(P, apollo_inputs, functionality)
## Prepare and return outputs of function
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
## Calculate LL at starting values
apollo_llCalc(apollo_beta, apollo_probabilities, apollo_inputs)
## Model Estimation
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs, estimate_settings = list(maxIterations=100))
## Model output
apollo_modelOutput(model)