ApolloChoiceModelling forum

Code: Select all

rm(list = ls())

### Load Apollo library
library(apollo)

### Initialise code
apollo_initialise()

### Set core controls
apollo_control = list(
  modelName  ="latent class CNL",
  modelDescr ="LCCNL_testing",
  indivID    ="ID"
)

database = read.csv("apollo_modeChoiceData.csv",header=TRUE)
### Use only SP data
database = subset(database,database$SP==1)
database$time_air_scaled = database$time_air/100
database$time_bus_scaled = database$time_bus/100
database$time_car_scaled = database$time_car/100
database$time_rail_scaled = database$time_rail/100
database$cost_air_scaled = database$cost_air/10
database$cost_bus_scaled = database$cost_bus/10
database$cost_car_scaled = database$cost_car/10
database$cost_rail_scaled = database$cost_rail/10
database$income_scaled = database$income/1000
apollo_beta=c(asc_car_c1 = 0,
              asc_bus_c1 = -0.7718,
              asc_air_c1 = -0.5970,
              asc_rail_c1 = -0.9971,
              b_tt_car_c1 = -0.8960,
              b_tt_bus_c1 = -1.1957,
              b_tt_air_c1 = -0.9839,
              b_tt_rail_c1 = -0.4547,
              b_cost_c1 = -0.4462,
              lambda_fastPT = 0.95,
              lambda_groundPT = 0.95,
              alpha0_rail_fastPT = 0,
              alpha0_rail_groundPT = 0,
              gamma_gender_c1 = 0,
              gamma_income_c1 = 0,
              delta_c1 = 0, 
              asc_car_c2 = 0,
              asc_bus_c2 = -0.617,
              asc_air_c2 = -0.478,
              asc_rail_c2 = -0.798,
              b_tt_car_c2 = -0.717,
              b_tt_bus_c2 = -0.957,
              b_tt_air_c2 = -0.787,
              b_tt_rail_c2 = -0.364,
              b_cost_c2 = -0.357,
              gamma_gender_c2 = 0,
              gamma_income_c2 = 0,
              delta_c2 = 0)
apollo_fixed = c("asc_car_c1","asc_car_c2","gamma_gender_c1","gamma_income_c1","delta_c1","alpha0_rail_groundPT")
apollo_lcPars = function(apollo_beta, apollo_inputs){
  lcpars = list()
  lcpars[["b_tt_car"]] = list(b_tt_car_c1,b_tt_car_c2)
  lcpars[["b_tt_bus"]] = list(b_tt_bus_c1,b_tt_bus_c2)
  lcpars[["b_tt_air"]] = list(b_tt_air_c1,b_tt_air_c2)
  lcpars[["b_tt_rail"]] = list(b_tt_rail_c1,b_tt_rail_c2)
  lcpars[["b_cost"]] = list(b_cost_c1,b_cost_c2)
  lcpars[["asc_car"]] = list(asc_car_c1,asc_car_c2)
  lcpars[["asc_bus"]] = list(asc_bus_c1,asc_bus_c2)
  lcpars[["asc_air"]] = list(asc_air_c1,asc_air_c2)
  lcpars[["asc_rail"]] = list(asc_rail_c1,asc_rail_c2)
  V = list()
  V[["class_1"]] = delta_c1 + gamma_gender_c1*female + gamma_income_c1*income_scaled
  V[["class_2"]] = delta_c2 + gamma_gender_c2*female + gamma_income_c2*income_scaled
  mnl_settings = list(
    alternatives = c(class_1=1, class_2=2),
    avail = 1,
    choiceVar = NA,
    V = V
  )
  lcpars[["pi_values"]] = apollo_mnl(mnl_settings, functionality = "raw")
  lcpars[["pi_values"]] = apollo_firstRow(lcpars[["pi_values"]], apollo_inputs)
  return(lcpars)
}
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()
  cnlNests = list(fastPT=lambda_fastPT,groundPT = lambda_groundPT, car=1)
  alpha_rail_fastPT   = exp(alpha0_rail_fastPT)/(exp(alpha0_rail_fastPT) + exp(alpha0_rail_groundPT))
  alpha_rail_groundPT = 1-alpha_rail_fastPT
  cnlStructure = matrix(0,nrow = length(cnlNests),ncol=length(V))
  cnlStructure[1,] = c(0,0,1,alpha_rail_fastPT) #alpha_rail_fastPT
  cnlStructure[2,] = c(0,1,0,alpha_rail_groundPT) #alpha_rail_groundPT
  cnlStructure[3,] = c(1,0,0,0) #car
  
  cnl_settings <- list(
    alternatives = c(car=1, bus=2, air=3, rail=4),
    avail        = list(car=av_car, bus=av_bus, air=av_air, rail=av_rail),
    choiceVar    = choice,
    cnlNests     = cnlNests,
    cnlStructure = cnlStructure
  )
  s=1
  while(s<=2){
    V = list()
    V[['car']] = asc_car[[s]] + b_tt_car[[s]]*time_car_scaled + b_cost[[s]]*cost_car_scaled
    V[['bus']] = asc_bus[[s]] + b_tt_bus[[s]]*time_bus_scaled + b_cost[[s]]*cost_bus_scaled
    V[['air']] = asc_air[[s]] + b_tt_air[[s]]*time_air_scaled + b_cost[[s]]*cost_air_scaled
    V[['rail']] = asc_rail[[s]] + b_tt_rail[[s]]*time_rail_scaled + b_cost[[s]]*cost_rail_scaled
    
    cnl_settings$V = V
    P[[s]] = apollo_cnl(cnl_settings,functionality)
    P[[s]] = apollo_panelProd(P[[s]],apollo_inputs,functionality)
    
    s = s+1
  }
  lc_settings = list(inClassProb = P, classProb=pi_values)
  P[["model"]] = apollo_lc(lc_settings,apollo_inputs,functionality)
  P = apollo_prepareProb(P,apollo_inputs,functionality)
}

model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities,apollo_inputs)
apollo_modelOutput(model,modelOutput_settings = list(printPVal=TRUE))

Code: Select all

cnlStructure = matrix(0,nrow = length(cnlNests),ncol=length(V))

Code: Select all

cnlStructure = matrix(0,nrow = length(cnlNests),ncol=4)